#!/usr/bin/perl
eval "exec /usr/bin/perl -S $0 $*"
    if $running_under_some_shell;
			# this emulates #! processing on NIH machines.
			# (remove #! line above if indigestible)

eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
			# process any FOO=bar switches

#
#	explain - extract on-line documentation from elisp function definitions
#
#  Input is expected to be a concatenation of .el files, each starting with
#  an RCS "Id" line supplying the original filename.  Output is written to
#  corresponding .texinfo files.  Variable references are written to
#  variables.texinfo.  These can be incorporated into documentation
#  using @include statements.
#
#  $Id: explain,v 1.1 1996/12/31 03:02:00 jrv Exp jrv $
#
$[ = 1;			# set array base to 1
$, = ' ';		# set output field separator
$\ = "\n";		# set output record separator

if (($#ARGV+1) != 2) {
    print 'usage: explain  elisp-file';
}
$file_name = 'DUMMY.texinfo';
$variable_file = 'variables.texinfo';
$func_file = $ARGV[1];

line: while (<>) {
    chop;	# strip record separator
    @Fld = split(' ', $_, 9999);
    if (/define-key *emacspeak-keymap/ || 
        /define-key *emacspeak-eterm-keymap/ || 
        /define-key *emacspeak-dtk-submap/) {
# parse a key definition that looks like this:
#            (define-key emacspeak-keymap   "\C-a"
#              'emacspeak-toggle-auditory-icons )
	$text = $_;
	if ($#Fld < 4) {
	    #			print "wrapped line:",text;
	    $_ = &Getline0();
	    $text = $text . $_;
	    #			print "     becomes:",text;

	    ;
	}
#        if ($_ ~ /\'\[003 *[a-zA-Z]*\]/) {
#            $_ ~= s//[/;
#	}
        @b = split(' ', $text);
        $keymap = $b[2];
	if (index($b[3], "'") == 1) {
	    $key = substr($b[3], 2, 999999);
	    $func_name = $b[4];
	}
	else {			# key sequence includes a space
	    $key = substr($text, index($text, "\"") + 1, 999999);
	    $func_name = $key;
	    $key = substr($key, 1, index($key, "\"") - 1);
	    $key =~ s/^ $/[space]/;
	}
	$key =~ s/^\\//;	# eliminate leading `\' on key sequence
	$key =~ s/\@$/@@/;	# escape the `@' for texinfo
	$key =~ s/^\%s$/1/;	# special case - substitute example
                                # add appropriate prefix
        if ($keymap =~ /emacspeak-keymap/) {    
             $key = 'C-e ' . $key;
        }
        elsif ($keymap =~ /emacspeak-dtk-submap/) {
             $key = 'C-e d ' . $key;
         }
         elsif ($keymap =~ /emacspeak-eterm-keymap/) {
              $key = 'C-t ' . $key;
        }
#        if ($func_name =~ /emacspeak-eterm-maybe-send-raw/) {
#            $key = 'C-r C-r';	# special case - insert proper key sequence
#        }
	if (!($i = index($func_name, "'"))) {
	    print $.,': @c bad function name:', $func_name;
	    next;
	}
	$func_name =~ s/^.*'//;
	$func_name =~ s/ *\).*$//;
	$Keys{$func_name} = $key;
    }
}

&Pick('>', $variable_file) &&
    (print $fh '@table @samp');
while (($_ = &Getline2($func_file),$getline_ok)) {
    if ($_ =~ /\$Id:/) {	# found start of a new source code file 
				# -- open new output file to match
	if ($definitions_found) {
	    &Pick('>', $file_name) &&
		(print $fh "\@end table\n");
	}
	if ($collected) {
	    &dump_unbound($file_name);
	}
	delete $opened{$file_name} && close($file_name);
	$definitions_found = 0;
	@t = split(' ', $_);
	$file_name = $t[3];
	$file_name =~ s/\..*$/.texinfo/;
	$file_name =~ s/emacspeak.texinfo/emacspeak-main.texinfo/;
    }
    elsif ($_ =~ /^ *\(defun/ || 
#           $_ =~ /^ *\(defadvice/ ||
           $_ =~ /^ *\(defsubst/) {
	$func_name = $Fld[2];

#	print "found definition of",$func_name;
	$func_name =~ s/ *\(.*$//;
	$_ = &Getline2($func_file);
	$interactive = $_ =~ /[^a-zA-Z0-9-]interactive/;
	if ($_ !~ /^[ \t]*\"/) {
	    if(/^[ \t]*$/) {next;}
            if ($interactive) {
	        print $.,": ",$_, "not the docs";
	        print "interactive =", $interactive;
            }
	    $_ = &Getline2($func_file);
	}
	if ($_ !~ /^[ \t]*\"/) {
	    next;
	}
#	print $_, "is start of docs";
	s/"//;
	$text = '';
	while (1) {
	    $i = index($_, "\"");
	    #				print "quote at offset",i," of ",$0
	    if ($i) {
		last;		# break after finding closing quote
	    }
	    $text = $text . $_ . "\n";
	    $err = ($_ = &Getline2($func_file),$getline_ok);
	    if ($err == 0 || $err == -1) {
		&Pick('>', 'explain.log') &&
		    (print $fh 'error on input file');
		exit 1;
	    }
	}
	$text = $text . substr($_, 1, $i - 1) . "\n";
	# document only interactive functions
	if (!$interactive) {
	    $err = ($_ = &Getline2($func_file),$getline_ok);
	    if ($err == 0 || $err == -1) {
		&Pick('>', 'explain.log') &&
		    (print $fh 'error on input file');
		exit 1;
	    }
	    if ($_ =~ /^$/) {$_ = &Getline2($func_file);}
	    if (!($_ =~ /[^a-zA-Z0-9-]interactive/)) {
		next;
	    }
	}
	if (defined $Keys{$func_name}) {
	    if (!$definitions_found) {
		&Pick('>', $file_name) &&
		    (print $fh '@table @samp');
	    }
	    $definitions_found++;
	    $key = $Keys{$func_name};
	    delete $Keys{$func_name};
	    &Pick('>', $file_name) &&
		(print $fh '@item', $key);
	    &Pick('>', $file_name) &&
		(print $fh '@kindex', $key);
	    &Pick('>', $file_name) &&
		(print $fh '@itemx M-x', $func_name);
	    &Pick('>', $file_name) &&
		(print $fh '@findex', $func_name);
	    &Pick('>', $file_name) &&
		(print $fh $text);
	}
	elsif ($collected) {
	    &Pick('>', $file_name) &&
		(print $fh '@c no key binding for', $func_name);
	    #				print "with usage:",text >file_name;
	    $unbound{$func_name} = $text;
	    $cnt_unbound++;
	    $unbound_file{$func_name} = $file_name;
	}
	else {
	    if (!$definitions_found) {
		&Pick('>', $file_name) &&
		    (print $fh '@table @samp');
	    }
	    $definitions_found++;
            $text =~ s/dfined/defined/;	# fix spelling
            $text =~ s/contnets/contents/; # fix spelling
	    &Pick('>', $file_name) &&
		(print $fh '@c no key binding for', $func_name);
	    &Pick('>', $file_name) &&
		(print $fh '@item M-x', $func_name);
	    &Pick('>', $file_name) &&
		(print $fh '@findex', $func_name);
	    &Pick('>', $file_name) &&
		(print $fh $text);
	}
    }
    elsif ($_ =~ /^\(defvar/) {
	$var_name = $Fld[2];

#	print "found definition of",$var_name;
	$var_name =~ s/ *\(.*$//;
	$_ = &Getline2($func_file);
	if ($_ !~ /^[ \t]*\"/) {
	    $_ = &Getline2($func_file);
	}
	if ($_ !~ /^[ \t]*\"/) {
	    next;
	}
	s/"//;
	if ($_ =~ /^[ \t]*\@/) {
	    next;
	}
	$text = '';
	while (1) {
	    $i = index($_, "\"");
	    #				print "quote at offset",i," of ",$0
	    if ($i) {
		last;
	    }
	    $text = $text . $_ . "\n";
	    $err = ($_ = &Getline2($func_file),$getline_ok);
	    if ($err == 0 || $err == -1) {
		&Pick('>', 'explain.log') &&
		    (print $fh 'error on input file');
		exit 1;
	    }
	}
	$text = $text . substr($_, 1, $i - 1) . "\n";
#        $text =~ s/dfined/defined/g;
	if ($text =~ /(\\\\\{([-a-zA-Z]*)\})/) {
# The documentation includes an entire key binding table.
# We delete the request.
		$text =~ s/(\\\\\{([-a-zA-Z]*)\})//;
	    }
	if ($text =~ /(\\\\\[([-a-zA-Z]*)\])/) {
# The documentation refers to the key binding of a command.
# We must substitute the key binding.
#	    print "This documentation: ",$text;
#	    print "contains this sequence:", $1;
#	    print "which includes this command:", $2;
	    if( defined $Keys{$2}) {
#		print "which is bound to: ", $Keys{$2};
		$s_ = '@kbd{'.($Keys{$2}).'}';
		$s_ =~ s/&/\$&/g, 
#		$s_ =~ s/(\W)/\\$1/g;
#		$text =~ s/$1/eval $s_/e;
		$text =~ s/(\\\\\[([-a-zA-Z]*)\])/$s_/;
#		print "resulting docs:",$text;
	    }
            else { print $., ":", $text, $2, "is not bound to any key"; }
	}
	&Pick('>', $variable_file) &&
	    (print $fh '@item', $var_name);
	&Pick('>', $variable_file) &&
	    (print $fh '@vindex', $var_name);
        $text =~ s/t\!\@\#\$/t!\@\@#\$/g;
	&Pick('>', $variable_file) &&
	    (print $fh $text);
    }
}
if ($definitions_found) {
    &Pick('>', $file_name) &&
	(print $fh '@end table');
}
foreach $name (keys %Keys) {
    print '@c no explanation for', $Keys{$name}, $name;
}
#	dump_unbound("unbound.texinfo");
&Pick('>', $variable_file) &&
    (print $fh '@end table');

exit $ExitValue;

sub dump_unbound {
    local($file_name) = @_;
    if ($cnt_unbound) {
	&Pick('>', $file_name) &&
	    (print $fh "These functions are not bound to a key.\n");
	&Pick('>', $file_name) &&
	    (print $fh '@table @samp');
	foreach $name (keys %unbound) {
	    &Pick('>', $file_name) &&
		(print $fh '@item M-x', $name);
	    &Pick('>', $file_name) &&
		(print $fh '@findex', $name);
	    &Pick('>', $file_name) &&
		(print $fh '@c from:', $unbound_file{$name});
	    &Pick('>', $file_name) &&
		(print $fh $unbound{$name});
	    delete $unbound{$name};
	    $cnt_unbound--;
	}
	&Pick('>', $file_name) &&
	    (print $fh '@end table');
    }
}

sub Getline0 {
    if ($getline_ok = (($_ = <>) ne '')) {
	chop;	# strip record separator
	@Fld = split(' ', $_, 9999);
    }
    $_;
}

sub Getline2 {
    &Pick('',@_);
    if ($getline_ok = (($_ = <$fh>) ne '')) {
	chop;	# strip record separator
	@Fld = split(' ', $_, 9999);
    }
    $_;
}

sub Pick {
    local($mode,$name,$pipe) = @_;
    $fh = $name;
    open($name,$mode.$name.$pipe) unless $opened{$name}++;
}