Mercurial > emacs
annotate admin/check-doc-strings @ 99492:ee792794d888
(isearch-search-fun): Compare the length of the
current search string with the length of the string from the
previous search state to detect the situation when the user
adds or removes characters in the search string.
Use word-search-forward-lax and word-search-backward-lax in this
case, and otherwise word-search-forward and word-search-backward.
author | Juri Linkov <juri@jurta.org> |
---|---|
date | Tue, 11 Nov 2008 19:43:09 +0000 |
parents | 4e2606f6ee72 |
children | dd7c098af727 ef719132ddfa |
rev | line source |
---|---|
38850 | 1 : #-*- Perl -*- |
2 eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge | |
75862
4e2606f6ee72
Make legal status more obvious.
Glenn Morris <rgm@gnu.org>
parents:
52401
diff
changeset
|
3 if 0; |
4e2606f6ee72
Make legal status more obvious.
Glenn Morris <rgm@gnu.org>
parents:
52401
diff
changeset
|
4 |
4e2606f6ee72
Make legal status more obvious.
Glenn Morris <rgm@gnu.org>
parents:
52401
diff
changeset
|
5 # Author: Martin Buchholz |
4e2606f6ee72
Make legal status more obvious.
Glenn Morris <rgm@gnu.org>
parents:
52401
diff
changeset
|
6 # This program is in the public domain. |
38850 | 7 |
8 use strict; | |
9 use POSIX; | |
10 | |
11 (my $myName = $0) =~ s@.*/@@; my $usage=" | |
12 Usage: $myName | |
13 | |
14 Finds DOCSTRING arg mismatches between | |
15 formal parameters, docstrings, and lispref texi. | |
16 | |
17 This program is in the public domain.\n"; | |
18 | |
19 die $usage if @ARGV; | |
20 die $usage unless -r "src/alloc.c" && -d "CVS" && -d "lisp"; | |
21 | |
22 my %texi_funtype; | |
23 my %texi_arglist; | |
24 | |
25 my %code_funtype; | |
26 my %code_arglist; | |
27 | |
28 sub FileContents { | |
29 local $/ = undef; | |
30 open (FILE, "< $_[0]") or die "$_[0]: $!"; | |
31 return scalar <FILE>; | |
32 } | |
33 | |
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 } | |
39 } | |
40 | |
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; | |
47 | |
48 if (exists $texi_funtype{$function}) { | |
49 print "duplicate texidoc: $function @parms\n"; | |
50 return; # later definition likely bogus package def | |
51 } | |
52 | |
53 $texi_funtype{$function} = $funtype; | |
54 $texi_arglist{$function} = "@parms"; | |
55 | |
56 foreach my $parm (@parms) { | |
57 next if $parm eq '&optional' || $parm eq '&rest'; | |
58 $arglist_parm{$parm} = 1; | |
59 } | |
60 | |
61 foreach my $parm ($docstring =~ /\@var{([^{}]+)}/g) { | |
62 $docstring_parm{$parm} = 1; | |
63 } | |
64 | |
65 foreach my $hit ($docstring =~ /[^\`]\`[A-Za-z-]+\'/g) | |
66 { | |
67 print "texi \@code missing: $function: $hit\n"; | |
68 $show_details = 1; | |
69 } | |
70 | |
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 # } | |
78 | |
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 } | |
85 | |
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 } | |
92 | |
93 Show_details $show_details, $function, "@parms", $docstring; | |
94 } | |
95 | |
96 sub Check_function { | |
97 my ($function, $funtype, $docstring, @parms) = @_; | |
98 my %docstring_parm; | |
99 my %arglist_parm; | |
100 my $show_details = 0; | |
101 | |
102 if (exists $code_funtype{$function}) { | |
103 print "duplicate codedef: $function @parms\n"; | |
104 return; # later definition likely bogus package def | |
105 } | |
106 | |
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 } | |
164 | |
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 } | |
172 | |
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 } | |
190 | |
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 } | |
196 | |
197 Show_details $show_details, $function, "@parms", $docstring; | |
198 } | |
199 | |
200 my $lisprefdir; | |
201 if (-d "man/lispref") { $lisprefdir = "man/lispref"; } | |
202 elsif (-d "lispref") { $lisprefdir = "lispref"; } | |
203 else { die "Can't find lispref texi directory.\n"; } | |
204 | |
205 open (FIND, "find $lisprefdir -name '*.texi' -print |") or die; | |
206 while (my $file = <FIND>) { | |
207 my @matches = ((FileContents $file) =~ | |
208 /\@(def(?:fn|un))([^\n]+)\n(.*?)\n\@end def(?:un|fn)/sgo); | |
209 # /^\@(def(?:un|fn))\s+(.*)\n([.|\n]*?)^\@end def(?:un|fn)\n/mgo); | |
210 while (@matches) { | |
211 my ($defform, $defn, $docstring) = splice (@matches, 0, 3); | |
212 #print "defform = $defform\n"; | |
213 #print "defn = $defn\n"; | |
214 #print "docstring = $docstring\n"; | |
215 my ($function, @parms, $funtype); | |
216 if ($defform eq 'defun') { | |
217 ($funtype, $function, @parms) = ('Function', split (' ', $defn)); | |
218 } else { | |
219 die unless $defform eq 'deffn'; | |
220 ($funtype, $function, @parms) = split (' ', $defn); | |
221 } | |
222 next if $funtype eq '{Syntax' or $funtype eq '{Prefix'; | |
223 | |
224 Check_texi_function $function, $funtype, $docstring, @parms; | |
225 } | |
226 } | |
227 | |
228 open (FIND, "find src -name '*.c' -print |") or die; | |
229 while (my $file = <FIND>) { | |
230 my @matches = | |
231 ((FileContents $file) =~ | |
232 /\bDEFUN\s*\(\s*\"((?:[^\\\"]|\\.)+)\"\s*,\s*\S+\s*,\s*(\S+)\s*,\s*(\S+)\s*,\s*((?:0|\"(?:(?:[^\\\"]|\\.)*)\"))\s*,\s*\/\*(.*?)\*\/\s*\(([^()]*)\)\)/sgo); | |
233 while (@matches) { | |
234 my ($function, $minargs, $maxargs, $interactive, $docstring, $parms) = splice (@matches, 0, 6); | |
235 $docstring =~ s/^\n+//s; | |
236 $docstring =~ s/\n+$//s; | |
237 $parms =~ s/,/ /g; | |
238 my @parms = split (' ',$parms); | |
239 for (@parms) { tr/_/-/; s/-$//; } | |
240 if ($parms !~ /Lisp_Object/) { | |
241 if ($minargs < @parms) { | |
242 if ($maxargs =~ /^\d+$/) { | |
243 die unless $maxargs eq @parms; | |
244 splice (@parms, $minargs, 0, '&optional'); | |
245 } | |
246 } | |
247 } | |
248 my $funtype = ($interactive =~ /\"/ ? 'Command' : 'Function'); | |
249 Check_function $function, $funtype, $docstring, @parms; | |
250 } | |
251 } | |
252 | |
253 my @pkgs; | |
254 if (-d "../xemacs-packages") { | |
255 @pkgs = qw (libs/edebug libs/xemacs-base comm/eudc oa/edit-utils); | |
256 } else { | |
257 @pkgs = (); | |
258 } | |
259 for (@pkgs) { s@^@../xemacs-packages/@; } | |
260 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die; | |
261 while (my $file = <FIND>) { | |
262 my $contents = FileContents $file; | |
263 $contents =~ s/(?:\s|;);.*//mog; | |
264 my @matches = | |
265 ($contents =~ | |
266 /\((def(?:un|subst|macro))\s+(\S+)\s+\(([^()]*)\)\s+\"((?:[^\\\"]|\\.)+)\"(.*?)\)/sgo); | |
267 while (@matches) { | |
268 my ($defform, $function, $parms, $docstring, $code_fragment) = splice (@matches, 0, 5); | |
269 | |
270 my $funtype = | |
271 $defform eq 'defmacro' ? 'Macro' : | |
272 $code_fragment =~ /^\s*\(interactive\b/so ? 'Command' : | |
273 'Function'; | |
274 | |
275 $docstring =~ s/^\n+//s; | |
276 $docstring =~ s/\n+$//s; | |
277 | |
278 my @parms = split (' ', $parms); | |
279 | |
280 Check_function $function, $funtype, $docstring, @parms; | |
281 } | |
282 } | |
283 | |
284 open (FIND, "find lisp @pkgs -name '*.el' -print |") or die; | |
285 while (my $file = <FIND>) { | |
286 my $contents = FileContents $file; | |
287 $contents =~ s/(?:\s|;);.*//mog; | |
288 | |
289 my @matches = ($contents =~ /^\((?:defalias|fset|define-function)\s+\'([A-Za-z0-9_-]+)\s+\'([A-Za-z0-9_-]+)/mog); | |
290 while (@matches) { | |
291 my ($alias, $aliasee) = splice (@matches, 0, 2); | |
292 print "alias $alias aliasee $aliasee\n"; | |
293 if (exists $code_funtype{$aliasee}) { $code_funtype{$alias} = $code_funtype{$aliasee}; } | |
294 if (exists $code_arglist{$aliasee}) { $code_arglist{$alias} = $code_arglist{$aliasee}; } | |
295 } | |
296 } | |
297 | |
298 foreach my $fun (sort keys %texi_funtype) { | |
299 if (not exists $code_funtype{$fun}) { | |
300 print "nuke-this-doc: $fun $texi_funtype{$fun}\n"; | |
301 } | |
302 } | |
303 | |
52401 | 304 # arch-tag: e75331f5-5d1b-4393-ad5b-b0f87b5d47b0 |