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
-
-
-
