doc/extract-docs

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