Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 215 lines (197 sloc) 6.327 kB
#!/usr/bin/perl -w
#
# idlwave_catalog
#
# Program to create IDLWAVE library catalogs.
#
# (c) 2002-2004 J.D. Smith <jdsmith@as.arizona.edu>
#
# Scans all IDL ".pro" files at the current level and recursively in
# all directories beneath it, compiling a catalog of information for
# each directory with any routines found, stored in a file named
# ".idlwave_catalog". Any such "library catalogs" on the IDL path
# will be automatically loaded into IDLWAVE.
#
# Usage: idlwave_catalog [-l] [-v] [-d] [-s] [-f] [-x PATTERN] [-h] libname
# libname - Unique name of the catalog (4 or more alphanumeric
# characters -- only 10 will be shown in routine info).
# -l - Scan local directory only, otherwise recursively
# catalog all directories at or beneath this one.
# -v - Print verbose information.
# -d - Instead of scanning, delete all .idlwave_catalog files
# here or below.
# -s - Be silent.
# -f - Force overwriting any catalogs found with a different
# library name.
# -x - Skip directories matching the passed pattern
# -h - Print this usage.
#
# You can arrange to have this script run automatically to update
# libraries which change frequently. The name will be used to refer
# to the routines collectively, so make it unique and descriptive
# (without spaces). E.g. "NasaLib". A file named .idlwave_catalog
# will be created in each directory with ".pro" routine files.
#
# $Id: idlwave_catalog,v 1.5 2004/10/13 20:34:07 jdsmith Exp $
use Getopt::Std;
$opt_l=$opt_s=$opt_f=$opt_v=$opt_d=$opt_h=0;
getopt('x');
$opt_v=0 if $opt_s;
usage() if $opt_h;
unless ($opt_d) {
$libname=shift or usage();
if (length($libname)<=3 or ($libname=~tr/A-Za-z0-9_//c)) {
die
"LibName must be alphanumeric, >3 characters, and contains no spaces.\n"
}
}
$cat=".idlwave_catalog";
unless ($opt_l) {
use File::Find;
find(sub{
if (/\Q$cat\E$/) {
if ($opt_d) {
if (unlink $_) {
print "Removing catalog $File::Find::name\n" if $opt_v;
} else {
warn "Can't remove catalog $File::Find::name: $!\n"
unless $opt_s;
}
} else {
$dirs{$File::Find::dir}{cat}=libname($_);
}
return;
}
return if $opt_d;
return unless -f and /\.pro$/i;
parsefile($File::Find::dir, $_);
}, '.');
} else { #Just process the local directory
opendir(DIR,".") || die "Can't open this directory: $!";
if (-f $cat) {
if ($opt_d) {
if (unlink $cat) {
print "Removing catalog $cat\n" if $opt_v;
} else {
warn "Can't remove catalog $cat: $!\n" unless $opt_s;
}
} else {
$dirs{"."}{cat}=libname($cat);
}
}
unless($opt_d) {
foreach (grep {-f and /\.pro$/i} readdir(DIR)) {
parsefile(".",$_);
}
}
closedir DIR;
}
exit if $opt_d; #Nothing more to do
foreach $dir (keys %dirs) {
if ($opt_x and $dir=~/$opt_x/) {
print "Skipping $dir\n" if $opt_v;
next;
}
next if !defined($dirs{$dir}{pro}) || !$dirs{$dir}{pro};
print "Cataloging $dir\n" if $opt_v;
if (exists $dirs{$dir}{cat} && $dirs{$dir}{cat} ne $libname) {
if ($opt_f) {
warn "Overwriting existing \"$dirs{$dir}{cat}\" catalog in " .
($dir eq "."?"this directory":$dir) . ".\n" unless $opt_s;
} else {
warn "Skipping existing \"$dirs{$dir}{cat}\" catalog in " .
($dir eq "."?"this directory":$dir) .
" (-f overrides).\n" unless $opt_s;
next;
}
}
unless (open CATALOG, ">$dir/$cat") {
warn "Can't open catalog file $dir/$cat for writing... skipping\n";
next;
}
$time=localtime();
print CATALOG <<EOF;
;;
;; IDLWAVE catalog for library $libname
;; Automatically Generated -- do not edit.
;; Created by idlwave_catalog on $time
;;
(setq idlwave-library-catalog-libname "$libname")
(setq idlwave-library-catalog-routines
EOF
print CATALOG " '(".join("\n ",@{$dirs{$dir}{pro}});
print CATALOG "))\n";
}
if($opt_v && !%dirs) {
print $opt_l?"Current directory contains no .pro files.\n":
"No directories with .pro files found.\n";
}
sub parsefile {
my ($dir,$file)=@_;
my ($call,@kwds,@args,@entries);
open FILE, $file;
while (<FILE>) {
next unless
/^[ \t]*(pro|function)[ \t]+(?:([a-zA-Z0-9\$_]+)::)?([a-zA-Z0-9\$_]+)/i;
($type,$class,$name)=(lc($1) eq "pro"?"pro":"fun",$2,$3);
$call="";
@kwds=@args=();
while (/[ \t]*\$\s*(;.*)?[\r\n]+/) { # Continuations
$call.=$`;
$_=<FILE>;
while (/^\s*(;.*)?[\r\n]+/) {$_=<FILE>} #skip blank or comment lines
}
s/\s*(;.*)?[\r\n]+//;
$call.=$_;
while($call=~/,\s*([a-zA-Z][a-zA-Z0-9\$_]*|(?:_ref)?_extra)\s*(=)?/gi) {
if ($2) {
push @kwds, $1;
} else {
push @args, $1;
}
}
$is_func=$type eq "fun";
@kwds=sort {lc($a) cmp lc($b)} @kwds;
# Name type class
push @{$dirs{$dir}{pro}},
qq{("$name" $type } . ($class?qq("$class"):"nil") .
# Source (source-type file dir library-name)
qq< (lib "$file" nil "$libname") > .
#Calling sequence
'"' . ($is_func?"Result = ":"") . ($class?'Obj ->[%s::]':"") . '%s' .
# Argument list
(@args?($is_func?"(":", ") .
join(", ",@args) .
($is_func?')':""):"") . '"' .
# Keywords
' (nil' . (@kwds?' ("'.join('") ("', @kwds).'")':"") . "))";
}
close FILE;
return
}
sub libname {
my $file=shift;
open FILE, $file;
while (<FILE>) {
return $1 if /\(setq idlwave-library-catalog-libname "([^"]+)"\)/;
}
"";
}
sub usage {
print <<EOF;
Usage: idlwave_catalog [-l] [-v] [-d] [-s] [-f] [-h] [-x PATTERN] libname
libname - Unique name of the catalog (4 or more alphanumeric
characters -- only 10 will be shown in routine info).
-l - Scan local directory only, otherwise recursively
catalog all directories at or beneath this one.
-v - Print verbose information.
-d - Instead of scanning, delete all .idlwave_catalog files
here or below.
-s - Be silent.
-f - Force overwriting any catalogs found with a different
library name.
-x - Skip directories matching the passed pattern.
-h - Print this usage.
EOF
exit;
}
Jump to Line
Something went wrong with that request. Please try again.