Re: [MacPerl] Setting the "label" on folders

[Fred Giorgi <fgiorg@atl.com>]

Thanks Chris
Here is a complete solution.
--fred

#!perl -wl
# color dropped folders according to number of enclosed items
# save this as a droplet
#'label index' is a property of 'item'
# for ref here are the out of the box labels from macOS
# #   Label       color
# 0 = none        gray
# 1 = Essential   Orange
# 2 = Hot         Red
# 3 = In Progress Magenta
# 4 = Cool        LtBlue
# 5 = Personal    DkBlue
# 6 = Project1    Green
# 7 = Project2    Brown

use Mac::AppleEvents::Simple qw(:all);
use POSIX;     #for the ceil() function

# default no label for trash
my $label = 0;
my $item = "Trash";
my $count = 0.0;  #be sure to initialize with '0.0' not '0' to force numeric
my ($obj1, $obj2);
my @params = ();
my $droppeditem;
my @names = ();

foreach $droppeditem ( @ARGV ) {

   if( -d($droppeditem) ) {   #filetest to see if it's a directory
      opendir(DIR, $droppeditem);
      @names = readdir(DIR);
      closedir(DIR);

      $count = @names;  #array rtns count in scaler context

      $label = ceil($count/5);        #round up
      if($label > 7) { $label = 7; }  #limit

      $obj1 = 'obj {form:name, want:type(cobj), seld:TEXT(@), from:null()}';
      push @params, $droppeditem;
      $obj2 = "obj {form:prop, want:type(prop), seld:type(labi), from:$obj1}";
      do_event(qw/core setd MACS/, "'----':$obj2, data:$label", @params);

   }else{
      print "Dropped Item is not a folder or volume.\n";
   }
}

>Does anyone know how to set the label field on folders with perl?
>I would like to set the label field to some color based on how many files
>are in the folder.
>I would like to drop a folder on a prel icon and automatically set the
>"label" attribute on all subfolders.
>For example:
>folder is empty - no label
>folder contains 1 to 10 files - orange
>folder contains 10 to 20 files - red
>Any help would be appreciated.

--
Fred Giorgi <mailto:fgiorg@atl.com>




***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch