Mercurial > forge

changeset 1098:96a954e137da octave-forge

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Re-add mktexi/mkdoc with the right execute flagscvs add mktexi mkdoc
author adb014
date Thu, 06 Nov 2003 14:42:59 +0000
parents 0761d9d1f861
children 2b676999f159
files admin/mkdoc admin/mktexi
diffstat 2 files changed, 570 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/admin/mkdoc	Thu Nov 06 14:42:59 2003 +0000
@@ -0,0 +1,137 @@
+#!/usr/bin/env perl
+#
+# David Bateman Feb 02 2003
+# 
+# Extracts the help in texinfo format from *.cc and *.m files for use
+# in documentation. Based on make_index script from octave_forge.
+
+use strict;
+use File::Find;
+use File::Basename;
+use FileHandle;
+
+my $docdir = ".";
+if (@ARGV) {
+  $docdir = @ARGV[0];
+}
+
+# locate all C++ and m-files in current directory
+my @m_files = ();
+my @C_files = ();
+find(\&cc_and_m_files, $docdir);
+
+sub cc_and_m_files { # {{{1 populates global array @files
+    return unless -f and /\.(m|cc)$/;  # .m and .cc files
+    my $path = "$File::Find::dir/$_";
+    $path =~ s|^[.]/||;
+    if (/\.m$/) {
+        push @m_files, $path;
+    } else {
+        push @C_files, $path;
+    }
+} # 1}}}
+
+# grab help from C++ files
+foreach my $f ( @C_files ) {
+  # XXX FIXME XXX. Should run the preprocessor over the file first, since 
+  # the help might include defines that are compile dependent.
+    if ( open(IN,$f) ) {
+	while (<IN>) {
+	    # skip to the next function
+	    next unless /^DEFUN_DLD/;
+
+	    # extract function name to pattern space
+	    /\((\w*)\s*,/;
+	    # remember function name
+	    my $function = $1;
+	    # skip to next line if comment doesn't start on this line
+	    # XXX FIXME XXX maybe we want a loop here?
+	    $_ = <IN> unless /\"/;
+	    # skip to the beginning of the comment string by
+	    # chopping everything up to opening "
+	    my $desc = $_;
+            $desc =~ s/^[^\"]*\"//;
+	    # join lines until you get the end of the comment string
+	    # plus a bit more.  You need the "plus a bit more" because
+	    # C compilers allow implicitly concatenated string constants
+	    # "A" "B" ==> "AB".
+	    while ($desc !~ /[^\\]\"\s*\S/ && $desc !~ /^\"/) {
+		# if line ends in '\', chop it and the following '\n'
+		$desc =~ s/\\\s*\n//;
+		# join with the next line
+		$desc .= <IN>;
+		# eliminate consecutive quotes, being careful to ignore
+		# preceding slashes. XXX FIXME XXX what about \\" ?
+		$desc =~ s/([^\\])\"\s*\"/$1/;
+	    }
+	    $desc = "" if $desc =~ /^\"/; # chop everything if it was ""
+	    $desc =~ s/\\n/\n/g;          # insert fake line ends
+	    $desc =~ s/([^\"])\".*$/$1/;  # chop everything after final '"'
+	    $desc =~ s/\\\"/\"/;          # convert \"; XXX FIXME XXX \\"
+	    $desc =~ s/$//g;		  # chop trailing ...
+
+	    if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) {
+		my $err = sprintf("Function %s, does not contain texinfo help\n",
+				$function);
+		print STDERR "$err";
+	    }
+	    my $entry = sprintf("\037%s\n%s", $function, $desc);
+	    print "$entry", "\n";
+	}
+	close (IN);
+    } else {
+	print STDERR "Could not open file ($f): $!\n";
+    }
+}
+
+# grab help from m-files
+foreach my $f ( @m_files ) {
+    my $desc     = extract_description($f);
+    my $function = basename($f, ('.m'));
+    die "Null function?? [$f]\n" unless $function;
+    if (!($desc =~ /^\s*-[*]- texinfo -[*]-/)) {
+	my $err = sprintf("Function %s, does not contain texinfo help\n",
+				$function);
+	print STDERR "$err";
+    }
+    my $entry = sprintf("\037%s\n%s", $function, $desc);
+    print "$entry", "\n";
+}
+
+sub extract_description { # {{{1
+# grab the entire documentation comment from an m-file
+    my ($file) = @_;
+    my $retval = '';
+
+    if( open( IN, "$file")) {
+	# skip leading blank lines
+	while (<IN>) {
+	    last if /\S/;
+	}
+	if( m/\s*[%\#][\s\#%]* Copyright/) {
+	    # next block is copyright statement, skip it
+	    while (<IN>) {
+		last unless /^\s*[%\#]/;
+	    }
+	}
+	# Skip everything until the next comment block
+	while ( !/^\s*[\#%]/ ) {
+	    $_ = <IN>;
+	    last if not defined $_;
+	}
+        # Return the next comment block as the documentation
+        while (/^\s*[\#%]/) {
+	    s/^[\s%\#]*//;    # strip leading comment characters
+            s/[\cM\s]*$//;   # strip trailing spaces.
+	    s/[\.*]$//;
+	    $retval .= "$_\n";
+	    $_ = <IN>;
+	    last if not defined $_;
+	}
+        close(IN);
+	return $retval;
+    }
+    else {
+	print STDERR "Could not open file ($file): $!\n";
+    }
+} # 1}}}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/admin/mktexi	Thu Nov 06 14:42:59 2003 +0000
@@ -0,0 +1,433 @@
+#!/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;
+
+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;
+}
+
+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}}}