Diff of /doc/mktexi_inc [000000] .. [81ef98] Maximize Restore

  Switch to side-by-side view

--- a
+++ b/doc/mktexi_inc
@@ -0,0 +1,462 @@
+#!/usr/bin/env perl
+#
+# David Bateman Feb 02 2003
+# 
+# Extracts the help in texinfo format for particular function for use
+# in documentation. Based on make_index script from octave_forge.
+
+use strict;
+use File::Find;
+use File::Basename;
+use Text::Wrap;
+use FileHandle;
+use IPC::Open3;
+use POSIX ":sys_wait_h";
+
+my $file = shift @ARGV;
+my $docfile = shift @ARGV;
+my $indexfile = shift @ARGV;
+my $line;
+print("\\input texinfo \n");
+print("\@ifnottex \n");
+print("\@node Top \n");
+print("\@top Octave gsl \n");
+print("\@end ifnottex \n");
+if ( open(IN,$file) ) {
+  $line = <IN>;
+  my $tex = 0;
+  while ($line) {
+    if ($line =~ /^\@DOCSTRING/) {
+      my $found = 0;
+      my $func = $line;
+      $func =~ s/\@DOCSTRING\(//;
+      $func =~ s/\)[\n\r]+//;
+      my $func0 = $func;
+      my $func1 = $func;
+      $func0 =~ s/,.*$//;
+      $func1 =~ s/^.*,//;
+      if ( open(DOC,$docfile) ) {
+	while (<DOC>) {
+	  next unless /\037/;
+	  my $function = $_;
+	  $function =~ s/\037//;
+	  $function =~ s/[\n\r]+//;
+	  if ($function =~ /^$func0$/) {
+	    my $desc = "";
+	    my $docline;
+	    my $doctex = 0;
+	    while (($docline = <DOC>) && ($docline !~ /^\037/)) {
+	      $docline =~ s/^\s*-[*]- texinfo -[*]-\s*//;
+	      if ($docline =~ /\@tex/) {
+		$doctex = 1;
+	      }
+	      if ($doctex) {
+		$docline =~ s/\\\\/\\/g;
+	      }
+	      if ($docline =~ /\@end tex/) {
+		$doctex = 0;
+	      }
+	      $desc .= $docline;
+	    }
+	    $desc =~ s/$func0/$func1/g;
+	    $desc =~ s/\@seealso\{(.*[^}])\}/See also: \1/g;
+	    print "$desc", "\n";
+	    $found = 1;
+	    last;
+	  }
+        }
+	close (DOC);
+	if (! $found) {
+	  print "\@emph{Not implemented}\n";
+	}
+      } else {
+	print STDERR "Could not open file $docfile\n";
+	exit 1;
+      }
+    } elsif ($line =~ /^\@REFERENCE_SECTION/) {
+      my $secfound = 0;
+      my $sec = $line;
+      $sec =~ s/\@REFERENCE_SECTION\(//;
+      $sec =~ s/\)[\n\r]+//;
+      my @listfunc = ();
+      my $nfunc = 0;
+      my $seccat = 0;
+
+      if ( open(IND,$indexfile) ) {
+	while (<IND>) {
+	  next unless /^[^ ]/;
+	  my $section = $_;
+	  $section =~ s/[\n\r]+//;
+	  if ($section =~ /^(.*?)\s*>>\s*(.*?)$/) {
+	    $section =~ s/.*>>(.*)/\1/;
+	    $seccat = 1;
+	  }
+	  $section =~ s/^ *//;
+	  $section =~ s/ *$//;
+	  if ($section =~ /^$sec$/) {
+	    if ($seccat) {
+	      print "\@iftex\n";
+	      print "\@section Functions by Category\n";
+	      # Get the list of categories to index
+	      my $firstcat = 1;
+	      my $category;
+	      while (<IND>) {
+		last if />>/;
+		if (/^[^ ]/) {	
+		  if (! $firstcat) {
+		    print "\@end table\n";
+		  } else {
+		    $firstcat = 0;
+		  }
+		  $category = $_;
+		  $category =~ s/[\n\r]+//;
+		  print "\@subsection $category\n";
+		  print "\@table \@asis\n";
+		} elsif (/^\s+(\S.*\S)\s*=\s*(\S.*\S)\s*$/) {
+		  my $func = $1;
+		  my $desc = $2;
+		  print "\@item $func\n";
+		  print "$desc\n";
+		  print "\n";
+		} else {
+		  if ($firstcat) {
+		    print STDERR "Error parsing index file\n";
+		    exit 1;
+		  }
+		  s/^\s+//;
+		  my @funcs = split /\s+/;
+		  while ($#funcs >= 0) {
+		    my $func = shift @funcs;
+		    $func =~ s/^ *//;
+		    $func =~ s/[\n\r]+//;
+		    push @listfunc, $func;
+		    $nfunc = $nfunc + 1;
+		    print "\@item $func\n";
+		    print func_summary($func, $docfile);
+		    print "\n";
+		  }
+		}
+	      }
+	      if (! $firstcat) {
+	        print "\@end table\n";
+	      }
+	      print "\n\@section Functions Alphabetically\n";
+	      print "\@end iftex\n\n";
+	    } else {
+	      # Get the list of functions to index
+	      my $indline;
+	      while (($indline = <IND>) && ($indline =~ /^ /)) {
+		if ($indline =~ /^\s+(\S.*\S)\s*=\s*(\S.*\S)\s*$/) {
+		  next;
+		}
+		$indline =~ s/^\s+//;
+		my @funcs = split(/\s+/,$indline);
+		while ($#funcs >= 0) {
+		  my $func = shift @funcs;
+		  $func =~ s/^ *//;
+		  $func =~ s/[\n\r]+//;
+		  push @listfunc, $func;
+		  $nfunc = $nfunc + 1;
+		}
+	      }
+	    }
+	    $secfound = 1;
+	    last;
+	  }
+	}
+	close (IND);
+	if (! $secfound) {
+	  print STDERR "Did not find section $sec\n";
+	}
+      } else {
+	print STDERR "Could not open file $indexfile\n";
+	exit 1;
+      }
+
+      @listfunc = sort(@listfunc);
+      my @listfunc2 = ();
+      my $indent = 16 - 3;
+      print "\@menu\n";
+      foreach my $func (@listfunc) {
+	if ( open(DOC,$docfile) ) {
+	  my $found = 0;
+	  while (<DOC>) {
+	    next unless /\037/;
+	    my $function = $_;
+	    $function =~ s/\037//;
+	    $function =~ s/[\n\r]+//;
+	    if ($function =~ /^$func$/) {
+	      $found = 1;
+	      last;
+	    }
+	  }
+	  close (DOC);
+	  if ($found) {
+	    push @listfunc2, $func;
+	    my $func0 = "${func}::";
+	    my $entry = sprintf("* %-*s %s",$indent,$func0,func_summary($func,$docfile));
+	    print wrap("","\t\t","$entry"), "\n";
+	  }
+	} else {
+	  print STDERR "Could not open file $indexfile\n";
+	  exit 1;
+	}
+      }
+      print "\@end menu\n";
+
+      my $up = "Function Reference";
+      my $next;
+      my $prev;
+      my $mfunc = 1;
+      foreach my $func (@listfunc2) {
+	if ($mfunc == $nfunc) {
+	  $next = "";
+	} else {
+	  $next = @listfunc2[$mfunc];
+	  $mfunc = $mfunc + 1;
+	}
+	print "\n\@node $func, $next, $prev, $up\n";
+	if ($seccat) {
+	  print "\@subsection $func\n\n";
+	} else {
+	  print "\@section $func\n\n";
+	}
+	$prev = $func;
+	my $found = 0;
+	my $desc = "";
+	if ( open(DOC,$docfile) ) {
+	  while (<DOC>) {
+	    next unless /\037/;
+	    my $function = $_;
+	    $function =~ s/\037//;
+	    $function =~ s/[\n\r]+//;
+	    if ($function =~ /^$func$/) {
+	      my $docline;
+	      my $doctex = 0;
+	      while (($docline = <DOC>) && ($docline !~ /^\037/)) {
+		$docline =~ s/^\s*-[*]- texinfo -[*]-\s*//;
+		if ($docline =~ /\@tex/) {
+		  $doctex = 1;
+		}
+		if ($doctex) {
+		  $docline =~ s/\\\\/\\/g;
+		}
+		if ($docline =~ /\@end tex/) {
+		  $doctex = 0;
+		}
+		$desc .= $docline;
+	      }
+	      $desc =~ s/\@seealso\{(.*[^}])\}/See also: \1/g;
+	      print "$desc", "\n";
+	      $found = 1;
+	      last;
+	    }
+	  }
+	  close (DOC);
+	  if (! $found) {
+	    print "\@emph{Not implemented}\n";
+	  }
+        } else {
+	  print STDERR "Could not open file $docfile\n";
+	  exit 1;
+	}
+      }
+    } else {
+      if ($line =~ /\@tex/) {
+	$tex = 1;
+      }
+      if ($tex) {
+	$line =~ s/\\\\/\\/g;
+      }
+      print "$line";
+      if ($line =~ /\@end tex/) {
+	$tex = 0;
+      }
+    }
+    $line = <IN>;
+  }
+} else {
+    print STDERR "Could not open file $file\n";
+    exit 1;
+};
+print("\@bye");
+
+sub func_summary { # {{{1
+  my ($func,		# in function name
+      $docfile		# in DOCSTRINGS
+      )       = @_;
+
+  my $desc = "";
+  my $found = 0;
+  if ( open(DOC,$docfile) ) {
+    while (<DOC>) {
+      next unless /\037/;
+      my $function = $_;
+      $function =~ s/\037//;
+      $function =~ s/[\n\r]+//;
+      if ($function =~ /^$func$/) {
+	my $docline;
+	my $doctex = 0;
+	while (($docline = <DOC>) && ($docline !~ /^\037/)) {
+	  if ($docline =~ /\@tex/) {
+	    $doctex = 1;
+	  }
+	  if ($doctex) {
+	    $docline =~ s/\\\\/\\/g;
+	  }
+	  if ($docline =~ /\@end tex/) {
+	    $doctex = 0;
+	  }
+	  $desc .= $docline;
+	}
+	$desc =~ s/\@seealso\{(.*[^}])\}/See also: \1/g;
+        $found = 1;
+        last;
+      }
+    }
+    close (DOC);
+    if (! $found) {
+      $desc = "\@emph{Not implemented}";
+    }
+  } else {
+    print STDERR "Could not open file $docfile\n";
+    exit 1;
+  }
+  return first_sentence($desc);
+}   # 1}}}
+
+
+sub first_sentence { # {{{1
+# grab the first real sentence from the function documentation
+    my ($desc) = @_;
+    my $retval = '';
+    my $line;
+    my $next;
+    my @lines;
+
+    my $trace = 0;
+    # $trace = 1 if $desc =~ /Levenberg/;
+    return "" unless defined $desc;
+    if ($desc =~ /^\s*-[*]- texinfo -[*]-/) {
+	# help text contains texinfo.  Strip the indicator and run it
+	# through makeinfo. (XXX FIXME XXX this needs to be a function)
+	$desc =~ s/^\s*-[*]- texinfo -[*]-\s*//;
+	my $cmd = "makeinfo --fill-column 1600 --no-warn --no-validate --no-headers --force --ifinfo";
+	open3(*Writer, *Reader, *Errer, $cmd) or die "Could not run info";
+	print Writer "\@macro seealso {args}\n\n\@noindent\nSee also: \\args\\.\n\@end macro\n";
+	print Writer "$desc"; close(Writer);
+	@lines = <Reader>; close(Reader);
+	my @err = <Errer>; close(Errer);
+	waitpid(-1,&WNOHANG);
+
+	# Display source and errors, if any
+	if (@err) {
+	    my $n = 1;
+	    foreach $line ( split(/\n/,$desc) ) {
+		printf "%2d: %s\n",$n++,$line;
+	    }
+	    print ">>> @err";
+	}
+
+	# Print trace showing formatted output
+#	print "<texinfo--------------------------------\n";
+#	print @lines;
+#	print "--------------------------------texinfo>\n";
+
+	# Skip prototype and blank lines
+	while (1) {
+	    return "" unless @lines;
+	    $line = shift @lines;
+	    next if $line =~ /^\s*-/;
+	    next if $line =~ /^\s*$/;
+	    last;
+	}
+
+    } else {
+
+#	print "<plain--------------------------------\n";
+#	print $desc;
+#	print "--------------------------------plain>\n";
+
+	# Skip prototype and blank lines
+	@lines = split(/\n/,$desc);
+	while (1) {
+	    return "" if ($#lines < 0);
+	    $line = shift @lines;
+	    next if $line =~ /^\s*[Uu][Ss][Aa][Gg][Ee]/; # skip " usage "
+
+	    $line =~ s/^\s*\w+\s*://;             # chop " blah : "
+	    print "strip blah: $line\n" if $trace;
+	    $line =~ s/^\s*[Ff]unction\s+//;      # chop " function "
+	    print "strip function $line\n" if $trace;
+	    $line =~ s/^\s*\[.*\]\s*=\s*//;       # chop " [a,b] = "
+	    print "strip []= $line\n" if $trace;
+	    $line =~ s/^\s*\w+\s*=\s*//;          # chop " a = "
+	    print "strip a= $line\n" if $trace;
+	    $line =~ s/^\s*\w+\s*\([^\)]*\)\s*//; # chop " f(x) "
+	    print "strip f(x) $line\n" if $trace;
+	    $line =~ s/^\s*[;:]\s*//;                # chop " ; "
+	    print "strip ; $line\n" if $trace;
+
+	    $line =~ s/^\s*[[:upper:]][[:upper:]0-9_]+//; # chop " BLAH"
+	    print "strip BLAH $line\n" if $trace;
+	    $line =~ s/^\s*\w*\s*[-]+\s+//;        # chop " blah --- "
+	    print "strip blah --- $line\n" if $trace;
+	    $line =~ s/^\s*\w+ *\t\s*//;          # chop " blah <TAB> "
+	    print "strip blah <TAB> $line\n" if $trace;
+	    $line =~ s/^\s*\w+\s\s+//;            # chop " blah  "
+	    print "strip blah <NL> $line\n" if $trace;
+
+#	    next if $line =~ /^\s*\[/;           # skip  [a,b] = f(x)
+#	    next if $line =~ /^\s*\w+\s*(=|\()/; # skip a = f(x) OR f(x)
+	    next if $line =~ /^\s*or\s*$/;      # skip blah \n or \n blah
+	    next if $line =~ /^\s*$/;            # skip blank line
+	    next if $line =~ /^\s?!\//;          # skip # !/usr/bin/octave
+	    # XXX FIXME XXX should be testing for unmatched () in proto
+	    # before going to the next line!
+	    last;
+	}
+    }
+
+    # Try to make a complete sentence, including the '.'
+    if ( "$line " !~ /[^.][.]\s/ && $#lines >= 0) {
+	my $next = $lines[0];
+	$line =~ s/\s*$//;  # trim trailing blanks on last
+	$next =~ s/^\s*//;    # trim leading blanks on next
+	$line .= " $next" if "$next " =~ /[^.][.]\s/; # ends the sentence
+    }
+
+    # Tidy up the sentence.
+    chomp $line;          # trim trailing newline, if there is one
+    $line =~ s/^\s*//;    # trim leading blanks on line
+    $line =~ s/([^.][.])\s.*$/$1/; # trim everything after the sentence
+    print "Skipping:\n$desc---\n" if $line eq "";
+
+    # And return it.
+    return $line;
+
+} # 1}}}
+
+__END__
+This program 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 of the License, or
+(at your option) any later version.
+This program 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 this program; if not, see <http://www.gnu.org/licenses/>.
+This program is granted to the public domain.
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.