NetNews Usenet Archive 1992 #18/NN_1992_18.iso/spool/comp/lang/perl/5395

Text File | 1992-08-19 | 12.4 KB | 371 lines

Newsgroups: comp.lang.perl
Path: sparky!uunet!infonode!drew.b17a.ingr.com!drew
From: [e-mail] (Drew Mills)
Subject: MWM Image Menu Spec Generator (see comments at top of script)
Message-ID: <[e-mail]>
Keywords: menus abp mwm
Sender: [e-mail] (Usenet Administrator)
Reply-To: [e-mail]
Organization: Cartographic Applications, Intergraph
Date: Wed, 19 Aug 1992 23:12:15 GMT
Lines: 358

#!/usr/local/bin/perl
# This is my third try at getting this out & I haven't seen it in our news
# yet.  If this is the third time you've seen this, be kind, drop me a
# line; help stamp out Usenet blunders.  On with the show...
###########################################################################
#$debug = 1;                 # Uncomment this for debug
#
#   For all you a.b.p* nuts who use the Motif Window Manager!  I
#   couldn't help myself.  I had to have my pictures available on my
#   menus but I didn't want to have to type 'em all in by hand.  I
#   especially didn't want to have to update 'em by hand.  So this
#   script updates my .mwmrc file by reading my image directories and
#   creating menu entries for me.  It 'updates' the menu spec by
#   replacing the 'image menus' section completely whenever you run
#   this script.
#
#   It creates a menu 'tree' that represents the image directory
#   'tree'.  It tries to ignore non-binary files.
#
#   By default, it uses xv to display the pictures on my background.
#
#   Note that it expects you have created an entry like
#
#       "Images"      f.menu "Images"
#
#   in a menu entry in your .mwmrc file.  It also expects to find the
#   following 2 lines:
#
#   #Begin Image Menus
#    .
#    .
#    .
#    .
#   #End Image Menus
#
#   in the .mwmrc file.  Between the two lines are where the menus specs
#   will go.
#
#    For an example, the following directory tree:
#  <image root>--|
#                +-trains--+        +bno42
#                |         +-steam--|
#                |         |        +nw234
#                |         |
#                |         +-diesel--+
#                |                   +-cnw403
#                |                   |
#                |                   +-lnn251
#                |
#                |
#                +-scenery-+       +-yellowstone
#                          |       |
#                          +-parks-+-yosemite
#                          |       |
#                          |       +-denali
#                          |
#                          |
#                          +-fish-+-anemone
#                                 |
#                                 +-blacktip
#                                 |
#                                 +-gourami
#
#  creates menus like this:
#                                                       |=====|
#                               |========|              |bno42|
#      ========|              +-|steam  >|--------------|nw243|
#          .   |              | |diesel >|-\            |=====|
#          .   |              | |========| |
#      Images >|-|=========|  |            |
#          .   | |trains  >|--/            | |======|
#          .   | |scenery >|--\            +-|cnw403|
#          .   | |=========|  |              |lnn241|
#      ========|              |              |======|
#                             |
#                             |
#                             |
#                             | |=======|            |===========|
#                             | |parks >|------------|yellowstone|
#                             +-|fish  >|-\          |yosemite   |
#                               |=======| |          |denali     |
#                                         |          |===========|
#                                         |
#                                         | |========|
#                                         +-|anemone |
#                                           |blacktip|
#                                           |gourami |
#                                           |========|
#
#
#   LIMITATIONS:
#
#       This program will not differentiate between two directories
#       that have the same name on different parts of the tree.  It's
#       not a problem for me so I didn't bother with it.
#
#       It's too slow.  I've got a pretty big image directory tree and
#       it takes awhile to run it.  I think that this is because it
#       just takes a while to read all the directories, splice the
#       lists out into manageable bites and then create all those
#       strings.  I don't have any really big loops.  If anyone can
#       show me where I could get some extra speed, I would welcome
#       suggestions with shouts of praise and adulation (may your
#       mother-in-law live long and have her own apartment).
#
###########################################################################

