38850
|
1 : #-*- Perl -*-
|
|
2 eval 'exec perl -w -S $0 ${1+"$@"}' # Portability kludge
|
75862
|
3 if 0;
|
|
4
|
|
5 # Author: Martin Buchholz
|
|
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
|