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