###
  #
  #  This first section contains constants that may be altered for your
  #  particular situation.
  #
###

$max_num_rows = 30;        # Maximum number of rows in a menu.  You'll
                # have to figure this one out by yourself.
                # If you use a smaller font than did I, then
                # you can fit more items on each menu.
$picroot = "/usr/local/giffiles"; # Root directory for Image files
$mwmrc_path = "$ENV{HOME}/.mwmrc"; # .mwmrc path
$tmp_mwmrc_path = "/usr/tmp/tmpmwmrc"; # tmp holding file
$display_cmd = "xv -rm 5 -quit -maxpect"; # Command used in menu entry to
                      # display the image (This default
                      # uses xv to maximize the picture
                      # onto the root window)

###########################################################################
#
#   Here on, it's my problem.
#
###########################################################################

system("cp $mwmrc_path $mwmrc_path.sav") &&
    die "I could not make a copy of $mwmrc_path, so I\'m outta here!!!\n\n";

die "$picroot is not a directory.\n" if (! -d $picroot);

open (TMPMWMRC, "> $tmp_mwmrc_path") ||
    die "Could not open the tmp file $tmp_mwmrc_path!\n";

open (MWMRC, "< $mwmrc_path") ||
    die "Hey!! Why can\'t I read your .mwmrc file ($mwmrc_path)???";

$found=0;
while (<MWMRC>)
{
    ($found = 1, last) if /#Begin Image Menus/;
    print TMPMWMRC $_;
}

die "BAD FILE FORMAT! To indicate where the menus should go, you need to add the lines:\n\n#Begin Image Menus\n   and\n#End Image Menus\n\n   to your.mwmrc!!!\n" if (!$found);

print TMPMWMRC "#Begin Image Menus\n";

%main_menu_list = ();

#
#  This call is the one that does all the work.  See the subroutine
#  below to figure out what's going on.
#
&recurse_menu($picroot, "Images");

#
#  Now, print the results out to the TMPMWMRC file
#
foreach(sort(keys(%main_menu_list)))
{
    print TMPMWMRC $main_menu_list{$_};
}

print TMPMWMRC "\n#End Image Menus\n";

#
# Look for the line that has #End Image Menus
#
$found=0;
while (<MWMRC>)
{
    ($found=1, last) if /#End Image Menus/;
}

die "BAD FILE FORMAT! To indicate where the menus should go, you need to add the lines:\n\n#Begin Image Menus\n   and\n#End Image Menus\n\n   to your.mwmrc" if (!$found);


@therest = <MWMRC>;

print TMPMWMRC @therest;

close(TMPMWMRC);
close(MWMRC);

#
#  Now move the temporary .mwmrc file on top of the original .mwmrc file.
rename($tmp_mwmrc_path, $mwmrc_path) ||
    die "The new file $tmp_mwmrc_path was created but I wasn\'t able to rename it to $mwmrc_path\n\tMaybe you should do it yourself.";

#
#  That's all folks!
#
exit(0);

###########################################################################
#
# sub recurse_menu
#
#   This subroutine is the (recursively callable) routine that is used
#   to create the various menus needed.
#
#   We use an associated list of menus to hold each menu entry no
#   matter at what level its on, since mwm sees only a flat file.
#   It goes through the following step for each directory it encounters:
#
#   1) Every subdirectory has this build menu function run on it and the
#      function is expected to add its entire menu spec onto the main
#      menu associated list.  A menu entry is created locally to
#      access this subdirectory menu.
#
#   2) If maxwin > #subdirs + local entries, then create menu entries for
#      each picture locally (append them to the local menu string.)
#      Else, create as many sub menu entries (add them to this current
#      string) as is necessary to fit in the local pictures.  Do this
#      by splitting up the list into lists maxentries long.  Each list
#      is given to a different routine that creates that menu and a
#      f.menu entry is create in the current menu string for that new
#      menu.

