branch: externals/idlwave commit 730fb31d4c11dd0a7e2394849d6a7d12a8882ac6 Author: jdsmith <jdsmith> Commit: jdsmith <jdsmith>
- Removed in favor of get_html_rinfo --- get_rinfo | 2510 ------------------------------------------------------------- 1 file changed, 2510 deletions(-) diff --git a/get_rinfo b/get_rinfo deleted file mode 100755 index ab9d54af49..0000000000 --- a/get_rinfo +++ /dev/null @@ -1,2510 +0,0 @@ -#!/usr/bin/perl -# -# Program to extract the information from the IDL manuals and IDL to -# support IDLWAVE. -# (c) 1999, 2000 Carsten Dominik <domi...@astro.uva.nl> -# (c) 2001, 2002 J.D. Smith <jdsm...@as.arizona.edu> -# -# Needs the PDF documentation files distributed with IDL 5.4 or later. -# -# Uses `pdftotext' by Derek B. Noonburg in order to convert the PDF -# files to ASCII. -# -# Talks to the local version of IDL in order to get additional information. -# -# Call this program from the command line like this: -# -# get_rinfo -path path/to/pdffiles/ --idl /path/to/idl/executable -# -# This will convert the PDF files to ASCII, extract routine information, -# talk to IDL and write the following files which are needed by IDLWAVE: -# -# idlw-rinfo.el: Routine information for completion etc. -# idlw-help.txt: ASCII version of the IDL documantation -# idlw-help.el: Supporting code and pointers to topics in idlw-help.txt. - -# The full manpage of this program is available with "perldoc get_rinfo". - -# Commentary: -# =========== -# -# IDL currently contains more than 1200 functions, procedures and object -# methods with more than 5000 keywords. In order to support writing IDL -# programs, the IDLWAVE mode uses a list of routines and keywords. RSI -# does not provide such a list in machine-readable form. Therefore this -# program embarks on the task to extract the necessary information from -# available sources - the IDL manuals which are supplied by RSI in PDF -# format. GET_RINFO works by looking for the "Syntax" sections and -# extracting information from there. -# -# Note that this program depends strongly upon the standards for writing -# documentation that are used by RSI. So it is only as robust as these -# standards are. For example, the syntax descriptions changed considerably -# between IDL 5.2 and IDL 5.3, and I had to rewrite :-( -# -# The program extracts information from manuals written by humans (the -# documentation department at RSI). Naturally, such documents are not -# always complete, consistent or free of typos. As a result of this, the -# list of routines and keywords extracted from the manuals will not be -# perfect. In order to cover for incorrect or inconsistent "Syntax" -# entries in the manual, get_rinfo contains a number of special matchers -# which detect specific entries and try to correct. See the definition of -# %specials in the BEGIN block. When a new version of IDL is released, -# the actions of these special matchers needs to be checked, because the -# involved syntax entries may have changed. -# -# Please contact the maintainer if you find any inconsistencies between -# the routine information supplied by IDLWAVE, and the IDL documentation. -# -# Get_rinfo also produces an ASCII version of the IDL documentation -# and a topics file which can be used to display full online help for -# system routines. See the IDLWAVE documentation for details. -# -# Acknowledgement: -# ================ -# -# Without Perl, the task of reverse-engineering thousands of pages of -# documentation would have been impossible. With Perl, it only takes a -# small program like this. Thanks to Larry Wall and the Perl community. -# -# Thanks to Mark Goosman from RSI for granting me permission to -# extract and distribute routine information from the IDL manual, -# and to distribute an ASCII version of the manuals for online help. -# -# Maintainer Information: -# ======================= -# When a new version of IDL is published, the following things might need -# work in order to make the result of this program as good as possible. -# To find the corresponding places in the file, search for "UPDATE". -# -# 1. UPDATE: Files -# ------------- -# The names of the PDF files to be scanned for routine info and/or -# to be included into the online help file. RSI might have renamed -# or added or removed files. -# -# 2. UPDATE: Manual sections -# ----------------------- -# Each Routine description has many sections. The list can be extended -# when necessary - the better the list, the more accurate the parsing. -# -# 3. UPDATE: Special matchers -# ------------------------ -# The %specials hash contains all the special matchers which fix unusual -# or incorrect routine descriptions. They change the entry so that the -# parser does the right thing, or they add entries to special arrays. -# The first thing to do with a new version is to run get_rinfo with -# the -debug flag. Part of the output will be a list of all special -# matchers, with additional info how often the matcher matches, and -# if it did its actions correctly. Matchers which no longer match -# should be checked. Matchers which match, but do not act may be due -# to the fact that RSI fixed that particular entry. -# It is also possible that new special matchers have to be written for -# new entries - you need to check what is new in this version and if -# it is processed correctly. -# Read the documentation just before the definition of the %specials hash -# to find out how such a matcher must behave. -# -# 4. UPDATE: Statement regexp -# ------------------------ -# This is also a special matcher which makes sure that no routine -# info is produced by the syntax entries for IDL language -# constructs. As RSI adds new statements (as COMPILE_OPT in -# version 5.3 or SWITCH/BREAK/CONTINUE in version 5.4), this regexp -# must be extended to match the new statements as well. -# -# 5. UPDATE: Graphics Keywords Routines -# ---------------------------------- -# Routines that should have links to the GRAPHICS KEYWORDS section, -# because some of their keywords are described there. For many but -# not all routines, this can be detected automatically by looking -# for "Graphics Keywords" in the syntax entry. This list is a -# backup to make sure also those routines which do not have this -# magic cookie will get theirs links set. -# -# 5. UPDATE: Multi-Threading routines -# -------------------------------- -# Routines that should have links to the MULTI-THREADING keywords, -# as described in the documentation for routine CPU, because of -# their keywords are described there. As of IDL v5.5, these -# keywords were not covered in the main documentation, and instead -# were added using a fixup file. Future version of IDL should -# include links such as "Multi-threading keywords", analogous to -# "Graphics Keywords", but can still be listed as backup. -# -# 6. UPDATE: Special help topics -# --------------------------- -# Some words which can show up in IDL source code have special help topics -# associated with them. This Lisp association list links downcase -# versions of these words to the appropriate topics. Even if word and -# topic are the same, it must be mentioned here in order to trigger -# help on this word. If the word at point is not in this list, IDLWAVE -# checks for the local routine call and supplies help. -# -# 7. UPDATE: Group appendix topics -# ----------------------------- -# Here we group some appendix topics to a single large topic. -# The hash %group_topics associates the first topic in the group -# with the first topic which is no longer part of the group. -# The refguide.txt file needs to be checked if these borders are -# correct. Remember that GET_RINFO makes a topic of (almost) all lines -# which are not indented. -# -# It is certainly a good idea to look at a diff between the old and -# the new `idlw-rinfo.el' file. Comparing this with the "What's New" -# section from RSI should give hints where get_rinfo may have to be -# adapted. -# For more detailed info, run `get_rinfo' with the `-debug' flag and -# check the resulting files get_rinfo.cpl, get_rinfo.rej, and -# get_rinfo.log. -# -#============================================================================ - -require 5.004; - -# UPDATE: Files -# ------------- -# Set the default list of files to be scanned for routine info -# These are the files which contain "Syntax" descriptions. -@rifiles = ("refguide.pdf","datamine.pdf","obsolete.pdf"); -# "whatsnew55.pdf"); -#@rifiles= ("refguide.pdf"); - -# Set the list of files which will be used to create fast online help. -# More or less the same files as above, but you can leave out long -# files which have only one or two Syntax entries, like edg.pdf or -# insight.pdf. Leaving them out makes the help file smaller. -@olhfiles = ("refguide.pdf","datamine.pdf","obsolete.pdf"); -# "whatsnew55.pdf"); -#@olhfiles=("refguide.pdf"); -# Parse command line options and make file names -use Getopt::Long; -GetOptions("-debug" => \$debug, - "-path=s" => \$path, - "-idl=s" => \$idl, - "-nohelp" => \$nohelp, - "-nowrap" => \$nowrap, - "-txt" => \$usetxt, - "-maketxt" => \$maketxt, - "-xname=s" => \$ignore_name_re, - "-xclass=s" => \$ignore_class_re, - "-fixup=s" => \$fixup) - or usage(); - -# Always part of emacs now -$emacs=1; - -if (@ARGV) { - # File names are on the command line - print STDERR "Unrecognized command line args: @ARGV\n"; - exit(1); -} - -$idl = $idl || "idl"; - -# Compute the base names of file names -@ribases = map {file_basename($_)} @rifiles; -@olhbases = map {file_basename($_)} @olhfiles; - -# We must scan all files - thus combine the lists -@files = make_unique( (@rifiles,@olhfiles) ); - -# Compressed file extensions and decompressors -%compress = (".gz" => "gunzip -c", - ".bz2" => "bunzip2 -c", - ".Z" => "zcat"); - -# Establish default output file names -$rinfofile = "idlw-rinfo.el"; -$helpfile = "idlw-help.txt"; -$topicsfile = "idlw-help-topics.el"; - -# Establish default for the wrap width -$wrapwidth = 65; - -# The program which converts pdf to text -$pdftotext = "pdftotext"; - -# Check the path -$path ||= "."; -die "Invalid path $path\n" unless !$path || -d $path; - -if ($maketxt) { - warn "Only converting pdf to ascii\n"; - foreach $file (@files) { - convert_pdf_to_text($path,$file); - } - exit(0); -} - -if ($usetxt) { - # Look for txt files instead of pdf files - @files = map {textname($_)} @files; -} - -# Check if the files exist. If not, try compression suffixes. -foreach $file (@files) { - $file = find_file($path,$file); -} - -%routines = (); - -# Open the REJECT and LOG files file for debugging information -if ($debug) { - open REJECT, ">get_rinfo.rej" or die "Cannot write to get_rinfo.rej\n"; - open COMPLAIN,">get_rinfo.cpl" or die "Cannot write to get_rinfo.cpl\n"; - open LOG, ">get_rinfo.log" or die "Cannot write to get_rinfo.log\n"; -} - -# Do this here so help files can -open_help_file() unless $nohelp; - -# Open the lisp file for output -open RINFO,">$rinfofile" or die "Cannot open $rinfofile for write\n"; - -read_fixup() if $fixup; - -# Scan the different files -foreach $file (@files) { - - $file_basename = file_basename($file); - $isri = grep {/^$file_basename$/} @ribases; - $isolh = grep {/^$file_basename$/} @olhbases; - - # Read the file into a string, and make a second copy - $text = read_manual_file($path,$file); - - # Find the version number - if ($text =~ /IDL\s+Version\s+(\d+\.\d+)/) { - $version = $1; - $idlversion = $version if $version > $idlversion; - } - - # Remove Table of Contents and Index. - $text =~ s/^.*\nContents\s+[^\n]*\n\n\f\n\n//s; - $text =~ s/\f\s+\nIndex.*$//s; - - # Remove headers and footers and newpage stuff. We remove the line - # with ^L, at least 2 lines before and after it, and any additional - # empty lines around it. Regular expressions rule! - $text =~ s/\n+.*\n.*\n *\f *\n.*\n.*\n+/\n/gm; - - # Collapse multiple empty lines - $text =~ s/(^\s*\n){3,}/\n\n/mg; - - # Split the string at "Syntax", to seperate the modules. - # This seems to be more robust than splitting at the section titles - # (which would be more correct), because sometimes the section title - # contains not only the routine name but extra stuff, for example - # `(VMS only)'. In this way, the part of the description before the - # "Syntax" paragraph becomes part of the string for the preceeding - # routine. However, this information is not used, so we can live - # with this problem. - @modules = split(/(?=^ *Syntax *$)/im,$text); - printf STDERR " %4d locations\n", $#modules; - $files_string .= sprintf(";; %6d syntax entries in file %s\n", - $#modules,$file); - - if ($file =~ /datamine/i && $#modules == 0) { - # Unsuccessful datamine scan - add 5.2 entries by hand - # FIXME: This should only be necessary in IDL 5.3 - local $debug = 1; - diag("Scanning $file did not produce any entries\n"); - add_datamine_entries(); - } - if ($file =~ /insight/i && $#modules == 0) { - # Unsuccessful insight scan - add 5.2 entries by hand - # FIXME: This should only be necessary in IDL 5.3 - local $debug = 1; - diag("Scanning $file did not produce any entries\n"); - add_insight_entries(); - } - - # UPDATE: Manual sections - # ----------------------- - # The sections of each routine description that we know of and want to - # use. There might be more. This listing should be as complete as - # possible, mainly in order to have the "Syntax" section terminated - # where it should. - %sections = ("Syntax" => "call", - "Arguments" => "args", - "Return [vV]alue" => "return", - "Keywords?" => "kwds", - "Examples?" => "examples", - "Using [a-zA-Z0-9_]+" => "using", - "See Also" => "see"); -# "Graphics Keywords Accepted" => "graphics"); - - # Make a regexp matching these, making sure to save everything. - $section_re = ("(?=^ *(?:" . join('|',keys %sections) . ") *\$)"); - - SYNTAX: - foreach $txt (@modules) { - # Special check -- add fixup system variables if need be - if ($fixup && exists $fix{sysvars} && $txt=~/^System Variables\s*$/mi && - !$fix{sysvars}{matched}) { - $fix{sysvars}{matched}=1; - # Insert the system variables just after the heading. - my $heading_off=length($`)+length($&); - my $rest=$'; - # Add in all the sysvars, either as update, or not. - diag("Adding system variable: \n ".join(",",keys %{$fix{sysvars}}). - "\n"); - foreach $sysvar (sort keys %{$fix{sysvars}}) { - next unless $sysvar=~/^\!/; - diag("Matching sysvar: $sysvar\n"); - if ($rest=~/^\s*\Q$sysvar\E\s*$/m) { - my $sysv_off=length($`)+length($&); - @last=split(/(?:\n)/,$`); - @last=@last[$#last-10..$#last]; - diag("$sysvar: Matched past: $&\n".join("\n",@last)."\n"); - (my $ws)=substr($rest,$sysv_off)=~/\n+( +)/; - fixup_whitespace(\$fix{sysvars}{$sysvar},$ws); - substr($txt,$heading_off+$sysv_off,0)="\n$fix{sysvars}{$sysvar}"; - } else { #Just stick it in after the "System Variables" heading. - substr($txt,$heading_off,0)= - " $sysvar\n$fix{sysvars}{$sysvar}\n"; - } - $rest=substr($txt,$heading_off); - } - } - - next SYNTAX unless $txt =~ /\A *Syntax/; - # Split into the standard sections - @parts = split(/$section_re/mo,$txt); - %parts = %region = (); - my $offset=0; - foreach $part (@parts) { - SECTION: - foreach $re (keys %sections) { - if ($part =~ /^ *$re *$/mi) { - $parts{$sections{$re}} = $part; - # save the byte offset into $txt and length for each section - $region{$sections{$re}} = [$offset,length($part)]; - last SECTION; - } - } - $offset+=length($part); - } - - # Clear a few variables which are used by deeper routines to return stuff - @rejects = (); - @complains = (); - @enter = (); - - # Look at the Syntax section and get the info - # ------------------------------------------- - - $syntax = $parts{call}; - - # It would be good to have a better way to determine where the - # Syntax section ends. Looking at a change in indentation is a - # possibility, but since the indentation can change from page to - # page, it is not safe to actually use it. - - # Apply the special matchers - &try_specials(); - - # See if there are reasons to reject or complain about this entry - if (@rejects) { - # Reject - $n_rejections += scalar(@rejects); - reject($parts{call},$file,@rejects); - next SYNTAX; - } - if (@complains) { - # Keep, but complain - $n_complains += scalar(@complains); - complain($parts{call},$file,@complains); - } - - # Try to parse the entry - unless (parse_syntax($syntax)) { - # Make a note that this section could not be parsed and move on - # to the next syntax entry. - reject($parts{call},$file,("Could not be parsed")); - next SYNTAX; - } - - # Make the cases correct. - if ($class) { - $class = case_name("class",$class); - $name = case_name("method",$name); - } else { - $name = case_name("routine",$name); - } - - my $fname=make_full_name($class,$name); - - # If the special matchers have not set @enter, do it here - $enter[0] = [$name,$type,$class,$call] unless @enter; - - # See if any fix-ups match for this routine. - if ($fixup && exists $fix{$fname}) { - $fix{$fname}{matched}=1; - #Just put any notes at the beginning of the syntax entry. - if (exists $fix{$fname}{notes}) { - diag("FIXUP: $fname (notes)\n"); - if (exists $parts{call}) { - $parts{call}="\n$fix{$fname}{notes}\n\n$parts{call}"; - } else { - diag("Nowhere to put fixup notes for $fname.\n"); - } - } - - # Add keywords to keyword list, and parsed syntax - if (exists $fix{$fname}{kwds}) { - push @kwds,map(uc,keys %{$fix{$fname}{kwds}}); - if (exists $parts{call}) { - $keylist="[, ".join("] [, ",map(uc,keys %{$fix{$fname}{kwds}}))."]"; - # dumb approach: look for other keywords to put it with - $parts{call}=~ - s~(\[[^/\]]*/[^\]]*\] | # [ /KEY ] - \[[^=\]]*=[^\]]*\]) # [ KEY=`val' ] - ~$keylist $1~sx || - $parts{call}=~s/(${fname}\s*[,\(].*?)(\)|$)/$1$keylist$2/mi; - } - } - - # Modify syntax section of help, and calling sequence(s) - if (exists $fix{$fname}{args} and exists $parts{call}) { - foreach $arg (sort keys %{$fix{$fname}{args}}) { - # Don't add it if it's already there... - # Watch our for args like Di, standing for D1 ... DN - (my $matcharg=$arg)=~s/([A-Z])i$/$1[0-9]/; - next if $enter[0][3]=~/(,|\() *$matcharg/i; - # Add arguments to the pre-built calling sequence... - foreach $a (@enter) { - diag("Adding to calling sequence\n<$$a[3]\n"); - $$a[3]=~s/(\)|$)/,$arg$1/m; - diag(">$$a[3]\n"); - } - # and to the help text itself, up front - $parts{call}=~s/($fname\s*[\(,]?)/$1$arg,/i; - } - } - - # Modify specific keyword/argument help documentation sections - foreach $type (qw(kwds args)) { - next unless exists $fix{$fname}{$type}; - diag("FIXUP: $fname (".scalar(keys %{$fix{$fname}{$type}}). - " $type -- ".join(",",keys(%{$fix{$fname}{$type}})).")\n"); - foreach $keyarg (sort keys %{$fix{$fname}{$type}}) { - if (exists $parts{$type}) { - diag("Adding to $type in existing part\n"); - diag("Checking for arg/key doc section: $keyarg (re: ^[ \t]*${keyarg}[ \t]*\$)\n"); - ## See if documentation for the keyword/argument exists already.... - if ($parts{$type}=~/^[ \t]*${keyarg}[ \t]*$/m) { - # Just prepend the new information to the existing section. - my $insertion_point=length($`)+length($&); - (my $ws)=($'=~m/\n+( +)/); - fixup_whitespace(\$fix{$fname}{$type}{$keyarg},$ws); - diag("Prepending to existing $type section\n"); - substr($parts{$type},$insertion_point,0)= - "\n$fix{$fname}{$type}{$keyarg}"; - } else { - ## It's a whole new entry.. add it first, after any heading. - diag("Adding entire new $keyarg section\n"); - if ($parts{$type}=~ - /^ *(?:Keywords?|Arguments) *$/m) { - my $insertion_point=length($`)+length($&); - (my $ws)=($'=~m/\n+( +)/); - diag("Adding using ==>$ws<==\n"); - fixup_whitespace(\$fix{$fname}{$type}{$keyarg},$ws); - substr($parts{$type},$insertion_point,0)= - "\n$ws$keyarg\n$fix{$fname}{$type}{$keyarg}"; - } - } - } else { # No such section part exists: make one up, with this entry. - diag("No $type section: making one.\n"); - if (exists $parts{call}) { - $parts{call}.="\n ".($type eq "kwds"?"Keywords":"Arguments"). - "\n $keyarg\n$fix{$fname}{$type}{$keyarg}\n\n"; - } - } - } - } - - # Update the actual raw text itself, if need be - my $extraoff=0; - foreach $part (sort {$region{$a}[0]<=>$region{$b}[0]} - qw(call args kwds)) { - next unless exists $parts{$part}; - if (length($parts{$part})>$region{$part}[1]) { - substr($txt,$extraoff+$region{$part}[0],$region{$part}[1])= - $parts{$part}; - $extraoff+=length($parts{$part}) - $region{$part}[1]; - } - } - } - - check_special_keywords($class,$name); - - # Write a message for debugging output - diag(sprintf("%-20s %-15s %-20s with %3d keywords\n", - $type,$class,$name,scalar(@kwds))); - - # Store the stuff. - foreach $a (@enter) { - my $name = $$a[0]; - my $class = $$a[2]; - my $type = $$a[1]; - if ($ignore_name_re && $name =~ /$ignore_name_re/o) { - diag("Ignoring name $name because of -xname option\n"); - $ignore_name_cnt++; - next; - } - if ($ignore_class_re && $class =~ /$ignore_class_re/o) { - diag("Ignoring name $name because of -xclass option\n"); - $ignore_class_cnt++; - next; - } - # Store only if this is a routine info scan file - if ($isri) { - push @{$e{$class}{$type}{$name}{kwds}},@kwds; - push @{$e{$class}{$type}{$name}{Get}},@getkwds; - push @{$e{$class}{$type}{$name}{Set}},@setkwds; - $e{$class}{$type}{$name}{call} = $$a[3]; - } - if ($has_special_keywords{Graphics}) { - push @{$extra_keyword_topics{lc($name)}},"graphics keywords"; - } - - # The threading keywords are documented in the CPU procedure. - if ($has_special_keywords{MultiThreading}) { - push @{$extra_keyword_topics{lc($name)}},"cpu"; - # FIXME: When the threaded-routines are finally documented, - # the following will be unnecessary. - push @{$e{$class}{$type}{$name}{kwds}}, - qw(TPOOL_MAX_ELTS TPOOL_MIN_ELTS TPOOL_NOTHREAD); - } - } - } continue { # Always write the help text, even if skipped. - write_help($txt) if $isolh && !$nohelp; - } -} -close_help_file(); -write_topics_file() unless $nohelp; - -# We have all the information now in one huge array. A few things -# still need to be fixed... - -# 1. The IDL manual lists for object methods GetProperty and -# SetProperty only an incomplete list of keywords. Additional -# keywords are documented under "Init" with a "Get" or "Set" -# marker. These were collected during scan - here we put them into -# the right space. - -foreach $class (keys %e) { - foreach $what ("Get","Set") { - $pname = case_name("method",$what."Property"); - $iname = case_name("method","Init"); - if (defined $e{$class}{fun}{$iname} && @{$e{$class}{fun}{$iname}{$what}}) { - push @{$e{$class}{pro}{$pname}{kwds}},@{$e{$class}{fun}{$iname}{$what}}; - } - } -} - -# 2. It is possible that some special matcher put in a request to add keywords -# of one routine to another. Since now we know all keywords and all -# routines, we can do so. - -foreach $add (@add_keywords) { - my ($name1,$type1,$class1,$name2,$type2,$class2,$nokeysref) = @$add[0..6]; - my %nokeys = (); - foreach (@$nokeysref) {$nokeys{$_}++;} - my @kwds = @{$e{$class2}{$type2}{$name2}{kwds}}; - foreach (@kwds) { - push @{$e{$class1}{$type1}{$name1}{kwds}},$_ unless $nokeys{$_}; - } -} - -# 3. Cleanup the keyword lists: make case correct, uniquify, and sort. -foreach $class (keys %e) { - foreach $type ("pro","fun") { - foreach $name (keys %{$e{$class}{$type}}) { - @{$e{$class}{$type}{$name}{kwds}} = - fix_keywords(@{$e{$class}{$type}{$name}{kwds}}); - } - } -} - -# Make the Lisp reader strings and count the routines and keywords -foreach $class (keys %e) { - foreach $type ("pro","fun") { - foreach $name (keys %{$e{$class}{$type}}) { - $n_routines_total++; - $call = $e{$class}{$type}{$name}{call}; - $book = $e{$class}{$type}{$name}{book}; - @kwds = @{$e{$class}{$type}{$name}{kwds}}; - $n_keywords_total += scalar(@kwds); - $routines{$class}{$type}{$name} = - make_lisp_reader_string($name,$type,$class,$call,$book,@kwds); - } - } -} - - -# Print debug information about how often each special matcher matched. -# Will only be visible in debugging mode. -diag("SPECIAL MATCHERS: [m]atched, [s]uccess, [f]ailed---------------------\n"); -foreach $key (sort ignoring_case keys %specials) { - diag(sprintf("Special matcher %-35s m:s:f %3d %3d %3d\n", - $key,$special_matcnt{$key},$special_actcnt{$key}, - $special_matcnt{$key}-$special_actcnt{$key})); -} -diag(sprintf("\nProblematic entries: %d rejected, %d complains.\n",$n_rejections,$n_complains)); - -if ($fixup) { - diag("\nFIXUP RESULTS:\n".("="x60)."\n"); - foreach $name (sort keys %fix) { - unless ($fix{$name}{matched}) { - diag(" No FIXUP match found for $name\n") - } else { -# diag(" FIXED $name\n"); - $fixcnt++ - } - } - diag(sprintf(" Fixed %d/%d\n",$fixcnt,scalar(keys %fix))); -} - - -# Write the lisp file -# Also write some statistics to STDERR -write_rinfo_header(); -print RINFO "(defconst idlwave-system-routines\n"; -print RINFO " '(\n"; -printf STDERR "\n Nr Class Npro Nfun Ntot Nkwd\n"; -printf STDERR "-------------------------------------------\n"; -$classcnt = -1; -foreach $class (sort ignoring_case keys %routines) { - $npro = scalar(keys %{$routines{$class}{"pro"}}); - $nfun = scalar(keys %{$routines{$class}{"fun"}}); - $nkwd = 0; - foreach $type ("pro","fun") { - foreach $name (keys %{$e{$class}{$type}}) { - $nkwd += scalar @{$e{$class}{$type}{$name}{kwds}} - } - } - $nprotot += $npro; - $nfuntot += $nfun; - $nclass++; - printf STDERR "%3d %-17s %4d %4d %4d %5d\n", - ++$classcnt,$class,$npro,$nfun,$npro+$nfun,$nkwd; - foreach $type ("pro","fun") { - foreach $module (sort ignoring_case keys %{$routines{$class}{$type}}) { - $entry = $routines{$class}{$type}{$module}; - print RINFO " $entry\n"; - } - } -} - -print STDERR "-" x 43,"\n"; -printf STDERR "Total %4d %4d %5d %5d\n", - $nprotot,$nfuntot,$nprotot+$nfuntot,$n_keywords_total; -printf STDERR "Routines ignored due to -xname: %4d\n",$ignore_name_cnt - if $ignore_name_re; -printf STDERR "Routines ignored due to -xclass: %4d\n",$ignore_class_cnt - if $ignore_class_re; -print RINFO <<EOF; - ) - "$n_routines_total builtin routines with $n_keywords_total keywords for IDL version $idlversion.") -EOF - -talk_to_idl(); -write_sysvar_info(); -write_classtag_info(); -write_rinfo_footer(); -close RINFO; - -printf STDERR "Wrote file $rinfofile (%4d kBytes)\n", (-s $rinfofile)/1000.; - - -# ========================================================================== -# ========================================================================== -# -# The subroutines - -sub usage { - # Print usage information - print STDERR <<EOF; -usage: get_rinfo [-txt] [-debug] [-nowrap] [-path DIR] - [-fixup FIXUP_FILE] [-xname REGEXP] [-xclass REGEXP] - [-idl /path/to/idl] - - get_rinfo -maketxt [-path DIR] -EOF - exit(1); -} - -sub diag { - # Write diagnosis to STDERR and to the LOG file if we are debugging. - my $msg = @_[0]; - if ($debug) { - print STDERR $msg; - print LOG $msg; - } -} - -sub reject { - # Write a message to the reject file. - my($string,$file,@reasons) = @_; - if ($debug) { - print REJECT (("-" x 100) . "\n") x 2; - print REJECT "File: $file\n"; - foreach $reason (@reasons) { - print REJECT "Reason: $reason\n"; - } - print REJECT (("- " x 30) . "\n"); - print REJECT $string; - } -} - -sub complain { - # Write a message to the reject file. - my($string,$file,@reasons) = @_; - if ($debug) { - print COMPLAIN (("-" x 100) . "\n") x 2; - print COMPLAIN "File: $file\n"; - foreach $reason (@reasons) { - print COMPLAIN "Reason: $reason\n"; - } - print COMPLAIN (("- " x 30) . "\n"); - print COMPLAIN $string; - } -} - -sub find_file { - # Find the file or a compressed version of it. - my($path,$file) = @_; - my $fullname = "$path/$file"; - return $file if -e $fullname; - foreach $ext (keys %compress) { - if (-e $fullname.$ext) { - warn "Only found compressed ($ext) version of $file\n"; - return $file.$ext; - } - } - die "No such file $file\n"; -} - -sub convert_pdf_to_text { - # Call pdftotext to convert a file. - my ($path,$file) = @_; - my $fullname = "$path/$file"; - unless (-e $fullname) { - warn "No such file $fullname\n"; - return 0; - } - print STDERR "Converting to ASCII: $fullname...\n"; - system("$pdftotext $fullname") == 0 - or warn "$pdftotext $fullname failed: $?\n"; -} - -sub read_manual_file { - # Return the entire manual file as a string. - my ($path,$name) = @_; - my $file = "$path/$name"; - my $ext = ($file =~ m|(\.[^\./]+)$|)[0]; - my $cmd; - my $decomp = $compress{$ext} || "cat"; - local $/; - - if ($file =~ m|\.txt\b[^/]*$|) { - $cmd = "$decomp $file|"; - open IN,$cmd or die "Cannot read $file\n"; - } elsif ($file =~ m|\.pdf\b[^/]*$|) { - if ($decomp eq "cat") { - $cmd = "$pdftotext $file -|"; - open IN,$cmd or die "Cannot read $file\n"; - } else { - die "Cannot read compressed pdf file $file\n"; - } - } else { - die "Something is wrong here with $file.\n"; - } - - printf STDERR "Scanning file %-20s",$file."..."; - - # Put everything in one big string and return the string - undef $/; - $txt=scalar(<IN>); - close IN; - if ($? != 0) {die "Conversion process `$cmd' failed\n"} - $txt; -} - -sub fix_keywords { - # Fix the case of keywords, sort and uniquify the list. - my @a; - @a = map { case_name("keyword",$_) } @_; - @a = make_unique(@a); - @a = sort ignoring_case @a; - @a; -} - -sub case_name { - # Return $name in a unique case. - # The first time this function gets called, the default casification - # is determined and stored. Later calls with same or different case only - # return this initial value. - my ($type,$name) = @_; - my $lcname = lc($name); - if ($debug) { - $origcase{$type}{$lcname} = $name unless defined $origcase{$type}{$lcname}; - if (defined $origcase{$type}{$lcname} && - $name ne $origcase{$type}{$lcname}) { - diag("CASECHANGE $type: old $origcase{$type}{$lcname}, new $name\n"); - } - } - - if (defined $casedname{$type}{$lcname}) { - return $casedname{$type}{$lcname}; - } else { - my $casedname; - if ($type eq "class" || $type eq "method") { - $casedname = $name; - } else { - $casedname = uc($name) - } - return $casedname{$type}{$lcname} = $casedname; - } -} - -sub check_special_keywords { - my ($class,$name) = @_; - my $fullname = uc(make_full_name($class,$name)); - foreach $special (keys %routines_with_special_keywords) { - if ( scalar(grep(/^$fullname$/, - @{$routines_with_special_keywords{$special}})) - && !$has_special_keywords{$special}) { - $has_special_keywords{$special} = 1; - complain($parts{call},$file, - ("$special Keywords not linked to $special Keywords Section")) - } - } -} - -sub make_full_name { - my ($class,$name) = @_; - ($class ? "$class" . "::" : "") . $name -} - -sub make_unique { - # make an array unique. - my @new; - my %seen; - foreach (@_) { - push @new,$_ unless $seen{$_}++; - } - @new; -} - -# for case-insensitive sorting.. -sub ignoring_case {lc($a) cmp lc($b)} - -sub textname { - # replace the pdf extension with .txt - my ($file) = @_; - $file =~ s/\.pdf$/.txt/; - $file; -} - -sub file_basename { - # return the basename of a file - my $file = @_[0]; - $file =~ s/\..*//; - $file; -} - -sub balanced_parens { - # Check if all parenthesis are balanced - my $string = $_[0]; - $string =~ tr/()[]{}//cd; - 1 while $string =~ s/\(\)|\[\]|\{\}//g; - $string eq ""; -} - -sub close_open_parens { - # Add all necessary closing parenthesis to the end if a string - my $rtn = $_[0]; - my $string = $_[0]; - $string =~ tr/()[]{}//cd; - 1 while $string =~ s/\(\)|\[\]|\{\}//g; - my $close = reverse($string); - $close =~ tr/([{/)]}/; - $rtn . $close; -} - -sub make_lisp_reader_string { - # Make a string which will be correctly interpreted by the Emacs Lisp reader - # as a lisp list containing all needed information about a routine. - my ($name,$type,$class,$call,$book,@keywords) = @_; - my $entry; - - # In the calling sequence we want `%s' instead of name and class. - # The calling sequence will later be used as format string to make - # a calling sequence with the correct version of class and name. - $call =~ s/^result/Result/; - if ($class) { - $call =~ s/(\[)($class)(:+)(\])($name)\b/$1%s$3$4%s$6/i; - } else { - $call =~ s/\b$name\b/%s/i; - } - - # Now we make the string which can be parsed by the Lisp reader - # It looks like this: - # ("NAME" TYPE "CLASS" (system) "CALLING SEQUENCE" ("KWD1" "KWD2"...)) - $entry = sprintf('(%-24s %3s %-19s', '"'.$name.'"', $type, - ($class eq "" ? "nil" : "\"$class\"")); - $entry .= " (system) \"$call\""; - if (@keywords) { - $entry .= ' (("' . join('") ("',@keywords) . '"))'; - } else { - $entry .= " nil"; - } - $entry .= ')'; - - # Return the entry - $entry; -} - -sub read_fixup { - # Read in fix-up file, add routines, with extra notes, arguments, - # and keywords, for inclusion into RInfo, Help, etc. - local $/; - undef $/; - my %types=("Notes"=>"notes", "Keywords" => "kwds", "Arguments"=>"args"); - open FIXUP, "<$fixup" or die "Can't open fixup file $fixup."; - my ($null, %routines,%parts,%subparts); - - ($null,%routines)=split(/^([A-Z][0-9A-Za-z:_ ]*\w)/m,<FIXUP>); - foreach $routine (keys %routines) { - # Handle System variables specially - if ($routine=~/System\s*Variables?/i) { - ($null,%parts)=split(/^ {5,}(\![A-Z0-9_]+)\s*$/m,$routines{$routine}); - foreach (keys %parts) { - trim_and_mark_fixup(\$parts{$_}); - $fix{sysvars}{$_}=$parts{$_}; - } - next; - } - - # Split entry into its parts - ($null,%parts)=split(/^ {2,}(Keywords|Arguments|Notes)\s*$/m, - $routines{$routine}); - foreach $part (keys %parts) { - next unless exists $types{$part}; # Keep only known section types - if ($part eq "Notes") { - trim_and_mark_fixup(\$parts{$part}); - $fix{$routine}{$types{$part}}=$parts{$part}; - next; - } - # Separate each keyword or argument. - ($null,%subparts)=split(/^ {5,}([A-Za-z_0-9]+)\s*$/m,$parts{$part}); - foreach (keys %subparts) { - trim_and_mark_fixup(\$subparts{$_}); - $fix{$routine}{$types{$part}}{$_}=$subparts{$_}; - } - } - } -} - -# Fixup whitespace to fit in with existing region -sub fixup_whitespace { - my ($txtref,$ws)=@_; - my @ws=($$txtref=~/^( +)/mg); - my $minws=9999; - map {$minws=length($_) if length($_)<$minws} @ws; - my $diff=length($ws)-$minws; - return if $diff==0; - if($diff>0) { #Add whitespace - my $newws=" "x$diff; - $$txtref=~s/^/$newws/mg; - } else { - $diff=-$diff; - $$txtref=~s/^ {$diff}//mg; - } -} - -# Trim leading newlines, final whitespace, and wrap in <NEW></NEW> -sub trim_and_mark_fixup { - my $txtref=shift; - $$txtref=~s/^\n+//s; - $$txtref=~s/\s+$//s; - $$txtref=~s/^( *)/$1<NEW>/; - $$txtref.="</NEW>"; -} - -sub try_specials { - # Try if any of the special matchers in %specials matches the current - # entry. - my($key,$sub); - foreach (keys %has_special_keywords) { $has_special_keywords{$_} = 0; } - SPECIAL: - foreach $key (sort keys %specials) { - $sub = $specials{$key}; - $act = 0; - $rtn = &$sub(); - if ($rtn) { - $special_matcnt{$key}++; - $special_actcnt{$key}++ if $act; - diag("Special $key matched. Count is $special_matcnt{$key}, $special_actcnt{$key}\n"); - next SPECIAL if $rtn == 1; - return 1; - } - } - return 0; -} - -# UPDATE: Special matchers -# ------------------------ -# The BEGIN block sets the array which contains special matchers. The -# hash keys are just strings identifying the matcher. The values are -# anonymous subroutines which work on the global variable $syntax -# which contains the full syntax entry. To fix a problem, the matcher -# may change the $syntax variable. -# The return value of a matcher must be 0, 1, or 2 -# 0: The matcher did not match the entry. -# 1: The matcher matched, but further matchers should be tried. -# 2: The matcher did match and no further matchers should be tried. - -# Matching should mean that the matcher found the entry it was supposed to -# find. When the entry is successfully changed, the matcher should also set -# the variable $act. As typos get fixed by RSI, some matchers will still -# match but not act - a sign that they can be removed from the %specials list. - -# Matchers of buggy entries should also push onto the @complains array -# an explanation why the matched entry is buggy. The result can later -# be mailed to RSI to make them fix the problem. - -# Some entries describe actually several routines, for example PRINT/PRINTF. -# The matcher must then place entries into the @enter array for each routine. -# Also in this case it will be necessary to tell the online help system -# that help for this routine is under a different topic - this is done -# with the @name_translations array - see the examples. - -# Finally, some routines do not list all the keywords, but just say -# "accepts all keywords accepted by PLOT" or so. See the SURFACE matcher -# for an example how to tell the system to add the corresponding keywords -# to the routine description as well. - -# When this program is being run with the -d flag, at the end a list -# will be shown which matcher was used how often. -BEGIN { - - # The following function prefixes the names of special matchers with - # numbers, to make sure they are called in the same sequence as - # specified here. - $cnt = 0; - sub sname {sprintf("%03d %s",++$cnt,$_[0])} - - # The hash with the matchers - %specials = - ( - - # ------------------------------------------------------------------ - # Some typos which occur globally in many entries ------------------ - # ------------------------------------------------------------------ - - sname("DASH") => - sub { - if ($syntax =~ /\255/) { - # A wrong character is being used as the dash. - $act = ($syntax =~ s/\255/-/g); - @complains,"Character \\255 used as dash (which is \\045)"; - 1; - } else {0} - }, - - sname("UNBANACED PARENTHESIS") => - sub { - if (! balanced_parens($syntax)) { - # A parenthesis is missing in the Syntax entry - push @complains, "Unbalanced parenthesis"; - 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # The explanation of what the "Syntax" entry is must be rejected --- - # ------------------------------------------------------------------ - - sname("SYNTAX") => - sub { - if ($syntax =~ /Syntax\s*The\s*"?syntax"?\s*section/si) { - # Ignore when Syntax is used to explain itself - push @rejects, "Rejecting SYNTAX section explanation."; - $syntax = ""; - $act = 2; - } else {0} - }, - - # ------------------------------------------------------------------ - # C Functions ------------------------------------------------------ - # ------------------------------------------------------------------ - - sname("C FUNCTION") => - sub { - if ($syntax =~ /\A\s*Syntax\s* - (int | - char | - void | - IDL_MEMINT | - IDL_FUN_RET | - IDL_VPTR | - Client - )\b - /xsi) { - push @rejects, "Seems to be a C routine"; - $syntax = ""; - $act = 2; - } else {0} - }, - - # ------------------------------------------------------------------ - # IDL statements --------------------------------------------------- - # ------------------------------------------------------------------ - - # UPDATE: Statement regexp - sname("IDL STATEMENT") => - sub { - if ($syntax =~ /\A\s*Syntax\s+ - (BEGIN \s+ statements | - CASE \s+ expression | - SWITCH \s+ expression | - BREAK \s+ | - CONTINUE \s+ | - COMMON \s+ Block_name | - COMPILE_OPT \s+ | - FORWARD_FUNCTION \s+ | - FOR \s+ variable | - FUNCTION \s+ Function_Name | - GOTO \s* , \s+ label | - IF \s+ expression | - PRO \s+ Procedure_Name | - REPEAT \s+ statement | - WHILE \s+ expression) - /ix) { - # Ignore - $syntax = ""; - push @rejects, "IDL control stucture."; - $act = 2; - } else {0} - }, - - # ------------------------------------------------------------------ - # Executive statements --------------------------------------------- - # ------------------------------------------------------------------ - - sname("IDL EXECUTIVE COMMAND") => - sub { - if ($syntax =~ /\A *Syntax\s*\.[A-Z]+/) { - # Command starts with a dot. Ignore it. - $syntax = ""; - push @rejects, "IDL executive command."; - $act = 2; - } else {0} - }, - - # ------------------------------------------------------------------ - # Entries which must produce several rinfo list entries ------------ - # ------------------------------------------------------------------ - - sname("CALL_METHOD") => - sub { - if ($syntax =~ /CALL_METHOD.*\bor\b.*CALL_METHOD/s) { - # Can be called as function or method - make 2 entries. - $enter[0] = ["CALL_METHOD","pro","","CALL_METHOD, Name, ObjRef, [, P1, ..., Pn]"]; - $enter[1] = ["CALL_METHOD","fun","","Result = CALL_METHOD, Name, ObjRef, [, P1, ..., Pn]"]; - $act = 1; - } else {0} - }, - - sname("OPEN") => - sub { - if ($syntax =~ /OPENR.*OPENW.*OPENU/s) { - # Make this 3 separate entries - $enter[0] = ["OPENR","pro","","OPENR, Unit, File [, Record_Length]"]; - $enter[1] = ["OPENW","pro","","OPENW, Unit, File [, Record_Length]"]; - $enter[2] = ["OPENU","pro","","OPENU, Unit, File [, Record_Length]"]; - $name_translations{OPENR} = "OPEN"; - $name_translations{OPENW} = "OPEN"; - $name_translations{OPENU} = "OPEN"; - $override_name="OPEN"; - $act = 1; - } else {0} - }, - - sname("READ") => - sub { - if ($syntax =~ /Syntax\s*READ, \[Prompt/si) { - # Make this 2 separate entries - $syntax =~ s/^[ \t]*READ,.*?\n//m; - $syntax =~ s/^[ \t]*READF,.*?\n/m/; - $enter[0] = ["READ","pro","","READ, [Prompt,] Var1, ..., Varn"]; - $enter[1] = ["READF","pro","","READF, [Prompt,] Var1, ..., Varn"]; - $name_translations{READ} = "READ/READF"; - $name_translations{READF} = "READ/READF"; - $act = 1; - } else {0} - }, - - sname("PRINT") => - sub { - if ($syntax =~ /Syntax\s*PRINT \[, Expr/si) { - # Make this two separate entries - $syntax =~ s/^[ \t]*PRINT .*?\n//m; - $syntax =~ s/^[ \t]*PRINTF .*?\n/m/; - $enter[0] = ["PRINT","pro","","PRINT [, Expr1, ..., Exprn]"]; - $enter[1] = ["PRINTF","pro","","PRINTF [, Unit, Expr1, ..., Exprn]"]; - $name_translations{PRINT} = "PRINT/PRINTF"; - $name_translations{PRINTF} = "PRINT/PRINTF"; - $act = 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # INIT and CLEANUP ------------------------------------------------- - # ------------------------------------------------------------------ - - sname("IDLcomIDispatch::Init") => - sub { - if ($syntax =~ /obj_new\('IDLcomIDispatch[^']*'\)/si) { - $syntax="Result = Obj -> [IDLcomIDispatch::]Init()"; - push @complains,"IDLcomIDispatch::Init syntax incorrectly formatted."; - 1; - } else {0} - }, - - sname("IDLcomIDispatch::SetProperty") => - sub { - if ($syntax =~ /IDLcomIDispatch -> (Get|Set)Property,(.*)$/si) { - - $syntax="Obj->[IDLcomIDispatch::]$1Property, $2"; - $syntax=~s/<(\w+)>/$1/g; - push @complains,"Syntax incorrectly formatted."; - 1; - } else {0} - }, - - sname("INIT & OBJ_NEW") => - sub { - if ($syntax =~ /.*Init.*\bor\b.*OBJ_NEW\b/s) { - # Mention only "Init", not OBJ_NEW in calling sequence - $act = ($syntax =~ s/\bor\b.*OBJ_NEW.*subclass.*?\)//s); - push @complains,"Most syntax entries for INIT methods list OBJ_NEW before INIT"; - 1; - } else {0} - }, - - sname("OBJ_NEW & INIT") => - sub { - if ($syntax =~ /\s*Syntax.*OBJ_NEW(.*)\bor\s*(Result\b.*Init.*)/si) { - # Mention only "Init", not OBJ_NEW in calling sequence - $syntax = "$2 $1"; # space needed to make line indented - $syntax =~ s/\([^\)]*in\s+a\s+subclass[^\)]*Init[^\)]*\)//i; - $syntax =~ s/Note[\sa-zA-Z.]*brevity\.//i; - $syntax =~ s/\n[ \t\n]*\n/\n/; - $act = 1; - } else {0} - }, - - sname("INIT MISSING") => - sub { -# if ($syntax =~ /OBJ_NEW\(\s*[\`\']([a-zA-Z0-9_]+)[\`\'](.*)\(Only\s+in\s+a\s+sub/) { #`) - if ($syntax =~ /OBJ_NEW\(\s*[\`\']([a-zA-Z0-9_]+)[\`\'](.*?)(\(Only\s+in\s+a\s+sub|\))/s) { #`) - my $class = $1; - my $args = $2; - $args =~ s/^(\s*\[\s*),/$1/; - $syntax = "Result = Obj -> [${class}::]Init($args)"; - push @complains,"INIT calling sequence missing"; - $act = 1; - } else {0} - }, - - sname("OBJ_DESTROY & CLEANUP") => - sub { - if ($syntax =~ /\s*Syntax.*OBJ_DESTROY,\s*Obj\s+or\s*(.*)/si) { - # Mention only "Cleanup" in calling sequence, not OBJ_DESTROY - $syntax = $1; - $syntax =~ s/\(\s*in\s+a\s+subclass[^)]*Cleanup[^)]*\)//i; - $act = 1; - } else {0} - }, - - sname("CLEANUP & OBJ_DESTROY") => - sub { - if ($syntax =~ /.*Cleanup.*\bor\b.*OBJ_DESTROY\b/si) { - # Mention only "Cleanup" in calling sequence, not OBJ_DESTROY - push @complains,"Most syntax entries for CLEANUP methods list OBJ_DESTROY before CLEANUP"; - $act = ($syntax =~ s/\bor\b.*OBJ_DESTROY.*subclass.*?\)//s); - 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # Cleaning up the calling sequence --------------------------------- - # ------------------------------------------------------------------ - - sname("ATAN") => - sub { - if ($syntax =~ /ATAN.*ATAN/s) { - # Write a simpler calling sequence - $syntax = "Result = ATAN([Y,] X)"; - $act = 1; - } else {0} - }, - - sname("DEVICE") => - sub { - if ($syntax =~ /\s*Syntax.*Note.*Each\s*keyword\s*to\s*DEVICE/si) { - # Remove the initial explanation - $act = ($syntax =~ s/(Syntax).*?DEVICE.*(DEVICE)/$1\n$2/s); - $syntax =~ s/\{.*?\}//sg; - 1; - } else {0} - }, - - sname("INTERPOL") => - sub { - if ($syntax =~ /For regular grids.*INTERPOL/i) { - # Simplify calling sequence - $act = ($syntax =~ s/^[ \t]*for irregular grids://mi); - $syntax =~ s/^[ \t]*for regular grids:.*?\n/Result = INTERPOL( V, N) or Result = INTERPOL\( V, X, U/mi; - 1; - } else {0} - }, - sname("WRITE_JPEG") => - sub { - if ($syntax =~ /\s*Syntax\s*WRITE_JPEG\b/si) { - # Remove the UNIT thing from the syntax - $act = ($syntax =~ s/\[,\s*Filename\s*\|\s*,\s*UNIT=lun\s*\](.*)/[, Filename]$1 [, UNIT=lun]/si); - $syntax =~ s/\{.*?\}//sg; - 1; - } else {0} - }, - sname("EXPAND_PATH") => - sub { - if ($syntax =~ /\A\s*Syntax\s*Result\s*=\s*EXPAND_PATH\s*\(/is) { - # Simplify calling sequence - $act = ($syntax =~ s/\n[ \t]*The Path Definition String.*//si); - 1; - } else {0} - }, - sname("PLOT") => - sub { # Missing keyword - if ($syntax =~ /\s*Syntax\s*PLOT\b/si) { - unless ($syntax =~ m|,\s*/ISOTROPIC|) { - push @{$e{""}{pro}{PLOT}{kwds}}, "ISOTROPIC"; - push @complains,"Syntax missing keyword ISOTROPIC"; - } - 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # Attach keywords from another procedure --------------------------- - # ------------------------------------------------------------------ - - sname("SURFACE (ADD PLOT)") => - sub { - if ($syntax =~ /Syntax\s*SURFACE,/si) { - if ($syntax =~ /Graphics Keywords: Accepts.*PLOT.*except([^\.]*)/s) { - # Most PLOT keywords need to be added later. - $act = 1; - push @complains, "Keyword list not complete (PLOT kwds omitted)"; - my $nokeys = $1; - $nokeys =~ s/\{XYZ\}([A-Z0-9_]+)/X$1, Y$1, Z$1/g; - my @nokeys = (split(/[^A-Z0-9_]+/,$nokeys)); - push @add_keywords,["SURFACE","pro","","PLOT","pro","",\@nokeys]; - push @ {$extra_keyword_topics{surface}},"plot"; - } - 1; - } else {0} - }, - - sname("CONTOUR (ADD PLOT)") => - sub { - if ($syntax =~ /Syntax\s*CONTOUR,/si) { - if ($syntax =~ /Graphics Keywords: Accepts.*PLOT.*except([^\.]*)/s) { - # Most PLOT keywords need to be added later. - $act = 1; - push @complains, "Keyword list not complete (PLOT kwds omitted)"; - my $nokeys = $1; - $nokeys =~ s/\{XYZ\}([A-Z0-9_]+)/X$1, Y$1, Z$1/g; - my @nokeys = (split(/[^A-Z0-9_]+/,$nokeys)); - push @add_keywords,["CONTOUR","pro","","PLOT","pro","",\@nokeys]; - push @ {$extra_keyword_topics{contour}},"plot"; - } - 1; - } else {0} - }, - - sname("PLOT_3DBOX (ADD PLOT)") => - sub { - if ($syntax =~ /Syntax\s*PLOT_3DBOX,/si) { - if ($syntax =~ /Graphics Keywords: Accepts.*PLOT.*except([^\.]*)/s) { - $act = 1; - # Most PLOT keywords need to be added later. - push @complains, "Keyword list not complete (PLOT kwds omitted)"; - my $nokeys = $1; - $nokeys =~ s/\{XYZ\}([A-Z0-9_]+)/X$1, Y$1, Z$1/g; - my @nokeys = (split(/[^A-Z0-9_]+/,$nokeys)); - push @add_keywords,["PLOT_3DBOX","pro","","PLOT","pro","",\@nokeys]; - push @ {$extra_keyword_topics{plot_3dbox}},"plot"; - } - 1; - } else {0} - }, - - sname("GRAPHICS KEYWORDS") => - sub { - if ($syntax =~ /Graphics +Keywords *:/i) { - $act = 1; - $has_special_keywords{Graphics} = 1; - 1; - } else {0} - }, - - sname("THREAD POOL KEYWORDS") => - sub { - if ($parts{kwds} =~ /^[ \t]*Thread Pool Keywords[ \t]*$/mi) { - $act = 1; - $has_special_keywords{MultiThreading} = 1; - 1; - } else {0} - }, - - - # ------------------------------------------------------------------ - # Typos ------------------------------------------------------------ - # ------------------------------------------------------------------ - - sname("CW_LIGHT_EDITOR_SET/GET") => - sub { - if ($syntax =~ /\s*Syntax.*CW_ LIGHT_EDITOR_(SET|GET)/si) { - # Typo: Space after "CW_" - push @complains, "Spurious space after the underscore in CW_"; - $act = ($syntax =~ s/CW_ /CW_/); - 1; - } else {0} - }, - - sname("SLASH MISSING") => - sub { - if ($syntax =~ /Keywords|\[ *, *(\/|[A-Z][A-Z0-9_]* *=)/g) { - my $left = $` . $&; - my $right = $'; - my $n=0; - while ($right =~ s/((\[|\|)[ \n]*,[ \n]*)([A-Z][A-Z0-9_]*)( *(\||\]))/$1\/$3$4/s) { - $n++; - push @complains, "Slash before keyword $3 missing"; - print "Fixing keyword $n $3\n" if $debug; - } - if ($n) { - $syntax = $left . $right; - $act = 1; - 1; - } else {0} - } - }, - - sname("MRSID") => - sub { - if ($syntax =~ s/IDLMrSID/IDLffMrSID/) { - $act=1; - push @complains, "IDLMrSID instead of IDLffMrSID"; - 1; - } else {0} - }, - - sname("WOLRDTITLE") => - sub { - if ($syntax =~ s/('IDLgrVRML'.*)WOLRDTITLE/$1WORLDTITLE/si) { - $act=1; - push @complains, "WOLRDTITLE"; - 1; - } else {0} - }, - - sname("SUPRESS") => - sub { - if ($syntax =~ s/SUPRESS/SUPPRESS/) { - $act=1; - push @complains, "SUPRESS"; - 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # Keyword omissions ------------------------------------------------ - # ------------------------------------------------------------------ - - sname("SLASH SEPARATED FROM KEYWORD") => - sub { - if ($syntax =~ /\/\s+[A-Z][A-Z0-9_]+/) { - $act = ($syntax =~ s|/\s+([A-Z][A-Z0-9_]+)|/$1|); - push @complains,"space between slash and KEYWORD $1"; - 1; - } else {0} - }, - - # ------------------------------------------------------------------ - # Miscellaneous ---------------------------------------------------- - # ------------------------------------------------------------------ - - sname("ON_IOERROR") => - sub { - if ($syntax =~ /^(\s*syntax\s*ON_IOERROR,\s*Label.*)Label:/si) { - # Need to shorten the entry - it contains garbage - $syntax = $1; - push @complains, "'Arguments' heading missing?"; - $act = 1; - } else {0} - }, - - sname("EOS LENGTH (OUT)") => - sub { - if ($syntax =~ /syntax\s*.*EOS.*,\s*LENGTH\s*\(OUT\)\s*=/si) { - $syntax =~ s/LENGTH\s*\(OUT\)\s*=/LENGTH=/; - push @complains,"LENGTH (OUT): what does this mean?"; - $act = 1; - } else {0} - }, - - sname("Obj-> & CLASS BRACKETS") => - sub { - if ($syntax =~ /=\s*[a-zA-Z0-9_]+::Init/) { - $act = ($syntax =~ s/(=\s*)([a-zA-Z0-9_]+::)Init/$1 Obj ->\[$2\]Init/); - push @complains,"'Obj->' and class brackets missing"; - 1; - } else {0} - } - ); - # UPDATE: Graphics Keywords Routines - # ---------------------------------- - # Routines that should have links to the GRAPHICS KEYWORDS section. - # For many but not all routines, this can be detected automatically by - # looking for "Graphics Keywords" in the syntax entry. The following - # list is a backup to make sure also those routines which do not - # have this magic cookie will get theirs links set. - %routines_with_special_keywords = - (Graphics=> - [qw(AXIS CONTOUR DRAW_ROI ERASE MAP_SET MAP_GRID MAP_CONTINENTS - OPLOT PLOT PLOTS PLOT_3DBOX POLYFILL SHADE_SURF SURFACE TV TVCRS - TVRD TVSCL XYOUTS)], - # UPDATE: Threading Keywords Routines - # ---------------------------------- - # Routines that should have links to the THREADING KEYWORDS section. - # As of v5.5, it's unclear how these keywords will be indicated in - # individual syntax entries, since they appear only in the "What's - # New in IDL 5.5" document. Presumably, a %specials section which - # checks and adds an extra_keyword_topics, and sets - # $has_threading_keywords is called for. - MultiThreading=> - [qw(ABS ACOS ALOG ALOG10 ASIN ATAN BINDGEN BYTE BYTEORDER BYTSCL CEIL - CINDGEN COMPLEX CONJ CONVOL COS DCINDGEN DCOMPLEX DINDGEN DOUBLE - ERRORF EXP EXPINT FFT FINDGEN FINITE FIX FLOAT FLOOR GAMMA GAUSSINIT - IMAGINARY INDGEN INTERPOLATE ISHFT L64INDGEN LINDGEN LNGAMMA LONG64 - MAX MIN POLY_2D REPLICATE ROUND SIN SINH SQRT TAN TANH TOTAL TVSCL - UINDGEN UINT UL64INDGEN ULINDGEN ULONG64 UNLONG VOIGT WHERE)]); - - # UPDATE: Special help topics - # --------------------------- - # Some words which can show up in IDL source code have special help topics - # associated with them. This Lisp association list links downcase - # versions of these words to the appropriate topics. Even if word and - # topic are the same, it must be mentioned here in order to trigger - # help on this word. If the word at point is not in this list, IDLWAVE - # checks for the local routine call and supplies help. - - $special_topics_words_constant = <<EOF; -(defconst idlwave-help-special-topic-words - '( - ("pro") - ("end" . "pro") - ("function") - ("return") - ("if" . "if...then...else") - ("then" . "if...then...else") - ("endif" . "if...then...else") - ("else" . "if...then...else") - ("endelse" . "if...then...else") - ("for") - ("endfor" . "for") - ("while" . "while...do") - ("endwhile" . "while...do") - ("do" . "while...do") - ("repeat" . "repeat...until") - ("endrep" . "repeat...until") - ("until" . "repeat...until") - ("case") - ("of" . "case") - ("endcase" . "case") - ("switch") - ("endswitch" . "switch") - ("break") - ("continue") - ("begin" . "begin...end") - ("common") - ("goto") - ("forward_function") - ("compile_opt") - ("on_ioerror") -) - "Association list of help topics for special context words.") -EOF - - # The standard Emacs file header notice. - $part_of_gnu_emacs = <<EOF; - -This file is part of GNU Emacs. - -GNU Emacs is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs; see the file COPYING. If not, write to the -Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. -EOF - - # Make a "not part" notice - $not_part_of_gnu_emacs = $part_of_gnu_emacs; - $not_part_of_gnu_emacs =~ s/is part of GNU Emacs/is not part of GNU Emacs/g; - $not_part_of_gnu_emacs =~ s/^GNU Emacs/This file/gm; - - # Make the Lisp versions, with the comment chars. - ($lisp_part_of_gnu_emacs = $part_of_gnu_emacs) =~ s/^.*?\S/;; $&/mg; - ($lisp_not_part_of_gnu_emacs = $not_part_of_gnu_emacs) =~ s/^.*?\S/;; $&/mg; -} - -sub parse_syntax { - my $txt = $_[0]; - - # Initialize a few variables. - # Note that these are global vars which are interpreted by the caller. - @args = @kwds = @getkwds = @setkwds = (); - $name = $type = $class = $call = ""; - - # Get rid of the initial "Syntax" - $txt =~ s/^\s*syntax\s*//i; - - # and any initial explanation string, as in for OPEN - $txt =~ s/^.*?\w:(?!:)\s*//; - - # Terminate at first line without indentation. This helps to - # correctly cut off some entries where the `Syntax' section is not - # followed by one of the other standard sections. In particular, - # for some routines `Syntax' is the last section, and the header of - # the next routine gets in the way. - $txt =~ s/\n\S.*//s; - - # Determine type (function or procedure) - if ($txt =~ /^\s*[a-z][a-z0-9_]+\s*=/si) { - $type = "fun"; - } else { - $type = "pro"; - } - - # Determine Class (ignore the name - we grab it later) - if ($override_class) { - $class=$override_class; - $override_class=""; - } else { - if ($txt =~ /->\s*\[([a-z][a-z0-9_]+)::?\]([a-z][a-z0-9_]+)/i) { - $class = $1; - } - } - - # Clean out the remarks about BLABLA keywords - $txt =~ s/^.*?\bkeywords\b.*?://gmi; - # Clean out the "only in..." stuff - $txt =~ s/\(only\s*in[^\)]*\)//gi; - - # Callapse each chunk of whitespace into a single SPACE - $txt =~ s/[ \t\n]+/ /gm; - - # Get all keywords. Keywords are things with `/' before it or with `=' - # after it. - while ($txt =~ /(\{([XYZ \|]*)\})? - (\/)? - \b - ([A-Z][A-Z0-9_]*) - (\{\s*(Get|Set|Get\s*,\s*Set)\s*\})? - \s* - (=)?/gx - ) { - {next unless $` =~ /,/;} # ignores the "result=" in functions - ($xyz,$slash,$identifier,$getset,$equal) = ($2,$3,$4,$6,$7); - next unless $slash || $equal; - - # Everything before the first keyword is part of the calling sequence - $call = $` unless $call; - - # Some keywords have a {X|Y|Z} in front which must be expanded - if ($xyz) { - @ids = map {$_ . $identifier} (split(/ *\| */,$xyz)); - } else { - @ids = ($identifier); - } - - # Save the recognized keywords away - push @kwds,@ids; - # When the keyword has a Get or Set flag, add it to these lists - push @getkwds,@ids if $getset =~ /get/i; - push @setkwds,@ids if $getset =~ /set/i; - } - - # If there was no keyword, the whole text must be calling sequence - $call = ($call || $txt); - - # Final whitespace and parens are killed. - $call =~ s/[ \n\t\[\]\{\}\|,]*$//; #] - # We may have killed needed closing parenthesis - fix this. - $call = close_open_parens($call); - - # Find the name of the routine in the calling sequence. - if($override_name) { - $name=$override_name; - $override_name=""; - } else { - if ($class) { - if ($call =~ /->\s*\[[^\]]+\]([a-z][a-z0-9$_]*)/i) { - $name = $1; - } - } else { - if ($type eq "fun") { - if ($call =~ /=\s*([a-z][a-z0-9\$_]*)/i) { - $name = $1; - } - } elsif ($type eq "pro") { - if ($call =~ /^\s*([a-z][a-z0-9\$_]*)/si) { - $name = $1; - } - } - } - } - - # Return the name to indicate success - return $name; -} - -sub add_datamine_entries { - # This is just because in IDL 5.3, the datamine docs still use - # Calling Sequence instead of Syntax. So we have here the old list - # from IDL5.2 and put it in when scanning of datamine.pdf was unsuccessful. - my $book = "datamine"; - my($name,$class,$type,$call); - my @kwds; - my @entries = (["Connect","pro","IDLdbDatabase","DBobj ->[%s::]%s","CONNECTION","DATASOURCE","PASSWORD","USER_ID"], - ["ExecuteSQL","pro","IDLdbDatabase","DBobj->ExecuteSQL, strSQL"], - ["GetProperty","pro","IDLdbDatabase","DBobj->GetProperty","CAN_GET_TABLES","DBMS_NAME","DBMS_VERSION","DRIVER_ODBC_LEVEL","DRIVER_VERSION","IS_CONNECTED","IS_READONLY","MAX_CONNECTIONS","MAX_RECORDSETS","ODBC_LEVEL","SQL_LEVEL","SQL_SERVER_NAME","USE_CURSOR_LIB","USER_NAME"], - ["SetProperty","pro","IDLdbDatabase","DBobj->SetProperty","N_BUFFERS","SQL","TABLE","USE_CURSOR_LIB","VERBOSE"], - ["GetDatasources","fun","IDLdbDatabase","Datasources = DBObj->GetDatasources()"], - ["GetTables","fun","IDLdbDatabase","Tables = DBObj->GetTables()"], - ["AddRecord","pro","IDLdbRecordset","RSObj->AddRecord, [field1][field2]...[fieldn]","SET_AUTOINCREMENT"], - ["DeleteRecord","pro","IDLdbRecordset","RSobj->DeleteRecord"], - ["GetProperty","pro","IDLdbRecordset","RSobj->GetProperty","CAN_MOVE_ABSOLUTE","CAN_MOVE_FIRST","CAN_MOVE_LAST","CAN_MOVE_NEXT","CAN_MOVE_PRIOR","CAN_MOVE_RELATIVE","FIELD_INFO","GET_DATABASE","IS_READONLY","N_BUFFERS","RECORDSET_SOURCE"], - ["SetField","pro","IDLdbRecordset","RSobj->SetField, iFieldNumber, Value","INFORMIX","NULL","SQL_TSI_DAY","SQL_TSI_FRAC_SECOND","SQL_TSI_HOUR","SQL_TSI_MINUTE","SQL_TSI_MONTH","SQL_TSI_QUARTER","SQL_TSI_SECOND","SQL_TSI_WEEK","SQL_TSI_YEAR","TNSNAME","UNIX"], - ["CurrentRecord","fun","IDLdbRecordset","number = RSobj->CurrentRecord()"], - ["GetField","fun","IDLdbRecordset","value = RSobj->GetField(iFieldNumber)","IS_NULL","NULL_VALUE"], - ["GetRecord","fun","IDLdbRecordset","Result = RSObj->GetRecord()"], - ["MoveCursor","fun","IDLdbRecordset","Result = RSObj->MoveCursor()","ABSOLUTE","FIRST","LAST","NEXT","PRIOR","RELATIVE"], - ["NFields","fun","IDLdbRecordset","status = RSobj->NFields()"]); - diag(sprintf("Adding %d entries from datamine.pdf in IDL5.2\n",scalar(@entries))); - foreach (@entries) { - ($name,$type,$class,$call,@kwds) = @$_; - push @{$e{$class}{$type}{$name}{kwds}},@kwds; - $e{$class}{$type}{$name}{call} = $call; - $e{$class}{$type}{$name}{book} = $book; - } -} - -sub add_insight_entries { - # This is just because in IDL 5.3, the datamine docs still use - # Calling Sequence instead of Syntax. So we have here the old list - # from IDL5.2 and put it in when scanning of datamine.pdf was unsuccessful. - my $book = "insight"; - my($name,$class,$type,$call); - my @kwds; - my @entries = (["INSIGHT","pro","","%s [, Structure]","IMPORT_FILE","INDEXED_COLOR","PLUGINS_PATH","PREFERENCE_FILE","PROJECT_FILE"], - ["INSPUT","pro","","%s [, Structure]","CIDS","COUNT","CT_NAME","CT_NEW_NAME","CT_REPLACE","DESCRIPTION","GROUP","IMAGE","NAME","NEW_NAME","REPLACE"], - ["INSVIS","pro","","%s, Name1 [, Name2, Name3]","CIDS","DATA_NAME","END","GROUP","MODE","TAIL","TYPE","XRANGE","YRANGE"], - ["INSGET","fun","","Result = %s([Name])","COUNT","DIMS_LIST","EXCLUSIVE","GROUP","NAME","PTR_OUT","TITLE"]); - diag(sprintf("Adding %d entries from insight.pdf in IDL5.2\n",scalar(@entries))); - foreach (@entries) { - ($name,$type,$class,$call,@kwds) = @$_; - push @{$e{$class}{$type}{$name}{kwds}},@kwds; - $e{$class}{$type}{$name}{call} = $call; - $e{$class}{$type}{$name}{book} = $book; - } -} - -#====================================================================== -# -# Writing the RINFO file -# -#====================================================================== - -sub write_rinfo_header { - my ($part_of) = $emacs ? - $lisp_part_of_gnu_emacs : $lisp_not_part_of_gnu_emacs; - $date = localtime; - chomp $date; - ($progname = $0) =~ s|.*/||; - chomp $progname; - $n_files_scanned = @files; - print RINFO <<EOF; -;;; idlw-rinfo.el --- Routine Information for IDLWAVE -;; Copyright (c) 1999 Carsten Dominik -;; Copyright (c) 1999, 2000, 2001, 2002 Free Software Foundation - -;; Author: Carsten Dominik <dominik\@astro.uva.nl> -;; Maintainer: J.D. Smith <jdsmith\@as.arizona.edu> -;; Version: VERSIONTAG -;; Keywords: languages -$part_of -;;; Commentary: - -;; The constants which contain information about IDLs builtin -;; functions, procedures, system variables and class tags. This -;; information is extracted automatically from the IDL documentation -;; and by talking to IDL. -;; -;; Created by $progname on $date -;; IDL version: $idlversion -;; Number of files scanned: $n_files_scanned -$files_string;; Number of routines found: $n_routines_total -;; Number of keywords found: $n_keywords_total -;; -EOF - - print RINFO ";; Fixed up documentation with file: $fixup\n;;\t $fixcnt total fix matches.\n" if($fixup and $fixcnt); - print RINFO <<EOF; -; -;; New versions of IDLWAVE, documentation, and more information -;; available from: -;; http://idlwave.org -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: -EOF -} - -sub write_rinfo_footer { - print RINFO <<EOF; -(provide 'idlw-rinfo) -(provide 'idlwave-rinfo) - -;;; idlw-rinfo.el ends here -EOF -} #' - -sub max {$_[0] > $_[1] ? $_[0] : $_[1]} - -#====================================================================== -# -# Writing the HELP file -# -#====================================================================== - -sub write_help { - my $olhtext=shift; - my ($txt,$txt1,$txt2,$ws1,$ws2); - my($t1b,$t1e,$t2b,$t2e,$beg,$cen,$end); - my @lines = split(/\n/,$olhtext); - my $iline = -1; - - foreach $line (@lines) { - $iline++; # Keep count - - # Shift N_ELEMENTS to the border, to make it a topic - # Special case needed because of superfluous whitespace in PDF file - if ($line =~ /^ *N_ELEMENTS *$/) { - $next5 = join("\n",@lines[$iline+1..$iline+5]); - if ($next5 =~ /the +n_elements +function +returns/i) { - $line =~ s/^ *//; - } - } - - # Shift class methods to border, to make them topics - $line =~ s/^ *([a-zA-Z0-9_]+::[a-zA-Z0-0_]+) *$/$1/; - - # compress initial white space - $line =~ s/^( +)\1/$1/; - - # Short lines can stay as they are - if (length($line) <= $wrapwidth || $nowrap) { - print HELP $line,"\n"; - next; - } - - if ($line =~ /\S {5}/) { - # likely in a table or so - leave it alone - print HELP $line,"\n"; - next; - } - - # split long lines in two at a word boundary -- poor man's wrapping. - ($ws1,$txt) = ($line =~ /( *)(.*)/); - $mid = int(length($txt)/2); - $ws2 = $ws1 || " "; - $txt1 = substr($txt,0,$mid); - $txt2 = substr($txt,$mid); - ($t1b,$t1e) = ($txt1 =~ /(.*?) +(\S*)$/); - ($t2b,$t2e) = ($txt2 =~ /^(\S*) +(.*)/); - $beg = $t1b; - $end = $t2e; - $cen = $t1e . $t2b; - if (length($beg) < length($end)) { - $l1 = $ws1.$beg." ".$cen."\n"; - $l2 = $ws2.$end."\n"; - } else { - $l1 = $ws1.$beg."\n"; - $l2 = $ws2.$cen." ".$end."\n"; - } - print HELP $l1,$l2; - } -} - -sub open_help_file { - # Open the file for fast online help - open HELP, ">$helpfile" or die "Cannot write to $helpfile\n"; - write_help_header(); -} - -sub close_help_file { - write_help_footer(); - close HELP; - printf STDERR "Wrote file $helpfile (%4d kBytes)\n",(-s $helpfile)/1000.; -} - -sub write_help_header { - my ($part_of) = $emacs ? $lisp_part_of_gnu_emacs : ""; - $date = localtime; - chomp $date; - ($progname = $0) =~ s|.*/||; - chomp $progname; - $n_files_scanned = @files; - print HELP <<EOF; -### $helpfile --- Help file for IDLWAVE - - ############################################################## - ## - ## This file contains the ASCII text for IDLWAVE online help. - ## This information is extracted automatically from the - ## IDL documentation. - ## The copyright remains with Research Systems, Inc. - ## Please see below for the detailed copyright notice. - ## - ## Created by $progname on $date - ## IDL version: 5.5 - ## - ############################################################## - - -EOF -} - -sub write_help_footer { - print HELP <<EOF; - - ## idlw-help.txt ends here -EOF -} #' - -#====================================================================== -# -# Writing the Help TOPICS file -# -#====================================================================== - -sub write_topics_header { - $date = localtime; - chomp $date; - ($progname = $0) =~ s|.*/||; - chomp $progname; - $n_files_scanned = @files; - print TOPICS <<EOF; -;;; idlw-help-topics.el --- IDLWAVE topics in the help text file. -;; Copyright (c) 2002 J.D. Smith -;; -;; Author: J.D. Smith <jdsmith\@as.arizona.edu> -;; Version: VERSIONTAG -;; Keywords: languages -;; -$lisp_not_part_of_gnu_emacs -;;; Commentary: -;; -;; The constants which contain the locations of topics in the online -;; text help file, scanned from the text file source. -;; -;; Created by $progname on $date, IDL version: $idlversion -;; -;; New versions of IDLWAVE, documentation, and more information -;; available from: -;; http://idlwave.org -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Code: -EOF -} - - -sub write_topics_file { - # Write the topics file for fast online help - open HELP, "$helpfile" or die "Cannot read $helpfile\n"; - open TOPICS, ">$topicsfile" or die "Cannot write to $topicsfile\n"; - write_topics_header(); - print TOPICS <<EOF; -(defvar idlwave-help-topics) -(setq idlwave-help-topics - '( -EOF - my $sysvar_region = 0; - my $cnt = -1; - LINE: - while (<HELP>) { - if (! /^\S/) { - print TOPICS $topicline; - $topicline = ""; - next; - } - $topicline = ""; - /^(.*?) *$/; - $topic = $1; - $where = tell(HELP) - length($_); - - # reject some useless lines - next if $topic =~ /\bappendix\b/i; - next if $topic =~ /\bchapter\b/i; - next if $topic =~ /\bobsoleted?\b/i; - next if $topic =~ / /; - next if $topic =~ /\b\d\d+\b/; - next if $topic =~ /\"/; - next if $topic =~ /,/; - next if $topic =~ /(\. ){2,}/; - - # UPDATE: Group appendix topics - # ============================= - # Here we group some appendix topics to a single large topic. - # The hash %group_topics associates the first topic in the group - # with the first topic which is no longer part of the group. - # The refguide.txt file needs to be checked if these borders are - # correct. Remember that GET_RINFO make a topic of (almost) all - # lines which are not indented. - - %group_topics = - ("system variables" => "idl operators", - "idl operators" => "reserved words"); - foreach $starttopic (keys %group_topics) { - $endtopic = $group_topics{$starttopic}; - $gtflags{$starttopic} = 0 if lc($topic) eq $endtopic; - next LINE if $gtflags{$starttopic}; - $gtflags{$starttopic} = 1 if lc($topic) eq $starttopic; - } - - # extract and write topic info - $topicline = sprintf(qq{ ("%s" . %d)\n},lc($topic),$where); - } - print TOPICS " ))\n\n"; - print TOPICS <<EOF; -;; Some routines need to be searched under a different name. -;; Here are the required translations. -(defvar idlwave-help-name-translations) -(setq idlwave-help-name-translations - '( -EOF - foreach $from (sort keys %name_translations) { - printf TOPICS qq{ ("%s" . "%s")\n}, - lc($from),lc($name_translations{$from}); - } - print TOPICS " ))\n\n"; - print TOPICS <<EOF; -;; The description for a keyword is not always in the same topic. -;; Some keywords apply to many routines (graphics keywords). Keywords -;; listed by INIT methods are not repeated for GETPROPERTY or SETPROPERTY. -;; Thus, if a keyword description is not found, we sometimes must search -;; the description of additional routines as well. -;; The following list associates routines with other routines where keyword -;; descriptions might be found. Currently we assume that we do not need to -;; look in different object classes. This would be necessary for inheritance, -;; but we do not treat this case currently. -(defvar idlwave-help-alt-names) -(setq idlwave-help-alt-names - '( -EOF - foreach $name (sort keys %extra_keyword_topics) { - printf TOPICS qq{ ("%s" %s)\n},lc($name),'"'. - join('" "',@{$extra_keyword_topics{$name}}).'"'; - } - print TOPICS qq{ ("getproperty" "init")\n}; - print TOPICS qq{ ("setproperty" "init")\n}; - print TOPICS qq{ ("device" "keywords accepted by the idl devices")\n}; - print TOPICS qq{ ("system variables" "controlling the thread pool in idl")\n}; - print TOPICS " ))\n\n"; - - print TOPICS <<EOF; -;; Special words in the source files with associated help topics -EOF - print TOPICS $special_topics_words_constant; - print TOPICS "\n "; - - print TOPICS <<EOF; -;; What would be a good width for a dedicated help frame? -EOF - printf TOPICS "(defvar idlwave-help-frame-width)\n" . - "(setq idlwave-help-frame-width %d)\n", $nowrap ? 102 : $wrapwidth+2; - close TOPICS; - printf STDERR "Wrote file $topicsfile (%4d kBytes)\n", - (-s $topicsfile)/1000.; -} - -sub talk_to_idl { - # Run IDL and get some important information - my $code; - open IDLWAVE_EL,"idlwave.el" or die "Can't open idlwave.el"; - while ($_=<IDLWAVE_EL>) { - $code .= $_ if /^;; START OF IDLWAVE SUPPORT ROUTINES/.. - /^;; END OF IDLWAVE SUPPORT ROUTINES/; - } - close IDLWAVE_EL; - $code =~ s/([^\\])\\\"/$1\"/g; - open TMP, ">tmp.pro" or die "Can't write to tmp.pro\n"; - print TMP $code; - close TMP; - - use IPC::Open2; - # Run IDL in order to get the names of system variables - print STDERR "\nTalking to $idl...\n"; - $pid = open2(\*RDR, \*WTR, $idl . ' 2>/dev/null'); - print WTR ".run tmp.pro\n"; - print WTR "idlwave_get_sysvars\n"; - my $fmt = "idlwave_get_class_tags, '%s'\n"; - foreach $class (sort ignoring_case keys %routines) { - printf WTR $fmt,$class; - } - print WTR "exit\n"; - - # Collect the output - while ($_=<RDR>) { - if (/^IDLWAVE-SYSVAR: (.*[A-Z0-9\$])/) { - push @sv_entries,$1; - } elsif (/^IDLWAVE-CLASS-TAGS: (.*[A-Z0-9\$])/) { - push @ct_entries,$1; - } - } - printf STDERR - "%6d System Variables\n%6d Class Structures\n", - scalar(@sv_entries),scalar(@ct_entries); -} - -sub write_sysvar_info { - # Print the definition of the sysvar alist to the lisp file. - my $main; - print RINFO "\n(setq idlwave-system-variables-alist\n '("; - foreach (@sv_entries) { - @F=split; - $main = shift @F; - $main =~ s/^!//; - print RINFO "\n (\"$main\""; - foreach (@F) {print RINFO " (\"$_\")"} - print RINFO ")"; - } - print RINFO "))\n\n"; -} - -sub write_classtag_info { - # print the class tags to the lisp file. - my ($nclass,$ntags); - my @F; - print RINFO "\n(setq idlwave-system-class-tags\n '("; - foreach (@ct_entries) { - @F=split; - $main = shift @F; - $main =~ s/^!//; - $nclass++; - $ntags += scalar(@F); - print RINFO "\n (\"$main\""; - foreach (@F) {print RINFO " (\"$_\")"} - print RINFO ")"; - } - print RINFO "))\n\n"; - print STDERR "$ntags tags in $nclass classes\n"; -} - -sub write_classtag_info { - # print the class tags to the lisp file. - my ($class,$class1,$nclass,$ntags,$ntags1); - my @classes; - my @F; - print RINFO "\n(setq idlwave-system-class-info\n '("; - foreach (@ct_entries) { - @F=split; - $class = shift @F; - $class =~ s/^!//; - $nclass++; - $ntags += scalar(@F); - @{$tags{$class}} = @F; - } - - @classes = sort {$#{$tags{$b}} <=> $#{$tags{$a}}} keys %tags; - - CLASS: - for ($i=0;$i<$#classes;$i++) { - $c1 = $classes[$i]; - @c1tags = @{$tags{$c1}}; - SUPERCLASS_CANDIDATE: - for ($j=$i+1;$j<=$#classes;$j++) { - $c2 = $classes[$j]; - @c2tags = @{$tags{$c2}}; - if (is_subset(\@c2tags,\@c1tags)) { - @c1tags = @{$tags{$c1}} = remove_tags($tags{$c1},@c2tags); - push @{$inherits{$c1}}, $c2; - $n_inherits++; - next SUPERCLASS_CANDIDATE; - } else { - next SUPERCLASS_CANDIDATE; - } - } - } - - foreach $class (@classes) { - print RINFO "\n (\"$class\"\n"; - print RINFO " (tags"; - foreach (@{$tags{$class}}) {print RINFO " \"$_\"";$ntags1++} - print RINFO ")\n"; - print RINFO " (inherits"; - foreach $class1 (@{$inherits{$class}}) { - print RINFO " \"$class1\""; - } - print RINFO ")"; - print RINFO ")"; - } - print RINFO "))\n\n"; - print STDERR "$ntags tags, $nclass classes, $n_inherits inheritance cases deduced -> $ntags1 native tags\n" if $debug; -} - -sub is_subset { - # Accepts two array references as arguments. - # Checks if the first array is a subset of the second. - my ($ref2,$ref1) = @_; - my @tags1 = @$ref1; - my @tags2 = @$ref2; - my %taghash; - foreach (@tags1) {$taghash{$_}=1} - foreach (@tags2) { - return 0 unless defined($taghash{$_}); - } - return 1; -} - -sub remove_tags { - # Remove entries in the array in the first ref - # the entries to remove are the remaining arguments. - my $ref1 = shift @_; - my @tags = @$ref1; - my @rmtags = @_; - my %taghash; - my $cnt = 0; - foreach (@tags) {$taghash{$_}=++$cnt} - foreach (@rmtags) {delete $taghash{$_}} - sort {$taghash{$a} <=> $taghash{$b}} keys %taghash; -} - - - -__END__ - -=head1 NAME - -get_rinfo - Extract information from IDL documentation for use with IDLWAVE - -=head1 SYNOPSIS - -B<get_rinfo> [-path path/to/PDFfiles] [-txt] - [-nowrap] [-emacs] - [-debug] [-fixup path/to/fixup_file] - [-idl path/to/idl] - [-xname regexp] - [-xclass regexp] - - or - -B<get_rinfo> -maketxt [-path path/to/PDFfiles] - -=head1 DESCRIPTION - -I<get_rinfo> processes the PDF documentation of IDL (the Interactive -Data Language, a proprietary language owned by Research Systems Inc.). -It also talks to the IDL program itself for additional info. It -produces the files needed by the Emacs IDLWAVE mode to support -completion, short help (routine info display) and extensive online -help. It produces these three files: - -=over 4 - -=item F<idlw-rinfo.el> - -Contains the routine information needed for completion and compact -routine info display. This file must be installed on the Emacs load -path and is part of the standard IDLWAVE distribution. - -=item F<idlw-help.txt> - -The ASCII help file with most of the official IDL documentation. This -file is not part of the standard IDLWAVE distribution and needs to be -installed in the directory where the Emacs Lisp variable -B<idlwave-help-directory> or the environment variable -B<IDLWAVE_HELP_DIRECTORY> points. - -=item F<idlw-help.el> - -The code and topics file contains lisp code to access and display the -help file, and pointers to the relevant sections of the IDL documentation. -Needs to be installed in the same directory as F<idlw-help.txt>. -To build this file, get_rinfo also needs the file F<helpcode> which is -part of the IDLWAVE distribution. - -=back - -=head1 OPTIONS - -=over 5 - -=item B<-path> B<path/to/pdf/files> - -Specify the path to the PDF or text documentation files. Default is -the current directory. - -=item B<-idl> B</name/or/path/of/idl/executable> - -Specify the name of the IDL executable to talk to for additional -information. The default is F<idl>. - -=item B<-maketxt> - -Only call F<pdftotext> to convert the pdf files to ascii. Afterwards -you can use the B<-txt> option for faster operation. - -=item B<-txt> - -Assume that the PDF files have already been converted to ASCII files -with the extension F<.txt> and scan these files instead. This is much -faster - so if you need to experiment with this program, first convert -the PDF files (see the B<-maketxt> option) and then use the program with a -B<-t> option. - -=item B<-emacs> - -Include the standard file header for files which are part of -GNU Emacs in the output file. Needed when the resulting file -becomes part of an official Emacs distribution. - -=item B<-nowrap> - -Don't wrap the lines in the help file B<idlw-help.txt>. The -originally ~100 characters wide lines are wrapped to ~65 chars unless -this option is given. - -=item B<-debug> - -Debugging. Writes diagnostics to STDERR and creates these -files: - -F<get_rinfo.log>: A copy of the messages printed to STDERR. - -F<get_rinfo.rej>: All syntax entries which could not be parsed -correctly, together with an explanation. - -F<get_rinfo.cpl>: Syntax entries which contain typos or other -inconsistencies. I<get_rinfo> actually fixes most of these problems, -but you should feel free to complain about them to RSI. - -=item B<-xname> B<regexp> - -Exclude routine names matched by the regular expression REGEXP. -For example setting this to "^CDF_" will not store information -about routines starting with the "CDF_" prefix. - -=item B<-xclass> B<regexp> - -Exclude object classes matched by the regular expression REGEXP. - -=item B<-fixup> B</path/to/fixup_file> - -Occassionally, IDL is shipped with new features and no complementary -documentation update, instead describing new features and changes in a -I<What's New> file. This information can be formatted for inclusion -with the fast text help in IDLWAVE by producing a I<FIXUP> file. - -This reads a I<FIXUP> file, and annotates the help contents and routine -information with new documentation material. The format of the fixup -file is as follows: - -ROUTINE - - Notes - Note text - - Keywords - KEYWORD_NAME - Text describing keyword... - - ANOTHER_KEYWORD_NAME - Text describing another keyword... - - Arguments - Arg_name - Text describing argument... - - Another_arg_name - Text describing another argument... - - -Note the relative spacing. All sections are optional. Notes are -included in the initial description, and keywords and arguments are -included in the relevant section. Existing keywords/arguments are -permitted -- the new text will be grouped with the old. All new text -is bracketed in I<E<lt>NEWE<gt>..E<lt>/NEWE<gt>> markup. The calling -sequence is changed if possible, but this might not look perfect. -When creating a FIXUP file, keeping the indentation about the same as -that of the IDL PDF manuals in text form (about 100 characters), will -ensure a consistent look. - -As a special case, system variables can be specified as: - -System Variables - !SYS_VAR_NAME - System variable description... - -B<When new features a documented in are later release, the FIXUP file -should not be applied>. - -=back - -Options may be abbreviated to uniqueness -=head1 FILES - -F<get_rinfo.log>, F<get_rinfo.cpl>, F<get_rinfo.rej> - -=head1 AUTHOR - -Carsten Dominik <domi...@astro.uva.nl> -J.D. Smith <jdsm...@astro.cornell.edu> - -=cut - - -