head     1.1;
branch   1.1.1;
access   ;
symbols  EMACS_21_3:1.1.1.1 FSF_DIST:1.1.1;
locks    ; strict;
comment  @# @;


1.1
date     2004.11.05.11.14.52;  author Ben Wing;  state Exp;
branches 1.1.1.1;
next     ;

1.1.1.1
date     2004.11.05.11.14.52;  author Ben Wing;  state Exp;
branches ;
next     ;


desc
@@



1.1
log
@Initial revision
@
text
@: #-*- Perl -*-
eval 'exec perl -w -S $0 ${1+"$@@"}' # Portability kludge
    if 0; # Author: Martin Buchholz

use strict;
use POSIX;

(my $myName = $0) =~ s@@.*/@@@@; my $usage="
Usage: $myName

Finds DOCSTRING arg mismatches between
formal parameters, docstrings, and lispref texi.

This program is in the public domain.\n";

die $usage if @@ARGV;
die $usage unless -r "src/alloc.c" && -d "CVS" && -d "lisp";

my %texi_funtype;
my %texi_arglist;

my %code_funtype;
my %code_arglist;

sub FileContents {
  local $/ = undef;
  open (FILE, "< $_[0]") or die "$_[0]: $!";
  return scalar <FILE>;
}

sub Show_details {
  my ($show_details, $function, $parms, $docstring) = @@_;
  if ($show_details) {
    print "function = $function $parms\n$docstring\n", "-" x 70, "\n";
  }
}

sub Check_texi_function {
  my ($function, $funtype, $docstring, @@parms) = @@_;
  my %docstring_parm;
  my %docstring_word;
  my %arglist_parm;
  my $show_details = 0;

  if (exists $texi_funtype{$function}) {
    print "duplicate texidoc: $function @@parms\n";
    return;			# later definition likely bogus package def
  }

  $texi_funtype{$function} = $funtype;
  $texi_arglist{$function} = "@@parms";

  foreach my $parm (@@parms) {
    next if $parm eq '&optional' || $parm eq '&rest';
    $arglist_parm{$parm} = 1;
  }

  foreach my $parm ($docstring =~ /\@@var{([^{}]+)}/g) {
    $docstring_parm{$parm} = 1;
  }

  foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g)
    {
      print "texi \@@code missing: $function: $hit\n";
      $show_details = 1;
    }

  #   (my $raw_docstring = $docstring) =~ s/\@@var{[^{}]+}//g;
  #   $raw_docstring =~ s/[^a-zA-Z_-]+/ /g;
  #   foreach my $word (split (' ', $raw_docstring)) {
  #     if ($word =~ /^[A-Z][A-Z-]+$/) {
  #       print "Missing \@@var: $function: $word\n";
  #     }
  #   }

  foreach my $parm (keys %docstring_parm) {
    if (! exists $arglist_parm{$parm}) {
      print "bogus texi parm: $function: $parm\n";
      $show_details = 1;
    }
  }

  foreach my $parm (keys %arglist_parm) {
    if (! exists $docstring_parm{$parm}) {
      print "undocumented texi parm: $function: $parm\n";
      $show_details = 1;
    }
  }

  Show_details $show_details, $function, "@@parms", $docstring;
}

sub Check_function {
  my ($function, $funtype, $docstring, @@parms) = @@_;
  my %docstring_parm;
  my %arglist_parm;
  my $show_details = 0;

  if (exists $code_funtype{$function}) {
    print "duplicate codedef: $function @@parms\n";
    return;			# later definition likely bogus package def
  }

  $code_funtype{$function} = $funtype;
  $code_arglist{$function} = "@@parms";
  #foreach my $parm ($parms =~ /\b[a-z0-9-]{3,}\b/g) {
  #  $arglist_parm{$parm} = 1;
  #}
  foreach my $parm (@@parms) {
    next if $parm eq '&optional' || $parm eq '&rest';
    $arglist_parm{$parm} = 1;
  }
  my $doc_tmp = $docstring;
  $doc_tmp =~ s/[^A-Za-z0-9_-]/ /g;
  foreach my $parm (split (' ', $doc_tmp)) {
    if ($parm =~ /^[A-Z][A-Z0-9-]*$/) {
      next if $parm =~ /I18N/;
      next if $parm =~ /M17N/;
      $parm =~ tr[A-Z][a-z];
      $docstring_parm{$parm} = 1;
    }
  }
  #  foreach my $parm ($docstring =~ /\b[A-Z0-9-]{1,}\b/g) {
  #    next if $parm =~ /-$/;
  #    $parm =~ tr[A-Z][a-z];
  #    $docstring_parm{$parm} = 1;
  #  }
  foreach my $parm (keys %docstring_parm) {
    next if $parm eq 'tty';
    next if $parm eq 'fsf';
    next if $parm eq 'note';
    next if $parm eq 'warning';
    next if $parm eq 'bug';
    next if $parm eq 'ascii';
    next if $parm eq 'iso';
    next if $parm eq 'and';
    next if $parm eq 'absolutely';
    next if $parm eq 'doc';
    next if $parm eq 'user';
    next if $parm eq 'not';
    next if $parm eq 'must';
    next if $parm eq 'nil';
    next if $parm eq 'esc';
    next if $parm eq 'lfd';
    next if $parm eq 'gpm';
    next if $parm eq 'primary';
    next if $parm eq 'secondary';
    next if $parm eq 'clipboard';
    next if length $parm < 3;
    if (! exists $arglist_parm{$parm}) {
      print "bogus parm: $function: $parm\n";
      $show_details = 1;
    }
  }
  foreach my $parm (keys %arglist_parm) {
    if (! exists $docstring_parm{$parm}) {
      print "Undocumented parm: $function: $parm\n";
      $show_details = 1;
    }
  }

  if ($docstring !~ /[\]}!\)\.]\s*\Z/m &&
      $docstring =~ /\S/ &&
      $docstring !~ /Keywords supported/)
    {
      print "Missing trailing period: $function\n";
      $show_details = 1;
    }

  if (exists $texi_arglist{$function}
      and "@@parms" ne $texi_arglist{$function}
      and not ("@@parms" eq 'int nargs Lisp-Object *args'
	       && $texi_arglist{$function} =~ /&rest/)) {
    my @@texi_parms = split (' ', $texi_arglist{$function});
    my @@a = ("@@parms" =~ /&optional/g);
    my @@b = ("@@parms" =~ /&rest/g);
    my @@c = ("@@texi_parms" =~ /&optional/g);
    my @@d = ("@@texi_parms" =~ /&rest/g);
    if (@@parms != @@texi_parms
	|| (@@a != @@c) || (@@b != @@d)) {
      print "serious mismatch: $function: @@parms --- @@texi_parms\n";
    } else {
      print "texi mismatch: $function: @@parms --- $texi_arglist{$function}\n";
    }
    $show_details = 1;
  }

  if (exists $texi_funtype{$function}
      && $texi_funtype{$function} ne $funtype) {
    print "interactiveness mismatch: $function: $funtype --- $texi_funtype{$function}\n";
    $show_details = 1;
  }

  Show_details $show_details, $function, "@@parms", $docstring;
}