###
#
#  This routine is expected to create a full menu spec that will be
#  placed in the global main menu assoc list.
#
#  It is recursive in nature, in that it may call itself in creating
#  it's own subdirectories.
#
#  The arguments it must receive are: directory path & menu name.
###
sub recurse_menu
{
    local($directory, $menu_name) = @_;
    local($menu_spec, @dirs, @images);

    $menu_spec = "Menu $menu_name\n{\n";

    # This section first reads in all directory entries that are
    # directories themselves, but aren't named '.' or '..' (but it
    # does get hidden directories).  It then reads in all binary
    # non-directories.

    &DBG("Changing to $directory\n");

    chdir($directory) || die "Why can't I cd to $directory?\n";

    opendir(THIS, ".") ||
    die "Hey, why can't I open this directory: $directory!\n";

    @dirs = sort(grep(-d && !/^\.{1,2}$/, readdir(THIS)));
    rewinddir(THIS);
    @images = sort(grep(-B && ! -d, readdir(THIS)));
    closedir(THIS);

    #
    #  For the time being I'm not going to worry about having more
    #  than 30 directories.  Thus, this little bugger.
    die "Whooaa, dude!  You've got a directory ($directory)\nthat contains more than $max_num_rows subdirectories!\nI just can't deal with that, dude!  I'm outta here!\n" if @dirs > $max_num_rows;

    #
    #  NOTICE!!!!!!!!!!
    #   The following piece of code contains one gotcha.  It creates
    #   menus base on the current dir name.  It doesn't bother to
    #   check on whether or not another menu has already used that dir
    #   name.  In other words, there's a problem if you have two
    #   different directories in your tree that have the same local name.
    #
    foreach $dir (@dirs)
    {
    $menu_spec .= "$dir\tf.menu $dir\n";
    &recurse_menu("$directory/$dir", $dir);

    }

    if (@images + @dirs > $max_num_rows)
    {
    $index=1;

    while(@images)
    {
        $menu_spec .= "\"$dir$index\"\tf.menu \"$dir$index\"\n";
        &create_simple_menu($dir.$index, $directory,
                splice(@images, 0, $max_num_rows));
        $index++;
    }

    }
    else
    {
    for $image (@images)
    {
        $menu_spec .= "\"$image\"\tf.exec \"$display_cmd $directory/$image\"\n";
    }
    }
    $menu_spec .= "}\n\n";
    $main_menu_list{$menu_name} = $menu_spec;
}


###
#
#  This routine only creates a single menu of picture entries as given
#  to it.  Arguments are
#
#         1) name of the menu and
#         2) directory
#      rest) images
#
###
sub create_simple_menu
{
    local($mname, $directory, @images)=@_;
    local($menu_spec, $image);

    &DBG("Creating menu spec $mname with %d entries\n", $#images+1);

    $menu_spec = "Menu $mname\n{\n";

    for $image (@images)
    {
    $menu_spec .= "\"$image\" f.exec \"$display_cmd $directory/$image\"\n";
    }

    $menu_spec .= "}\n\n";

    $main_menu_list{$mname} = $menu_spec;
}


###########################################################################
#
#   A little routine for printing debug statements...
#

sub DBG
{
    local(@list) = @_;

    print "DEBUG #####################################################################\n" if $debug;
    printf(@_) if $debug;
    print "DEBUG #####################################################################\n" if $debug;
}
#    ________________________________________________________________________
#   /                                    |                                   \
#  |   Drew Mills                        | Mail Stop: IW17A6                  |
#  |   Cartographic Applications         | E-Mail:    [e-mail] |
#  |   Intergraph Corporation            | Telephone: [phone]          |
#  |   Huntsville, Alabama  35894-0001   | FAX:       [phone]          |
#  |--------------------------------------------------------------------------|
#  |                   ...Consider yourself a disclaimee                      |
#   \________________________________________________________________________/
#