#!/usr/bin/perl
# -*- perl -*-
#
#################################################################
# This script extracts special comments from the source. It assembles
# them in texinfo files that are included in the manual.  
#################################################################
#
# The general format of what this script looks for is thusly:
#
#  %start-doc category sort-key
#  texi stuff goes here
#  %end-doc
#
# The lines with the %start-doc and %end-doc are not included in the
# texi extraction; only the lines between them.  The category is used
# to determine the file that's created; a category of "foo" causes a
# file "foo.texi" to be created.  The sort-keys are case insensitive.
# The text extracted is sorte according to the key and put into the
# file according to the category.  Each unique sort-key causes a @node
# to be created, unless that sort-key's text already has a @node in
# it.
# If the sort-key contains space characters, it should be enclosed by
# quotation marks ("). Leading digits in the sort key optionally followed
# by space are removed after sort but before creation of nodes. This
# allows to manipulate the order of nodes in the manual.
#
# Note that we synthesize a special @syntax command, which should be
# used for all things syntax.  We change those to whatever the current
# desired style is for syntaxes (currently, a cartouche box of
# non-wrapped but variable-pitch font).
#
# For extracting actions, this script expects a very specific syntax
# to be used.  It looks like this, with one or more lines
# (continuations are like this example):
#
# static const char some_string_help[] =
# "some text\n"
# "some text";
#
# Repeat for some_string_syntax[], then follow those with the usual
# %start-doc.  Note that the %start-doc for actions must use the
# category "actions" and the sort key must match the action name.
#
# Within start-doc/end-doc pairs, you can use two special @-lines
# to control the generated node names and document structure.
#
# @nodetype section
#   You can specify section, subsection, unnumberedsubsec, etc.  Each
#   unique sort key within each category is assigned one of these.
# @nodename pattern
#   A sprintf-like pattern to use to modify the sort-key to make a
#   node name.  Since node names must be unique and have various
#   restrictions as to what characters you can use in them, this
#   allows you to use a pattern for various categories which will help
#   keep node names unique without requiring lots of repetetive typing
#   in the source files.

$docdir = shift;
$docdir = "." unless $docdir;
$srcdir = "$docdir/../src";
$docdir = ".";

my $debug = 0;

open(FIND, "find $srcdir -type f -name '*.[chly]' -print | sort |");
while (<FIND>) {
    s/[\r\n]+$//;
    &scan_file($_);
}
close (FIND);

sub dsort {
    my ($a, $b) = @_;
    $a =~ tr/A-Z/a-z/;
    $b =~ tr/A-Z/a-z/;
    return $a cmp $b;
}

for $cat (sort keys %text) {
    print "$cat\n";
    @k = sort {&dsort($a,$b)} keys %{$text{$cat}};
    $new = '';
    $new .= "\@c key $cat\n";
    if ($cat eq "actions") {
	&dump_00_keys($cat, "\0\$");
	$new .= "\n\@menu\n";
	for $hid (sort keys %{$hids{$cat}}) {
	    if ($hid =~ /../) {
		$new .= "* ${hid} actions::\n";
	    } else {
		$new .= "* core actions::\n";
	    }
	}
	$new .= "\@end menu\n\n";
	for $hid (sort keys %{$hids{$cat}}) {
	    if ($hid =~ /../) {
		$new .= "\@node $hid actions\n";
		$new .= "\@section $hid actions\n";
		&dump_00_keys($cat, "\0$hid\$");
	    } else {
		$new .= "\@node core actions\n";
		$new .= "\@section Core actions\n";
	    }
	    $new .= "\@menu\n";
	    for $key (@k) {
		next unless $key =~ /\0$hid$/;
		next if $key =~ /^00/;
		$k2 = $title{$cat}{$key};
		if ($hid =~ /\S/ && $hid !~ /common/) {
		    $k2 = "$hid $k2";
		}
		$new .= "* ${k2} Action:: $desc{$key}\n";
	    }
	    $new .= "\@end menu\n";
	    for $key (@k) {
		next unless $key =~ /\0$hid$/;
		next if $key =~ /^00/;
		$k2 = $title{$cat}{$key};
		if ($hid =~ /\S/ && $hid !~ /common/) {
		    $k2 = "$hid $k2";
		}
		if ($key !~ /^00/) {
		    $new .= "\@node $k2 Action\n";
		    $new .= "\@subsection $k2\n";
		}
		$new .= "\@c key $k2 in hid $hid\n";
		if ($synt{$key}) {
		    $new .= "\@cartouche\n\@format\n";
		    $new .= $synt{$key};
		    $new .= "\n\@end format\n\@end cartouche\n\n";
		}
		if ($desc{$key}) {
		    $new .= $desc{$key} . "\n";
		}
		$new .= $text{$cat}{$key};
		if (! $desc{$key} && ! $text{$cat}{$key} ) {
		    $new .= "No documentation yet.\n";
		}
		$new .= "\n";
	    }
	}
    } else {
	$nodetype = "section";
	&dump_00_keys($cat, "");
	$new .= "\@menu\n";
	$nodename = "%s";
	for $key (@k) {
	    if ($nodename{$cat}{$key}) {
		$nodename = $nodename{$cat}{$key};
	    }
	    next if $key =~ /^00/;
	    $k2 = $title{$cat}{$key};
	    # strip leading digits from the key string
	    $k2 =~ s/\A\d+\s*//g;
	    $k2 = sprintf($nodename, $k2);
	    if ($text{$cat}{$key} !~ /\@node/) {
		$new .="* ${k2}::\n";
	    }
	}
	$new .= "\@end menu\n";
	$nodename = "%s";
	for $key (@k) {
	    if ($nodetype{$cat}{$key}) {
		$nodetype = $nodetype{$cat}{$key};
	    }
	    if ($nodename{$cat}{$key}) {
		$nodename = $nodename{$cat}{$key};
	    }
	    next if $key =~ /^00/;
	    $k2 = $title{$cat}{$key};
	    # strip leading digits from the key string
	    $k2 =~ s/\A\d+\s*//g;
	    $k2n = sprintf($nodename, $k2);
	    $new .= "\@c $cat $k2\n";
	    if ($text{$cat}{$key} !~ /\@node/) {
		$new .= "\@node $k2n\n";
		$new .= "\@$nodetype $k2\n";
	    }
	    $new .= $text{$cat}{$key};
	}
    }
    $^A = "";
    $line = join(' ', @k);
    formline("    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~\n", $line);
    print $^A;

    $old = '';
    if ( -f "$docdir/$cat.texi") {
	open(CAT, "$docdir/$cat.texi");
	$old = join('', <CAT>);
	close CAT;
    }
    if ($old ne $new) {
	open(CAT, ">$docdir/$cat.texi");
	print CAT $new;
	close CAT;
    }
}

