Fix bug #14946 with documentation of fringe-mode the variable.
[emacs.git] / admin / check-doc-strings
blobc69ff47ebfbd754153608f44d56e74084238bd43
1 : #-*- Perl -*-
2 eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
3     if 0;
5 # Author: Martin Buchholz
6 # This program is in the public domain.
8 use strict;
9 use POSIX;
11 (my $myName = $0) =~ s@.*/@@; my $usage="
12 Usage: $myName
14 Finds DOCSTRING arg mismatches between
15 formal parameters, docstrings, and lispref texi.
17 This program is in the public domain.\n";
19 die $usage if @ARGV;
20 die $usage unless -r "src/alloc.c" && -d ".bzr" && -d "lisp";
22 my %texi_funtype;
23 my %texi_arglist;
25 my %code_funtype;
26 my %code_arglist;
28 sub FileContents {
29   local $/ = undef;
30   open (FILE, "< $_[0]") or die "$_[0]: $!";
31   return scalar <FILE>;
34 sub Show_details {
35   my ($show_details, $function, $parms, $docstring) = @_;
36   if ($show_details) {
37     print "function = $function $parms\n$docstring\n", "-" x 70, "\n";
38   }
41 sub Check_texi_function {
42   my ($function, $funtype, $docstring, @parms) = @_;
43   my %docstring_parm;
44   my %docstring_word;
45   my %arglist_parm;
46   my $show_details = 0;
48   if (exists $texi_funtype{$function}) {
49     print "duplicate texidoc: $function @parms\n";
50     return;                     # later definition likely bogus package def
51   }
53   $texi_funtype{$function} = $funtype;
54   $texi_arglist{$function} = "@parms";
56   foreach my $parm (@parms) {
57     next if $parm eq '&optional' || $parm eq '&rest';
58     $arglist_parm{$parm} = 1;
59   }
61   foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) {
62     $docstring_parm{$parm} = 1;
63   }
65   foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g)
66     {
67       print "texi \@code missing: $function: $hit\n";
68       $show_details = 1;
69     }
71   #   (my $raw_docstring = $docstring) =~ s/\@var{[^{}]+}//g;
72   #   $raw_docstring =~ s/[^a-zA-Z_-]+/ /g;
73   #   foreach my $word (split (' ', $raw_docstring)) {
74   #     if ($word =~ /^[A-Z][A-Z-]+$/) {
75   #       print "Missing \@var: $function: $word\n";
76   #     }
77   #   }
79   foreach my $parm (keys %docstring_parm) {
80     if (! exists $arglist_parm{$parm}) {
81       print "bogus texi parm: $function: $parm\n";
82       $show_details = 1;
83     }
84   }
86   foreach my $parm (keys %arglist_parm) {
87     if (! exists $docstring_parm{$parm}) {
88       print "undocumented texi parm: $function: $parm\n";
89       $show_details = 1;
90     }
91   }
93   Show_details $show_details, $function, "@parms", $docstring;
96 sub Check_function {
97   my ($function, $funtype, $docstring, @parms) = @_;
98   my %docstring_parm;
99   my %arglist_parm;
100   my $show_details = 0;
102   if (exists $code_funtype{$function}) {
103     print "duplicate codedef: $function @parms\n";
104     return;                     # later definition likely bogus package def
105   }
107   $code_funtype{$function} = $funtype;
108   $code_arglist{$function} = "@parms";
109   #foreach my $parm ($parms =~ /\b[a-z0-9-]{3,}\b/g) {
110   #  $arglist_parm{$parm} = 1;
111   #}
112   foreach my $parm (@parms) {
113     next if $parm eq '&optional' || $parm eq '&rest';
114     $arglist_parm{$parm} = 1;
115   }
116   my $doc_tmp = $docstring;
117   $doc_tmp =~ s/[^A-Za-z0-9_-]/ /g;
118   foreach my $parm (split (' ', $doc_tmp)) {
119     if ($parm =~ /^[A-Z][A-Z0-9-]*$/) {
120       next if $parm =~ /I18N/;
121       next if $parm =~ /M17N/;
122       $parm =~ tr[A-Z][a-z];
123       $docstring_parm{$parm} = 1;
124     }
125   }
126   #  foreach my $parm ($docstring =~ /\b[A-Z0-9-]{1,}\b/g) {
127   #    next if $parm =~ /-$/;
128   #    $parm =~ tr[A-Z][a-z];
129   #    $docstring_parm{$parm} = 1;
130   #  }
131   foreach my $parm (keys %docstring_parm) {
132     next if $parm eq 'tty';
133     next if $parm eq 'fsf';
134     next if $parm eq 'note';
135     next if $parm eq 'warning';
136     next if $parm eq 'bug';
137     next if $parm eq 'ascii';
138     next if $parm eq 'iso';
139     next if $parm eq 'and';
140     next if $parm eq 'absolutely';
141     next if $parm eq 'doc';
142     next if $parm eq 'user';
143     next if $parm eq 'not';
144     next if $parm eq 'must';
145     next if $parm eq 'nil';
146     next if $parm eq 'esc';
147     next if $parm eq 'lfd';
148     next if $parm eq 'gpm';
149     next if $parm eq 'primary';
150     next if $parm eq 'secondary';
151     next if $parm eq 'clipboard';
152     next if length $parm < 3;
153     if (! exists $arglist_parm{$parm}) {
154       print "bogus parm: $function: $parm\n";
155       $show_details = 1;
156     }
157   }
158   foreach my $parm (keys %arglist_parm) {
159     if (! exists $docstring_parm{$parm}) {
160       print "Undocumented parm: $function: $parm\n";
161       $show_details = 1;
162     }
163   }
165   if ($docstring !~ /[\]}!\)\.]\s*\Z/m &&
166       $docstring =~ /\S/ &&
167       $docstring !~ /Keywords supported/)
168     {
169       print "Missing trailing period: $function\n";
170       $show_details = 1;
171     }
173   if (exists $texi_arglist{$function}
174       and "@parms" ne $texi_arglist{$function}
175       and not ("@parms" eq 'int nargs Lisp-Object *args'
176                && $texi_arglist{$function} =~ /&rest/)) {
177     my @texi_parms = split (' ', $texi_arglist{$function});
178     my @a = ("@parms" =~ /&optional/g);
179     my @b = ("@parms" =~ /&rest/g);
180     my @c = ("@texi_parms" =~ /&optional/g);
181     my @d = ("@texi_parms" =~ /&rest/g);
182     if (@parms != @texi_parms
183         || (@a != @c) || (@b != @d)) {
184       print "serious mismatch: $function: @parms --- @texi_parms\n";
185     } else {
186       print "texi mismatch: $function: @parms --- $texi_arglist{$function}\n";
187     }
188     $show_details = 1;
189   }
191   if (exists $texi_funtype{$function}
192       && $texi_funtype{$function} ne $funtype) {
193     print "interactiveness mismatch: $function: $funtype --- $texi_funtype{$function}\n";
194     $show_details = 1;
195   }
197   Show_details $show_details, $function, "@parms", $docstring;
200 my $lisprefdir = "doc/lispref";
201 die "Can't find lispref texi directory.\n" unless -d $lisprefdir;
203 open (FIND, "find $lisprefdir -name '*.texi' -print |") or die;
204 while (my $file = <FIND>) {
205   my @matches = ((FileContents $file) =~
206                  /\@(def(?:fn|un))([^\n]+)\n(.*?)\n\@end def(?:un|fn)/sgo);
207   #              /^\@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@end def(?:un|fn)\n/mgo);
208   while (@matches) {
209     my ($defform, $defn, $docstring) = splice (@matches, 0, 3);
210     #print "defform = $defform\n";
211     #print "defn = $defn\n";
212     #print "docstring = $docstring\n";
213     my ($function, @parms, $funtype);
214     if ($defform eq 'defun') {
215       ($funtype, $function, @parms) = ('Function', split (' ', $defn));
216     } else {
217       die unless $defform eq 'deffn';
218       ($funtype, $function, @parms) = split (' ', $defn);
219     }
220     next if $funtype eq '{Syntax' or $funtype eq '{Prefix';
222     Check_texi_function $function, $funtype, $docstring, @parms;
223   }
226 open (FIND, "find src -name '*.c' -print |") or die;
227 while (my $file = <FIND>) {
228   my @matches =
229     ((FileContents $file) =~
230      /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo);
231   while (@matches) {
232     my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6);
233     $docstring =~ s/^\n+//s;
234     $docstring =~ s/\n+$//s;
235     $parms =~ s/,/ /g;
236     my @parms = split (' ',$parms);
237     for (@parms) { tr/_/-/; s/-$//; }
238     if ($parms !~ /Lisp_Object/) {
239       if ($minargs < @parms) {
240         if ($maxargs =~ /^\d+$/) {
241           die unless $maxargs eq @parms;
242           splice (@parms, $minargs, 0, '&optional');
243         }
244       }
245     }
246     my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function');
247     Check_function $function, $funtype, $docstring, @parms;
248   }
251 my @pkgs;
252 if (-d "../xemacs-packages") {
253   @pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils);
254 } else {
255   @pkgs = ();
257 for (@pkgs) { s@^@../xemacs-packages/@; }
258 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
259 while (my $file = <FIND>) {
260   my $contents = FileContents $file;
261   $contents =~ s/(?:\s|;);.*//mog;
262   my @matches =
263     ($contents =~
264      /\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo);
265   while (@matches) {
266     my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@matches, 0, 5);
268     my $funtype =
269       $defform eq 'defmacro' ? 'Macro' :
270         $code_fragment =~ /^\s*\(interactive\b/so ? 'Command' :
271           'Function';
273     $docstring =~ s/^\n+//s;
274     $docstring =~ s/\n+$//s;
276     my @parms = split (' ', $parms);
278     Check_function $function, $funtype, $docstring, @parms;
279   }
282 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die;
283 while (my $file = <FIND>) {
284   my $contents = FileContents $file;
285   $contents =~ s/(?:\s|;);.*//mog;
287   my @matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog);
288   while (@matches) {
289     my ($alias, $aliasee) = splice (@matches, 0, 2);
290     print "alias $alias aliasee $aliasee\n";
291     if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; }
292     if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; }
293   }
296 foreach my $fun (sort keys %texi_funtype) {
297   if (not exists $code_funtype{$fun}) {
298     print "nuke-this-doc: $fun $texi_funtype{$fun}\n";
299   }