cgit.sxemacs.org Git - packages/blob - xemacs-packages/idlwave/idlwave_catalog

   1 #!/usr/bin/perl -w
   2 #
   3 # idlwave_catalog
   4 #
   5 # Program to create IDLWAVE library catalogs.
   6 #
   7 # (c) 2002-2003 J.D. Smith <jdsmith@as.arizona.edu>
   8 #
   9 # Scans all IDL ".pro" files at the current level and recursively in
  10 # all directories beneath it, compiling a catalog of information for
  11 # each directory with any routines found, stored in a file named
  12 # ".idlwave_catalog".  Any such "library catalogs" on the IDL path
  13 # will be automatically loaded into IDLWAVE.
  14 #
  15 # Usage: idlwave_catalog  [-l] [-v] [-d] [-s] [-f] [-h] libname
  16 #        libname - Unique name of the catalog (4 or more alphanumeric
  17 #                  characters -- only 10 will be shown in routine info).
  18 #             -l - Scan local directory only, otherwise recursively
  19 #                  catalog all directories at or beneath this one.
  20 #             -v - Print verbose information.
  21 #             -d - Instead of scanning, delete all .idlwave_catalog files
  22 #                  here or below.
  23 #             -s - Be silent.
  24 #             -f - Force overwriting any catalogs found with a different
  25 #                  library name.
  26 #             -h - Print this usage.
  27 #
  28 # You can arrange to have this script run automatically to update
  29 # libraries which change frequently.  The name will be used to refer
  30 # to the routines collectively, so make it unique and descriptive
  31 # (without spaces).  E.g. "NasaLib".  A file named .idlwave_catalog
  32 # will be created in each directory with ".pro" routine files.
  33 #
  34 # $Id: idlwave_catalog,v 1.1 2003-08-12 12:26:18 dominik Exp $
  35
  36 use Getopt::Std;
  37 $opt_l=$opt_s=$opt_f=$opt_v=$opt_d=$opt_h=0;
  38 getopt('');
  39 $opt_v=0 if $opt_s;
  40
  41 usage() if $opt_h;
  42
  43 unless ($opt_d) {
  44   $libname=shift or usage();
  45   if (length($libname)<=3 or ($libname=~tr/A-Za-z0-9_//c)) {
  46     die
  47       "LibName must be alphanumeric, >3 characters, and contains no spaces.\n"
  48     }
  49 }
  50
  51 $cat=".idlwave_catalog";
  52
  53 unless ($opt_l) {
  54   use File::Find;
  55   find(sub{
  56          if (/\Q$cat\E$/) {
  57            if ($opt_d) {
  58              if (unlink $_) {
  59                print "Removing catalog $File::Find::name\n" if $opt_v;
  60              } else {
  61                warn "Can't remove catalog $File::Find::name: $!\n"
  62                  unless $opt_s;
  63              }
  64            } else {
  65              $dirs{$File::Find::dir}{cat}=libname($_);
  66            }
  67            return;
  68          }
  69          return if $opt_d;
  70          return unless -f and /\.pro$/i;
  71          parsefile($File::Find::dir, $_);
  72        }, '.');
  73 } else { #Just process the local directory
  74   opendir(DIR,".") || die "Can't open this directory: $!";
  75   if (-f $cat) {
  76     if ($opt_d) {
  77       if (unlink $cat) {
  78         print "Removing catalog $cat\n" if $opt_v;
  79       } else {
  80         warn "Can't remove catalog $cat: $!\n" unless $opt_s;
  81       }
  82     } else {
  83       $dirs{"."}{cat}=libname($cat);
  84     }
  85   }
  86   unless($opt_d) {
  87     foreach (grep {-f and /\.pro$/i} readdir(DIR)) {
  88       parsefile(".",$_);
  89     }
  90   }
  91   closedir DIR;
  92 }
  93
  94 exit if $opt_d;  #Nothing more to do
  95
  96 foreach $dir (keys %dirs) {
  97   print "Cataloging $dir\n" if $opt_v;
  98
  99   if (exists $dirs{$dir}{cat} && $dirs{$dir}{cat} ne $libname) {
 100     if ($opt_f) {
 101       warn "Overwriting existing \"$dirs{$dir}{cat}\" catalog in " .
 102         ($dir eq "."?"this directory":$dir) . ".\n" unless $opt_s;
 103     } else {
 104       warn "Skipping existing \"$dirs{$dir}{cat}\" catalog in " .
 105         ($dir eq "."?"this directory":$dir) .
 106           " (-f overrides).\n" unless $opt_s;
 107       next;
 108     }
 109   }
 110
 111   unless (open CATALOG, ">$dir/$cat") {
 112     warn "Can't open catalog file $dir/$cat for writing... skipping\n";
 113     next;
 114   }
 115   $time=localtime();
 116   print CATALOG <<EOF;
 117 ;;
 118 ;; IDLWAVE catalog for library $libname
 119 ;; Automatically Generated -- do not edit.
 120 ;; Created by idlwave_catalog on $time
 121 ;;
 122 (setq idlwave-library-catalog-libname "$libname")
 123 (setq idlwave-library-catalog-routines
 124 EOF
 125   print CATALOG " '(".join("\n   ",@{$dirs{$dir}{pro}});
 126   print CATALOG "))\n";
 127
 128 }
 129
 130 if($opt_v && !%dirs) {
 131   print $opt_l?"Current directory contains no .pro files.\n":
 132     "No directories with .pro files found.\n";
 133 }
 134
 135 sub parsefile {
 136   my ($dir,$file)=@_;
 137   my ($call,@kwds,@args,@entries);
 138   open FILE, $file;
 139   while (<FILE>) {
 140     next unless
 141       /^[ \t]*(pro|function)[ \t]+(?:([a-zA-Z0-9\$_]+)::)?([a-zA-Z0-9\$_]+)/i;
 142     ($type,$class,$name)=(lc($1) eq "pro"?"pro":"fun",$2,$3);
 143     $call="";
 144     @kwds=@args=();
 145     while (/[ \t]*\$\s*(;.*)?[\r\n]+/) { # Continuations
 146       $call.=$`;
 147       $_=<FILE>;
 148       while (/^\s*(;.*)?[\r\n]+/) {$_=<FILE>} #skip blank or comment lines
 149     }
 150     s/\s*(;.*)?[\r\n]+//;
 151     $call.=$_;
 152     while($call=~/,\s*([a-zA-Z][a-zA-Z0-9\$_]*|(?:_ref)?_extra)\s*(=)?/gi) {
 153       if ($2) {
 154         push @kwds, $1;
 155       } else {
 156         push @args, $1;
 157       }
 158     }
 159     $is_func=$type eq "fun";
 160     @kwds=sort {lc($a) cmp lc($b)} @kwds;
 161
 162     # Name type class
 163     push @{$dirs{$dir}{pro}},
 164       qq{("$name" $type } . ($class?qq("$class"):"nil") .
 165         # Source (source-type file dir library-name)
 166         qq< (lib "$file" nil "$libname") > .
 167           #Calling sequence
 168           '"' . ($is_func?"Result = ":"") . ($class?'Obj ->[%s::]':"") . '%s' .
 169             # Argument list
 170             (@args?($is_func?"(":", ") .
 171              join(", ",@args) .
 172              ($is_func?')':""):"") . '"' .
 173                # Keywords
 174                ' (nil' . (@kwds?' ("'.join('") ("', @kwds).'")':"") . "))";
 175   }
 176   close FILE;
 177   return
 178
 179 }
 180
 181 sub libname {
 182   my $file=shift;
 183   open FILE, $file;
 184   while (<FILE>) {
 185     return $1 if /\(setq idlwave-library-catalog-libname "([^"]+)"\)/;
 186   }
 187   "";
 188 }
 189
 190 sub usage {
 191   print <<EOF;
 192 Usage: idlwave_catalog  [-l] [-v] [-d] [-s] [-f] [-h] libname
 193        libname - Unique name of the catalog (4 or more alphanumeric
 194                  characters -- only 10 will be shown in routine info).
 195             -l - Scan local directory only, otherwise recursively
 196                  catalog all directories at or beneath this one.
 197             -v - Print verbose information.
 198             -d - Instead of scanning, delete all .idlwave_catalog files
 199                  here or below.
 200             -s - Be silent.
 201             -f - Force overwriting any catalogs found with a different
 202                  library name.
 203             -h - Print this usage.
 204 EOF
 205   exit;
 206 }
 207