sub dump_00_keys {
    my($cat, $regex) = @_;
    for $k (@k) {
	next unless $k =~ /00.*$regex/;
	$new .= $text{$cat}{$k};
    }
}

sub scan_file {
    my ($name) = @_;
    print "DEBUG:  sub_scan($name)\n" if ($debug);

    # if the source file was in $(srcdir)/hid/<hidname>/ then
    # pick out the name of the hid and put it into $srcdir.
    if ($name =~ m@hid/([^/]+)/@) {
	$hid = "$1";
    } else {
	$hid = "";
    }
    $lineno = 0;

    # skip processing of lex/yacc output files
    if ($name =~ /\.[ch]$/) {
	$new = $name;
	$new =~ s/\.[ch]$/\.y/;
	return if -f $new;
	$new =~ s/\.y$/\.l/;
	return if -f $new;
    }

    open(F, $name);
    while (<F>) {
	$lineno ++;
	if (/^static\s+const\s+char\s+.*_(help|syntax)\[\]\s*=(.*)/) {
	    $tag = $1;
	    $last = 0;
	    $pending{$tag} = '';
	    
	    # note that the help/syntax string may start on the same line
	    # as the "static const char"... bit so we pick out that part and
	    # process it first.
	    $_ = $2;
	  LOOP: {
	      do {
		  # eat trailing whitespace, new-lines, and carriage returns
		  s/[\r\n\s]+$//;
		  
		  # we're done if we found the terminating ";"
		  $last = 1 if /;$/;
		  
		  # otherwise we need to eat leading whitespace and the leading quote
		  s/^[\s]*\"//; #"
		  
		  # convert \n to a newline
		  s/\\n/\n/g;

		  # eat the first part of the N_("..."); macros including leading spaces 
		  s/\s*N_\s*\(\s*\"//;

		  # eat the trailing part of the N_("..."); macros
		  s/\"\s*\)\s*;\s*$/$1/;
		  
		  # eat trailing quotes
		  s/\";?$//; #"
		  s/\\\"/\"/g; #"
		  s/ "/``/g;
		s/" /''/g;
		  $pending{$tag} .= $_;
		  last if $last;
	      } while (<F>);
	  }
	    # spit out a warning in case we have a malformed help
	    if ($pending{$tag}  =~ /%(start|end)-doc/) {
		print "WARNING:  $name line $lineno has a $1 string that includes a %start-doc or %end-doc\n";
		print "          tag:\n$pending{$tag}\n\n";
	    }
	    next;
	}

	if (/%start-doc\s+(\S+)\s+([^"^\s]+|".*?")(\s+(.*))?/) {
	# pattern to look for:
	# start-doc -> "%start-doc"
	# \s+ -> one ore more whitespace
	# (\S+) -> string with no whitespace, goes to $1
	# \s+ -> one ore more whitespace
	# ([^"^\s]+|".*?") -> a space-less string, or a string delimited by ", goes to $2
	# (\s+(.*))? -> zero or more space separated strings
	
	    $cat = $1;
	    $key = $2;
	    # strip leading and trailing quotation marks from the key string
	    $key =~ s/\A"//g;
	    $key =~ s/"\Z//g;
	    $title = $4;
	    if ($title) {
		$title{$cat}{"$key\0$hid"} = $title;
	    } else {
		$title{$cat}{"$key\0$hid"} = $key;
	    }
	    $text{$cat}{"$key\0$hid"} .= "\@c $name $lineno\n";
	    $hids{$cat}{$hid} = 1;
	    if ($cat =~ /^(.*_)?actions/) {
		$desc{"$key\0$hid"} = $pending{'help'};
		$synt{"$key\0$hid"} = $pending{'syntax'};
		%pending = ();
	    }
	    while (<F>) {
		next if /^\*\/$/;
		next if /^\/\*$/;
		last if /%end-doc/;
		s/\@syntax/\@cartouche\n\@format/g;
		s/\@end syntax/\@end format\n\@end cartouche/g;
		if (/^\@nodetype\s*(\S+)/) {
		    $nodetype{$cat}{"$key\0$hid"} = $1;
		    next;
		}
		if (/^\@nodename\s*(.+)/) {
		    $nodename{$cat}{"$key\0$hid"} = $1;
		    next;
		}
		$text{$cat}{"$key\0$hid"} .= $_;
	    }
	}
    }
    close (F);
}