view admin/check-doc-strings @ 94928:a9ee82808208

Throughout the file, delete all USE_FONT_BACKEND conditionals. Don't check enable_font_backend. Delete all codes used only when USE_FONT_BACKEND is not defined. (get_font_info_func, list_font_func, load_font_func) (query_font_func, set_frame_fontset_func, find_ccl_program_func) (get_font_repertory_func): Delete them. (FONTSET_SPEC, FONT_DEF_NEW, FONT_DEF_SPEC, FONT_DEF_ENCODING) (FONT_DEF_REPERTORY, RFONT_DEF_FACE, RFONT_DEF_SET_FACE) (RFONT_DEF_FONT_DEF, RFONT_DEF_SPEC, RFONT_DEF_REPERTORY) (RFONT_DEF_OBJECT, RFONT_DEF_SET_OBJECT, RFONT_DEF_SCORE) (RFONT_DEF_SET_SCORE, RFONT_DEF_NEW): New macros. (fontset_compare_rfontdef): New function. (reorder_font_vector): Remove the argument CHARSET-ID. Sort ront-defs by qsort. Adjusted for the change of font-group vector. (load_font_get_repertory): Deleted. (fontset_find_font): Use new macros to ref/set elements of font-def and rfont-def. (fontset_font): Fix the timing of remembering that no font for C. (free_face_fontset): Do nothing if the face has no fontset. (face_suitable_for_char_p): Use new macros to ref/set elements of rfont-def. (face_for_char): Likewise. Call face_for_char with font_object. (fs_load_font): Delete. Delete #pragma surrounding it. (fs_query_fontset): Use strcasecmp instead of strcmp. (generate_ascii_font_name): Adjusted for the format change of font-spec. (Fset_fontset_font): Likewise. Use new macros to set elements of font-def. (Fnew_fontset): Use font_unparse_xlfd to generate FONTSET_ASCII (fontset). (new_fontset_from_font_name): Deleted. (fontset_from_font): Renamed from new_fontset_from_font. Check if a fontset is already created for the font. FIx updating of Vfontset_alias_alist. (fontset_ascii_font): Deleted. (Ffont_info): Adjusted for the format change of font-spec. (Finternal_char_font): Likewise. (Ffontset_info): Likewise. (syms_of_fontset): Don't check load_font_func.

: #-*- Perl -*-
eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
    if 0;

# Author: Martin Buchholz
# This program is in the public domain.

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";
  }
}

# arch-tag: e75331f5-5d1b-4393-ad5b-b0f87b5d47b0