doc/extract-docs

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