doc/extract-docs

   1 #!/usr/bin/perl
   2 # -*- perl -*-
   3 #
   4 # $Id$
   5 #
   6 #################################################################
   7 # This script extracts special comments from the source. It assembles
   8 # them in texinfo files that are included in the manual.
   9 #################################################################
  10 #
  11 # The general format of what this script looks for is thusly:
  12 #
  13 #  %start-doc category sort-key
  14 #  texi stuff goes here
  15 #  %end-doc
  16 #
  17 # The lines with the %start-doc and %end-doc are not included in the
  18 # texi extraction; only the lines between them.  The category is used
  19 # to determine the file that's created; a category of "foo" causes a
  20 # file "foo.texi" to be created.  The sort-keys are case insensitive.
  21 # The text extracted is sorte according to the key and put into the
  22 # file according to the category.  Each unique sort-key causes a @node
  23 # to be created, unless that sort-key's text already has a @node in
  24 # it.
  25 # If the sort-key contains space characters, it should be enclosed by
  26 # quotation marks ("). Leading digits in the sort key optionally followed
  27 # by space are removed after sort but before creation of nodes. This
  28 # allows to manipulate the order of nodes in the manual.
  29 #
  30 # Note that we synthesize a special @syntax command, which should be
  31 # used for all things syntax.  We change those to whatever the current
  32 # desired style is for syntaxes (currently, a cartouche box of
  33 # non-wrapped but variable-pitch font).
  34 #
  35 # For extracting actions, this script expects a very specific syntax
  36 # to be used.  It looks like this, with one or more lines
  37 # (continuations are like this example):
  38 #
  39 # static const char some_string_help[] =
  40 # "some text\n"
  41 # "some text";
  42 #
  43 # Repeat for some_string_syntax[], then follow those with the usual
  44 # %start-doc.  Note that the %start-doc for actions must use the
  45 # category "actions" and the sort key must match the action name.
  46 #
  47 # Within start-doc/end-doc pairs, you can use two special @-lines
  48 # to control the generated node names and document structure.
  49 #
  50 # @nodetype section
  51 #   You can specify section, subsection, unnumberedsubsec, etc.  Each
  52 #   unique sort key within each category is assigned one of these.
  53 # @nodename pattern
  54 #   A sprintf-like pattern to use to modify the sort-key to make a
  55 #   node name.  Since node names must be unique and have various
  56 #   restrictions as to what characters you can use in them, this
  57 #   allows you to use a pattern for various categories which will help
  58 #   keep node names unique without requiring lots of repetetive typing
  59 #   in the source files.
  60
  61 $docdir = shift;
  62 $docdir = "." unless $docdir;
  63 $srcdir = "$docdir/../src";
  64 $docdir = ".";
  65
  66 my $debug = 0;
  67
  68 open(FIND, "find $srcdir -type f -name '*.[chly]' -print | sort |");
  69 while (<FIND>) {
  70     s/[\r\n]+$//;
  71     &scan_file($_);
  72 }
  73 close (FIND);
  74
  75 sub dsort {
  76     my ($a, $b) = @_;
  77     $a =~ tr/A-Z/a-z/;
  78     $b =~ tr/A-Z/a-z/;
  79     return $a cmp $b;
  80 }
  81
  82 for $cat (sort keys %text) {
  83     print "$cat\n";
  84     @k = sort {&dsort($a,$b)} keys %{$text{$cat}};
  85     $new = '';
  86     $new .= "\@c key $cat\n";
  87     if ($cat eq "actions") {
  88         &dump_00_keys($cat, "\0\$");
  89         $new .= "\n\@menu\n";
  90         for $hid (sort keys %{$hids{$cat}}) {
  91             if ($hid =~ /../) {
  92                 $new .= "* ${hid} actions::\n";
  93             } else {
  94                 $new .= "* core actions::\n";
  95             }
  96         }
  97         $new .= "\@end menu\n\n";
  98         for $hid (sort keys %{$hids{$cat}}) {
  99             if ($hid =~ /../) {
 100                 $new .= "\@node $hid actions\n";
 101                 $new .= "\@section $hid actions\n";
 102                 &dump_00_keys($cat, "\0$hid\$");
 103             } else {
 104                 $new .= "\@node core actions\n";
 105                 $new .= "\@section Core actions\n";
 106             }
 107             $new .= "\@menu\n";
 108             for $key (@k) {
 109                 next unless $key =~ /\0$hid$/;
 110                 next if $key =~ /^00/;
 111                 $k2 = $title{$cat}{$key};
 112                 if ($hid =~ /\S/ && $hid !~ /common/) {
 113                     $k2 = "$hid $k2";
 114                 }
 115                 $new .= "* ${k2} Action:: $desc{$key}\n";
 116             }
 117             $new .= "\@end menu\n";
 118             for $key (@k) {
 119                 next unless $key =~ /\0$hid$/;
 120                 next if $key =~ /^00/;
 121                 $k2 = $title{$cat}{$key};
 122                 if ($hid =~ /\S/ && $hid !~ /common/) {
 123                     $k2 = "$hid $k2";
 124                 }
 125                 if ($key !~ /^00/) {
 126                     $new .= "\@node $k2 Action\n";
 127                     $new .= "\@subsection $k2\n";
 128                 }
 129                 $new .= "\@c key $k2 in hid $hid\n";
 130                 if ($synt{$key}) {
 131                     $new .= "\@cartouche\n\@format\n";
 132                     $new .= $synt{$key};
 133                     $new .= "\@end format\n\@end cartouche\n\n";
 134                 }
 135                 if ($desc{$key}) {
 136                     $new .= $desc{$key} . "\n";
 137                 }
 138                 $new .= $text{$cat}{$key};
 139                 if (! $desc{$key} && ! $text{$cat}{$key} ) {
 140                     $new .= "No documentation yet.\n";
 141                 }
 142                 $new .= "\n";
 143             }
 144         }
 145     } else {
 146         $nodetype = "section";
 147         &dump_00_keys($cat, "");
 148         $new .= "\@menu\n";
 149         $nodename = "%s";
 150         for $key (@k) {
 151             if ($nodename{$cat}{$key}) {
 152                 $nodename = $nodename{$cat}{$key};
 153             }
 154             next if $key =~ /^00/;
 155             $k2 = $title{$cat}{$key};
 156             # strip leading digits from the key string
 157             $k2 =~ s/\A\d+\s*//g;
 158             $k2 = sprintf($nodename, $k2);
 159             if ($text{$cat}{$key} !~ /\@node/) {
 160                 $new .="* ${k2}::\n";
 161             }
 162         }
 163         $new .= "\@end menu\n";
 164         $nodename = "%s";
 165         for $key (@k) {
 166             if ($nodetype{$cat}{$key}) {
 167                 $nodetype = $nodetype{$cat}{$key};
 168             }
 169             if ($nodename{$cat}{$key}) {
 170                 $nodename = $nodename{$cat}{$key};
 171             }
 172             next if $key =~ /^00/;
 173             $k2 = $title{$cat}{$key};
 174             # strip leading digits from the key string
 175             $k2 =~ s/\A\d+\s*//g;
 176             $k2n = sprintf($nodename, $k2);
 177             $new .= "\@c $cat $k2\n";
 178             if ($text{$cat}{$key} !~ /\@node/) {
 179                 $new .= "\@node $k2n\n";
 180                 $new .= "\@$nodetype $k2\n";
 181             }
 182             $new .= $text{$cat}{$key};
 183         }
 184     }
 185     $^A = "";
 186     $line = join(' ', @k);
 187     formline("    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~\n", $line);
 188     print $^A;
 189
 190     $old = '';
 191     if ( -f "$docdir/$cat.texi") {
 192         open(CAT, "$docdir/$cat.texi");
 193         $old = join('', <CAT>);
 194         close CAT;
 195     }
 196     if ($old ne $new) {
 197         open(CAT, ">$docdir/$cat.texi");
 198         print CAT $new;
 199         close CAT;
 200     }
 201 }
 202
 203 sub dump_00_keys {
 204     my($cat, $regex) = @_;
 205     for $k (@k) {
 206         next unless $k =~ /00.*$regex/;
 207         $new .= $text{$cat}{$k};
 208     }
 209 }
 210
 211 sub scan_file {
 212     my ($name) = @_;
 213     print "DEBUG:  sub_scan($name)\n" if ($debug);
 214
 215     # if the source file was in $(srcdir)/hid/<hidname>/ then
 216     # pick out the name of the hid and put it into $srcdir.
 217     if ($name =~ m@hid/([^/]+)/@) {
 218         $hid = "$1";
 219     } else {
 220         $hid = "";
 221     }
 222     $lineno = 0;
 223
 224     # skip processing of lex/yacc output files
 225     if ($name =~ /\.[ch]$/) {
 226         $new = $name;
 227         $new =~ s/\.[ch]$/\.y/;
 228         return if -f $new;
 229         $new =~ s/\.y$/\.l/;
 230         return if -f $new;
 231     }
 232
 233     open(F, $name);
 234     while (<F>) {
 235         $lineno ++;
 236         if (/^static\s+const\s+char\s+.*_(help|syntax)\[\]\s*=(.*)/) {
 237             $tag = $1;
 238             $last = 0;
 239             $pending{$tag} = '';
 240
 241             # note that the help/syntax string may start on the same line
 242             # as the "static const char"... bit so we pick out that part and
 243             # process it first.
 244             $_ = $2;
 245           LOOP: {
 246               do {
 247                   # eat trailing whitespace, new-lines, and carriage returns
 248                   s/[\r\n\s]+$//;
 249
 250                   # we're done if we found the terminating ";"
 251                   $last = 1 if /;$/;
 252
 253                   # otherwise we need to eat leading whitespace and the leading quote
 254                   s/^[\s]*\"//; #"
 255
 256                   # convert \n to a newline
 257                   s/\\n/\n/g;
 258
 259                   # eat trailing quotes
 260                   s/\";?$//; #"
 261                   s/\\\"/\"/g; #"
 262                   s/ "/``/g;
 263                 s/" /''/g;
 264                   $pending{$tag} .= $_;
 265                   last if $last;
 266               } while (<F>);
 267           }
 268             # spit out a warning in case we have a malformed help
 269             if ($pending{$tag}  =~ /%(start|end)-doc/) {
 270                 print "WARNING:  $name line $lineno has a $1 string that includes a %start-doc or %end-doc\n";
 271                 print "          tag:\n$pending{$tag}\n\n";
 272             }
 273             next;
 274         }
 275
 276         if (/%start-doc\s+(\S+)\s+([^"^\s]+|".*?")(\s+(.*))?/) {
 277         # pattern to look for:
 278         # start-doc -> "%start-doc"
 279         # \s+ -> one ore more whitespace
 280         # (\S+) -> string with no whitespace, goes to $1
 281         # \s+ -> one ore more whitespace
 282         # ([^"^\s]+|".*?") -> a space-less string, or a string delimited by ", goes to $2
 283         # (\s+(.*))? -> zero or more space separated strings
 284
 285             $cat = $1;
 286             $key = $2;
 287             # strip leading and trailing quotation marks from the key string
 288             $key =~ s/\A"//g;
 289             $key =~ s/"\Z//g;
 290             $title = $4;
 291             if ($title) {
 292                 $title{$cat}{"$key\0$hid"} = $title;
 293             } else {
 294                 $title{$cat}{"$key\0$hid"} = $key;
 295             }
 296             $text{$cat}{"$key\0$hid"} .= "\@c $name $lineno\n";
 297             $hids{$cat}{$hid} = 1;
 298             if ($cat =~ /^(.*_)?actions/) {
 299                 $desc{"$key\0$hid"} = $pending{'help'};
 300                 $synt{"$key\0$hid"} = $pending{'syntax'};
 301                 %pending = ();
 302             }
 303             while (<F>) {
 304                 next if /^\*\/$/;
 305                 next if /^\/\*$/;
 306                 last if /%end-doc/;
 307                 s/\@syntax/\@cartouche\n\@format/g;
 308                 s/\@end syntax/\@end format\n\@end cartouche/g;
 309                 if (/^\@nodetype\s*(\S+)/) {
 310                     $nodetype{$cat}{"$key\0$hid"} = $1;
 311                     next;
 312                 }
 313                 if (/^\@nodename\s*(.+)/) {
 314                     $nodename{$cat}{"$key\0$hid"} = $1;
 315                     next;
 316                 }
 317                 $text{$cat}{"$key\0$hid"} .= $_;
 318             }
 319         }
 320     }
 321     close (F);
 322 }