octave-maintainers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Octave Function Reference Manual?


From: David Bateman
Subject: Octave Function Reference Manual?
Date: Fri, 19 Jan 2007 15:35:36 +0100
User-agent: Thunderbird 1.5.0.7 (X11/20060921)

One thing I don't like about the current octave manual is that I don't
believe that it is in fact a manual but rather a collection of the help
strings and in many ways is closer to a reference manual. So why not
have a real reference manual and rewrite the manual itself to go beyond
the scope of what the reference manual itself gives.

We have most of the tools to do this automatically already in
octave-forge in the form of the admin/make_index script and the
main/INDEX file. Taking the make_index script as a starting point I
wrote the attached script.. This, together with the patch for the
texinfo syntax errors in octave I just sent (
https://www.cae.wisc.edu/pipermail/bug-octave/2007-January/001488.html),
can be used to automatically create a texinfo reference manual for
octave. The INDEX file probably needs a little work and the reference
manual could be reformatted a bit, but the basic idea is there. To use
this script do something like

cd octave
../make_funref ../octave-forge/main/INDEX funref.texi
texi2dvi funref.texi
dvipdf funref.dvi

after having applied the above patch and rebuilt octave. If you what to
see what the resulting pdf file looks like check

http://www.dbateman.org/octave/funref.pdf

What are your thoughts on the idea of splitting the manual into a
function reference manual and real manual?

Regards
David

-- 
David Bateman                                address@hidden
Motorola Labs - Paris                        +33 1 69 35 48 04 (Ph) 
Parc Les Algorithmes, Commune de St Aubin    +33 6 72 01 06 33 (Mob) 
91193 Gif-Sur-Yvette FRANCE                  +33 1 69 35 77 01 (Fax) 

The information contained in this communication has been classified as: 

[x] General Business Information 
[ ] Motorola Internal Use Only 
[ ] Motorola Confidential Proprietary

#!/usr/bin/env perl
#
# Albert Danial Mar 21 2002
#
# Creates .html files documenting all the functions in octave and
# octave-forge.

use strict;
use File::Find;
use File::Basename;
use Text::Wrap;
use FileHandle;
use IPC::Open3;
use POSIX ":sys_wait_h";

## Include the unimplemented, and functions with Notes?
my $EXCLUDE_NOTES = 1;
my $EXCLUDE_UNIMPLEMENTED = 1;

## Local configuration; the OCTAVE directory should contain
# src/DOCSTRINGS (which is a build product) and scripts/.
my $OCTAVE  = ".";
my $tmpdir = "/tmp";   # temp directory

## Commands to grab the last few defs from octave
## Use the first def if you want to extract from
## a locally compiled version, or the second if you
## want to use the installed version.
#my $OCTAVECMD = 
"LD_LIBRARY_PATH=$OCTAVE/src/:$OCTAVE/liboctave:$OCTAVE/libcruft 
$OCTAVE/src/octave -q";
#my $OCTAVEINIT = "path='.:$OCTAVE/src//:$OCTAVE/scripts//'; 
suppress_verbose_help_message = 1;";
my $OCTAVECMD = "octave -q";
my $OCTAVEINIT = "suppress_verbose_help_message(1);";

# initialize the indexing variables
my %index_by_TB_cat   = (); # i_TB_cat{toolbox}{category} = list of functions
my %index_by_function = (); # i_function{function} =[ [toolbox_1,category_1],
#                         [toolbox_2,category_2],..]
my %TB_description    = ();
my %index_notes = (); # index_notes{function} = comment
my %index_by_package = (); # i_package{package} = list of functions

# load index
my $indexfile = shift @ARGV;
load_index($indexfile,
           \%index_by_TB_cat,
           \%TB_description,
           \%index_by_function);

# Output file
my $outfile = shift @ARGV;

# XXX FIXME XXX should die if the index is empty
# die "No INDEX in current directory" if !-e "INDEX";

# locate all C++ and m-files in octave
my @m_files = ();
my @C_files = ();
find(\&cc_and_m_files, "$OCTAVE/scripts");
find(\&cc_and_m_files, "$OCTAVE/src");
        # or just use $OCTAVE/{src,scripts}/DOCSTRINGS ....
sub cc_and_m_files { # {{{1 populates global array @files
    return unless -f and /\.(m|cc|l|y)$/;  # .m and .cc files (lex & yacc too!)
    my $path = "$File::Find::dir/$_";
    ##$path =~ s|^[.]/||;
    my $noinstall = sprintf("%s/NOINSTALL", $path);
    if (! -e $noinstall) {
        if (/\.m$/) {
            push @m_files, $path;
        } else {
            push @C_files, $path;
        }
    }
} # 1}}}

my %function_description  = ();
my %octave_forge_function = ();
my @uncategorized = ();
my @skipped = ();
my %n_appearances = ();
my $n_functions = 0;
my @shadowed = ();

# grab help from C++ files
foreach my $f ( @C_files ) {
    if ( open(IN,$f) ) {
        while (<IN>) {
            # skip to the next function
            next unless /^\s*DEF(UN[ (]|UN_MAPPER|UN_DLD|CMD|VAR|CONST)/;

            # print "looking at $_";
            # extract function name to pattern space
            /\((\w*)\s*,/;
            # remember function name
            my $function = $1;
            # print "  found function $function\n";

            # skip to second , to skip default string options of DEFVAR
            # comment if third or higher arg
            # XXX FIXME XXX What about if the string arg includes ,
            # XXX FIXME XXX What if second , is not on first line!!
            # Special cases
            #  * for DEFCONST (I, Complex (0., 1.),
            s/\(\w*\s*,\s*Complex\s*\(\s*[0-9.]*\s*,\s*[0-9.]*\s*\),//;
            #  * for macro containing DEFUN_DLD
            s/\w*\s*\(\w*\s*,\s*"/"/;
            # Main case
            s/\(\w*\s*,.*?,//;

            # If we have nothing but a newline, skip
            $_ = <IN> if /^\s*DEF(UN[ 
(]|UN_MAPPER|UN_DLD|CMD|VAR|CONST)\s*,*\s*\n/;

            # if line contains \w+_DOC_STRING we have a macro for the
            # help text
            my $desc;
            if (/\w+_DOC_STRING/) {
              my $macro = $_;
              $macro =~ s/^.*?\s*(\w*_DOC_STRING).*$/$1/;
              $macro =~ s/\n//;

              my $line;
              if ( open(IN2, $f) ) {
                while ($line = <IN2>) {
                  next unless $line =~ /^\#\s*define\s+$macro\s+\"/;
                  $desc = $line;
                  $desc =~ s/^\#\s*define\s+$macro\s+\"(.*\n)$/$1/;
                  while ($desc !~ /[^\\]\"/ && $desc !~ /^\"/) {
                    $desc =~ s/\\\s*\n//;
                    # join with the next line
                    $desc .= <IN2>;
                  }
                  $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 \\"
                  last;
                }
                close (IN2);
              } else {
                print STDERR "Could not open file ($f): $!\n";
              }
            } else {
              # 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 $doctex = 0;
              $desc = $_;
              if ($desc =~ /address@hidden/) {
                  $doctex = 1;
              }
              if ($doctex) {
                  $desc =~ s/\\\\/\\/g;
              }
              if ($desc =~ /address@hidden tex/) {
                  $doctex = 0;
              }
              $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*[\,\)]/ && $desc !~ /^\"/) {
                # if line ends in '\', chop it and the following '\n'
                $desc =~ s/\\\s*\n//;
                # join with the next line

                my $docline = <IN>;
                if ($docline =~ /address@hidden/) {
                    $doctex = 1;
                }
                if ($doctex) {
                    $docline =~ s/\\\\/\\/g;
                }
                if ($docline =~ /address@hidden tex/) {
                    $doctex = 0;
                }
                $desc .= $docline;
                # 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 ""

              # Now check for text included in help messages as macros
              # XXX FIXME XXX These macros are often compile dependent, so
              # how to we get the correct version of the macro in this case
              # without actually compiling the code???
              while ($desc =~ /[^\\]\"\s*\S+\s*[^\\]\"/) {
                my $macro = $desc;
                # Deal with issues of multiple macros...
                # $macro =~ s/^.*[^\\]\"\s*(\S+?)\s*[^\\]\".*$/$1/;
                ($macro) =   ($macro =~ /[^\\]\"\s*(\S+?)\s*\".*$/);
                $macro =~ s/\n//;
                my $macro_defn;
                my $line;
                if ( open(IN2, $f) ) {
                  while ($line = <IN2>) {
                    next unless $line =~ /^\#\s*define\s+$macro\s+\"/;
                    $macro_defn = $line;
                    $macro_defn =~ s/^\#\s*define\s+$macro\s+\"(.*)\n$/$1/;
                    while ($macro_defn !~ /[^\\]\"/ && $macro_defn !~ /^\"/) {
                      $macro_defn =~ s/\\\s*\n//;
                      # join with the next line
                      $macro_defn .= <IN2>;
                    }
                    $macro_defn = "" if $macro_defn =~ /^\"/; # chop everything 
if it was ""
                    $macro_defn =~ s/\\n/\n/g;          # insert fake line ends
                    $macro_defn =~ s/([^\"])\".*$/$1/;  # chop everything after 
final '"'
                    $macro_defn =~ s/\\\"/\"/;          # convert \"; XXX FIXME 
XXX \\"
                    last;
                  }
                  close (IN2);
                } else {
                  print STDERR "Could not open file ($f): $!\n";
                }
                $desc =~ s/\"\s*$macro\s*\"/$macro_defn/;
              }
            }

            $desc =~ s/\\n/\n/g;          # insert fake line ends
            $desc =~ s/([^\"])\".*$/$1/;  # chop everything after final '"'
            $desc =~ s/\\\"/\"/g;          # convert \"; XXX FIXME XXX \\"
#           print " description: $desc";

            # register the function with a brief description
            register_function($function,$desc,$f,0);
        }
        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;
    register_function($function,$desc,$f,0);
}

# grab help from octave's DOCSTRINGS
if (open (IN,"$OCTAVE/src/DOCSTRINGS")) {
    process_docstrings();
} else {
    print STDERR "could not open $OCTAVE/src/DOCSTRINGS !\n";
}
if (open (IN,"$OCTAVE/scripts/DOCSTRINGS")) {
    process_docstrings();
} else {
    print STDERR "could not open $OCTAVE/scripts/DOCSTRINGS !\n";
}

# Desperate last measure. Try help <func> within octave. Good for getting
# keyword and operator descriptions
print "Perl hacker: please make the following faster\n";
# XXX FIXME XXX, we shouldn't respawn a new octave process each time !!!
foreach my $TB ( toolbox_list()) {
  foreach my $cat ( cat_list($TB) ) {
    foreach my $func ( cat_funcs($TB,$cat) ) {
      if (! defined $function_description{$func}[1] && ! defined 
$index_notes{$func} ) {
        open3(*Writer, *Reader, *Errer, $OCTAVECMD) or die "Could not run 
octave";
        print Writer $OCTAVEINIT;
        print Writer "help $func; 1"; close(Writer);
        my @lines = <Reader>; close(Reader);
        my @err = <Errer>; close(Errer);
        waitpid(-1,&WNOHANG);

        # Display errors, if any
        if (@err) {
          print "help $func\n>>> @err";
        } else {
          my $body = join("",@lines);
          if ($body =~ /help: `(.*)' not found/ || $body =~ /help: sorry,/) {
            # do nothing
          } else {
            print "help $func\n";

            my $start;
            if ($body =~ /^\n\*\*\*/) {
              # clipping assuming ops/keywords only
              $start = index($body,"$func") + 1 + length($func);
            } else {
              # first lines till \n\n will be octave tell us the type
              # of variable/funtion and where it is found
              $start = index($body,"\n\n") + 2;
            }
            my $stop = index($body,"ans =");
            $body = substr($body,$start,$stop-$start);
            register_function($func,$body,$OCTAVE,0);
          }
        }
      }
    }
  }
}

# print a summary table rather than generating the html
write_funref($outfile);

if (@skipped) {
    print "skipped ", scalar(@skipped), " functions ";
    my $rs = $,; $, = "\n  ";
    print "  ", sort(@skipped); $, = $rs;
    print "\n";
}

print_missing();

if (@uncategorized) {
    print scalar(@uncategorized), " uncategorized functions ";
    print "(out of ", $n_functions, " total)";
    my $rs = $,; $, = "\n  ";
    print "  ", sort(@uncategorized); $, = $rs;
    print "\n";
#    print wrap("\t", "\t", join(" ", sort @uncategorized)), "\n";
}

if (@shadowed) {
    print "unexpected shadowing of ", scalar(@shadowed), " Octave functions";
    my $rs = $,; $, = "\n  ";
    print "  ", sort(@shadowed); $, = $rs;
    print "\n";
#    print wrap("\t", "\t", join(" ", sort @shadowed)), "\n";
}

sub process_docstrings {
  my $function = "";
  my $desc = "";
  my $doctex = 0;
  while (<IN>) {
    if (/^\037/) {
        if ($n_appearances{$function} == 0) {
            register_function($function,$desc,$OCTAVE,1) unless $function eq "";
        }
        $function = $_;
        $function =~ s/^\037//;
        $function =~ s/\n$//;
        $desc = "";
    } else {
        my $docline = $_;
        if ($docline =~ /address@hidden/) {
            $doctex = 1;
        }
        if ($doctex) {
            $docline =~ s/\\\\/\\/g;
        }
        if ($docline =~ /address@hidden tex/) {
            $doctex = 0;
        }
        $desc .= $_;
    }
  }
  if ($n_appearances{$function} == 0) {
      register_function($function,$desc,$OCTAVE,1) unless $function eq "";
  }
  close(IN);
}

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 "address@hidden seealso address@hidden also: 
address@hidden 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 "
            next if $line =~ /^\s*-/;           # skip " -- blah"

            $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}}}
sub register_function { # {{{1
# register the function and its one-line description
    my ($function,      # in   $index{toolbox}{category} = [functions]
        $desc,          # in   $toolbox_desc{toolbox} = description
        $file,
        $replace_shadow,
       )      = @_;
    ++$n_appearances{$function};
    if ($n_appearances{$function} > 1) {
      if ($replace_shadow != 0) {
        push @shadowed, "$file:$function";
      }
    } else {
        ++$n_functions;
    }
    if (! ($file =~ /^$OCTAVE/)) {
        $octave_forge_function{$function} = 1;
        if (defined $index_by_function{$function} ||
            ($function !~ /__/ && $file !~ /test/ 
             && $function !~ /^[Cc]ontents?$/
             && $function !~ /pre_install/
             && $function !~ /post_install/)) {
            my $package = $file;
            $package =~ s|^\s*([^/]+/[^/]+/).*$|$1|;
            push @{$index_by_package{$package}}, $function;
        }
    }
    if (!defined $index_by_function{$function}) {
        my $entry = $file;
        $entry = "$file: $function" if $file !~ /[.]m$/;
        if ($function =~ /__/ || $file =~ /test/ 
            || $function =~ /^[Cc]ontents?$/
            || $function =~ /pre_install/ || $function =~ /post_install/) {
            push @skipped, $entry;
        } else {
            push @uncategorized, $entry;
        }
    }

    my $oneline = first_sentence($desc);
    #printf "%30s %s\n", $function, $oneline;
    if ($replace_shadow == 0 && defined @function_description{$function}) {
      @function_description{$function} = [ $function_description{$function}[0], 
$oneline, $desc ];
    } elsif (!defined @function_description{$function}) {
      @function_description{$function} = [ $file, $oneline, $desc ];
    }
#    push @function_description{$function}}, "$file\n$oneline\n$desc";
    #printf "%-12s %-20s %s\n", $function,
    #                           $index_by_function{$function}[0],
    #                           $index_by_function{$function}[1];
} # 1}}}
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.
            $retval .= "$_\n";
            $_ = <IN>;
            last if not defined $_;
        }
        close(IN);
        $retval =~ s/\\\"/\"/g;          # convert \"; XXX FIXME XXX \\"
        return $retval;
    }
    else {
        print STDERR "Could not open file ($file): $!\n";
    }
} # 1}}}
sub load_index { # {{{1
    my ($file) = @_;             # in
    my $toolbox     = "extra";
    my $category    = "";
    my $description = "";
    my $function    = "";
    open(IN, $file) or die "Cannot read $file:  $!\n";
    my %map;   # simple macros for use in notes
    while (<IN>) {
        next if /^\s*$/; # skip blank lines
        next if /^\s*\#/; # skip comment lines
        chomp;
        if      (/^(.*?)\s*>>\s*(.*?)$/) {
            # toolbox lines contain "word >> description"
            $toolbox     = $1;
            $description = $2;
            $category    = "";
            $TB_description{$toolbox} = $description;
        } elsif (/^\s*\$(\w+)\s*=\s*(\S.*\S)\s*$/) {
            # define a variable as "$var = expansion"
            $map{$1} = $2;
        } elsif (/^(\w.*?)\s*$/) {
            # category lines start in the left most column
            $category    = $1;
        } elsif (/^\s+(\S.*?[^=~!><])=\s*(\S.*\S)\s*$/) {
            if (! $EXCLUDE_NOTES) {
                # Process "function = notes" explicit descriptions
                $function = $1;
                $description = $2;

                # We used ...(\S.*)=... rather than (\S.*\S)\s*= to allow for
                # single character function names, but that means we may have
                # to trim some extra spaces of the function name.  Single
                # character descriptions get the treatment they deserve.
                $function =~ s/\s+$//;

                # expand all $var in the description
                my @parts = split('\$', $description);
                foreach my $i ( 1 .. $#parts ) {
                    $parts[$i] =~ /^(\w+)(\W.*)$/ or $parts[$i] =~ /^(\w+)()$/;
                    $parts[$i] = "$map{$1}$2";
                }
                $description = join("",@parts);

                # record the function->description mapping
                $index_notes{$function} = $description;
                die "Function $function (line $.) has no category" unless 
$category;
                push @{$index_by_TB_cat{$toolbox}{$category}}, $function;
                push @{$index_by_function{$function}}, [$toolbox, $category];
            }
        } else {
            s/^\s+//;
            my @list = split /\s+/;
            while ($#list >= 0) {
                $function    = shift @list;
                die "Function $function (line $.) has no category" unless 
$category;
                push @{$index_by_TB_cat{$toolbox}{$category}}, $function;
                push @{$index_by_function{$function}}, [$toolbox, $category];

            }
        }
    }
    close(IN);
} # 1}}}


sub write_funref { # {{{1
    my ($outfile # Output file
        )      = @_;

    open(OUT, ">$outfile") or die "Cannot write $outfile:  $!\n";

    print OUT <<EOF;
\\input texinfo

address@hidden funref.info

address@hidden seealso {args}
address@hidden 1
address@hidden
See also: \\args\\.
address@hidden macro

address@hidden

address@hidden
address@hidden Octave Function Reference Manual
address@hidden January 2007
address@hidden John Eaton
address@hidden
address@hidden 0pt plus 1filll
Copyright address@hidden 2007

Permission is granted to make and distribute verbatim copies of
this manual provided the copyright notice and this permission notice
are preserved on all copies.

Permission is granted to copy and distribute modified versions of this
manual under the conditions for verbatim copying, provided that the entire
resulting derived work is distributed under the terms of a permission
notice identical to this one.

Permission is granted to copy and distribute translations of this manual
into another language, under the same conditions as for modified versions.
address@hidden titlepage

address@hidden

address@hidden
address@hidden Top, Introduction
address@hidden
address@hidden ifinfo

address@hidden Introduction, Function Reference, Top, Top
address@hidden Introduction

Some introductory text!!!

EOF
    print OUT "address@hidden Function Reference, ,Introduction, Top\n";
    print OUT "address@hidden@chapter Functions by Category\n";

    foreach my $TB ( toolbox_list() ) {
        print OUT "address@hidden $TB\n";
        $TB = trim($TB);
        foreach my $cat ( cat_list($TB) ) {
            print OUT "address@hidden $cat\n";
            print OUT "address@hidden address@hidden";
            foreach my $func ( cat_funcs($TB,$cat) ) {
                if (func_implemented ($func)) {
                    print OUT "address@hidden ",$func,"\n";
                    print OUT texi_desc($func);
                    print OUT "\n\n";
                }
            }
            print OUT "address@hidden table\n";
        }
    }

    print OUT "address@hidden Functions Alphabetically\n";
    print OUT "address@hidden iftex\n\n";

    print OUT "address@hidden";
    my $indent = 16 - 3;
    foreach my $func ( indexed_funcs() ) {
        if (func_implemented ($func)) {
            my $func0 = "${func}::";
            my $entry = sprintf("* %-*s %s",$indent,$func0,texi_desc($func));
            print OUT wrap("","\t\t","$entry"), "\n";
        }
    }
    print OUT "address@hidden menu\n";

    my $up = "Function Reference";
    my $next;
    my $prev;
    my $mfunc = 1;
    my @sorted_funcs = indexed_funcs();
    my @implemented_funcs;
    foreach my $func ( @sorted_funcs ) {
        if (func_implemented ($func)) {
            push @implemented_funcs, $func;
        }
    }

    foreach my $func ( @implemented_funcs ) {
        if ($mfunc == scalar @implemented_funcs) {
            $next = "";
        } else {
            $next = @implemented_funcs[$mfunc];
            $mfunc = $mfunc + 1;
        }
        print OUT "address@hidden $func, $next, $prev, $up\n";
        print OUT "address@hidden $func\n\n";
        $prev = $func;
        my $desc = $function_description{$func}[2];
        $desc =~ s/^[\s\n]*-[*]- texinfo -[*]-\s*//;
        print OUT $desc;
        print OUT "\n";
    }

    print OUT "address@hidden";
    close(OUT);
} # 1}}}

sub print_missing {
    my $printmissing = 1;
    foreach my $TB ( toolbox_list() ) {
        my $printTB = 1;
        foreach my $cat ( cat_list($TB) ) {
            my $printcat = 1;
            foreach my $func ( cat_funcs($TB,$cat) ) {
                if (! defined $function_description{$func}[1] && ! defined 
$index_notes{$func} ) {
                     print "missing functions:" if $printmissing;
                     print "\n  [$TB]" if $printTB;
                     print "\n  $cat\n  >" if $printcat;
                     print " $func";
                     $printTB = 0;
                     $printcat = 0;
                     $printmissing = 0;
                }
            }
        }
    }
    print "\n" unless $printmissing;
}
sub cat_ref { # 1{{{
# cat_ref($TB,$cat,$ref) returns an html link to $cat described by $ref
    my ($TB,$cat,$ref) = @_;
    my $anchor = cat_anchor($cat);
    return "<a href=\"$TB.html#$anchor\">$ref</a>";
} # 1}}}
sub cat_ref_up { # 1{{{
# cat_ref($TB,$cat,$ref) returns an html link to $cat described by $ref
    my ($TB,$cat,$ref) = @_;
    my $anchor = cat_anchor($cat);
    return "<a href=\"../$TB.html#$anchor\">$ref</a>";
} # 1}}}
sub cat_anchor { # 1{{{
# cat_anchor($cat) returns the anchor word generated for category $cat
    my ($cat) = @_;
    $cat =~ s/\W+//g;
    return $cat;
} # 1}}}


sub split_long_name { # 1{{{
# html magic to break long variable/function names
    # XXX FIXME XXX this function is probably not used
    my ( $nicefunc ) = @_;
    # $nicefunc =~ s/([^_])_([^_])/$1_ $2/g;
    return $nicefunc;
} # 1}}}
sub first_letters { # 1{{{
# return a list of all first letters in the arguments
# The argument list must come sorted with a case-insensitive sort.
    my $Letter = chr(0);
    my @ret = ();
    foreach my $name ( @_ ) {
        # Check if need to go to the next letter
        if (uc(substr($name, 0, 1)) ne $Letter) {
            $Letter = uc(substr($name, 0, 1));
            push @ret, $Letter;
        }
    } 
    return @ret;
} # 1}}}
sub letter_file { # 1{{{
    return "$_.html" if /[A-Z]/;
    return "A.html" if $_ lt "A";
    return "Z.html";
} # 1}}}
sub deping { # 1{{{
    return "\\'" if $_ eq "'";
    return "$_";
} # 1}}}
sub letter_ref { # 1{{{
# letter_ref($letter) returns a link to the letter
    return "<a href=\"" . letter_file($_) . "#$_\">$_</a>";
} # 1}}}
sub letter_option { # 1{{{
# letter_option($letter) returns a link to the letter
    #return "<option value=\"__BASE_ADDRESS__/doc/" . letter_file($_) . 
"#$_\">$_</option>";
    return "<a href=\"__BASE_ADDRESS__/doc/" . letter_file($_) . "#" . 
deping($_) . "\">" . deping($_) . "</a><br/>";
} # 1}}}
sub ascii_desc { # 1{{{
# ascii_desc($func) returns a decription of $func using ascii markup
    my ( $func ) = @_;
    if (! defined $function_description{$func}[1] ) {
        my $notes = $index_notes{$func};
        $notes = "<missing>" if $notes eq "";
        # convert "<a link>desc</a>" to "desc (link)"
        $notes =~ s|<a href=\"?([^>]*)\"?>([^<]*)</a>|$2 ($1)|g;
        # strip all remaining html formatting
        $notes =~ s|<[^>]*>||g;
        return $notes;      
    } else {
        my $desc = $function_description{$func}[1];
        if ($desc eq "") {
            return "<no description>";
        } else {
            return $desc;
        }
    }
} #}}}

sub func_implemented { # 1{{{
# func_implemented($func) returns true if 
#   1) function implemented
#   2) Notes exist
#   3) $EXCLUDE_UNIMPLEMENTED is false
    my ( $func ) = @_;
    my $notes = $index_notes{$func};
    if (! defined $function_description{$func}[1] ) {
        if ($notes eq "") {
            return (! $EXCLUDE_UNIMPLEMENTED);
        }
    }
    return !0;
}
sub texi_desc { # 1{{{
# texi_desc($func) returns a description of $func using texinfo markup
    my ( $func ) = @_;
    my $notes = $index_notes{$func};
    if (! defined $function_description{$func}[1] ) {
        $notes = "not implemented" if $notes eq "";
        # shut of the bold italics during "code" formatting
        $notes =~ s|<\s*[aA]\s+[hH][rR][eE][fF]\s*=\s*"(.+)"\s*>(.*)</[aA]>|$2 
(address@hidden)|g;
        $notes =~ s|<code>|address@hidden|g;
        $notes =~ s|</code>|}|g;
        $notes =~ s|<f>(\w+)</f>|address@hidden|g;
        return "$notes";
    } else {
        print "ignoring $func = $notes\n" if $notes ne "";
        my $desc = $function_description{$func}[1];
        if ($desc eq "") {
            return "address@hidden description\}";
        } else {
            return $desc;
        }
    }
} # 1}}}

sub toolbox_list { # 1{{{
# toolbox_list() returns an ordered list of toolboxes.
    return sort { uc($a) cmp uc($b) } keys %index_by_TB_cat;
} # 1}}}
sub toolbox_list_sorted_by_desc { # 1{{{
# toolbox_list_sorted_by_desc() returns an ordered list of toolboxes.
    return sort { uc($TB_description{$a}) cmp uc($TB_description{$b}) } keys 
%index_by_TB_cat;
} # 1}}}
sub package_list { # 1{{{
# package_list() returns an ordered list of package directories.
    return sort { uc($a) cmp uc($b) } keys %index_by_package;
} # 1}}}
sub cat_list { # 1{{{
# cat_list($TB) returns an ordered list of categories in a toolbox $TB.
    my ($TB) = @_;
    return sort keys %{$index_by_TB_cat{$TB}};
} # 1}}}
sub pack_list { # 1{{{
# pack_list($package) returns an ordered list of functions in a package 
directory.
    my ($package) = @_;
    return sort @{$index_by_package{$package}};
} # 1}}}
sub cat_funcs { # 1{{{
# cat_funcs($TB,$cat) returns an ordered list of functions in $TB,$cat
    my ($TB,$cat) = @_;
    return sort { uc($a) cmp uc($b) } @{$index_by_TB_cat{$TB}{$cat}}
} # 1}}}
sub indexed_funcs { # 1{{{
# indexed_funcs() returns an ordered list of all functions in the index
    return sort { uc($a) cmp uc($b) } keys %index_by_function;
} # 1}}}
sub forge_funcs { # 1{{{
# forge_funcs() returns an ordered list of functions only found in octave forge
    return sort { uc($a) cmp uc($b) } keys %octave_forge_function;
} # 1}}}
sub scanned_funcs { # 1{{{
# scanned_funcs() returns an ordered list of all functions found in m-files and 
oct-files
    return sort { uc($a) cmp uc($b) } %function_description;
} # 1}}}
sub trim($) {
# This functions trims spaces from the beginning and end of a string
        my $string = shift;
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
        return $string;
}

__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, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
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.

reply via email to

[Prev in Thread] Current Thread [Next in Thread]