my $lisprefdir;
if    (-d "man/lispref") { $lisprefdir = "man/lispref"; }
elsif (-d "lispref") { $lisprefdir = "lispref"; }
else { die "Can't find lispref texi directory.\n"; }

open (FIND, "find $lisprefdir -name '*.texi' -print |") or die;
while (my $file = <FIND>) {
  my @@matches = ((FileContents $file) =~
		 /\@@(def(?:fn|un))([^\n]+)\n(.*?)\n\@@end def(?:un|fn)/sgo);
  #		 /^\@@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@@end def(?:un|fn)\n/mgo);
  while (@@matches) {
    my ($defform, $defn, $docstring) = splice (@@matches, 0, 3);
    #print "defform = $defform\n";
    #print "defn = $defn\n";
    #print "docstring = $docstring\n";
    my ($function, @@parms, $funtype);
    if ($defform eq 'defun') {
      ($funtype, $function, @@parms) = ('Function', split (' ', $defn));
    } else {
      die unless $defform eq 'deffn';
      ($funtype, $function, @@parms) = split (' ', $defn);
    }
    next if $funtype eq '{Syntax' or $funtype eq '{Prefix';

    Check_texi_function $function, $funtype, $docstring, @@parms;
  }
}

open (FIND, "find src -name '*.c' -print |") or die;
while (my $file = <FIND>) {
  my @@matches =
    ((FileContents $file) =~
     /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
  while (@@matches) {
    my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@@matches, 0, 6);
    $docstring =~ s/^\n+//s;
    $docstring =~ s/\n+$//s;
    $parms =~ s/,/ /g;
    my @@parms = split (' ',$parms);
    for (@@parms) { tr/_/-/; s/-$//; }
    if ($parms !~ /Lisp_Object/) {
      if ($minargs < @@parms) {
	if ($maxargs =~ /^\d+$/) {
	  die unless $maxargs eq @@parms;
	  splice (@@parms, $minargs, 0, '&optional');
	}
      }
    }
    my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
    Check_function $function, $funtype, $docstring, @@parms;
  }
}

my @@pkgs;
if (-d "../xemacs-packages") {
  @@pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils);
} else {
  @@pkgs = ();
}
for (@@pkgs) { s@@^@@../xemacs-packages/@@; }
open (FIND, "find lisp @@pkgs -name '*.el' -print |") or die;
while (my $file = <FIND>) {
  my $contents = FileContents $file;
  $contents =~ s/(?:\s|;);.*//mog;
  my @@matches =
    ($contents =~
     /\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo);
  while (@@matches) {
    my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@@matches, 0, 5);

    my $funtype =
      $defform eq 'defmacro' ? 'Macro' :
	$code_fragment =~ /^\s*\(interactive\b/so ? 'Command' :
	  'Function';

    $docstring =~ s/^\n+//s;
    $docstring =~ s/\n+$//s;

    my @@parms = split (' ', $parms);

    Check_function $function, $funtype, $docstring, @@parms;
  }
}

open (FIND, "find lisp @@pkgs -name '*.el' -print |") or die;
while (my $file = <FIND>) {
  my $contents = FileContents $file;
  $contents =~ s/(?:\s|;);.*//mog;

  my @@matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog);
  while (@@matches) {
    my ($alias, $aliasee) = splice (@@matches, 0, 2);
    print "alias $alias aliasee $aliasee\n";
    if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; }
    if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; }
  }
}

foreach my $fun (sort keys %texi_funtype) {
  if (not exists $code_funtype{$fun}) {
    print "nuke-this-doc: $fun $texi_funtype{$fun}\n";
  }
}

@


1.1.1.1
log
@import emacs-21.3
@
text
@@
