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