19210
|
1 ;;; elint.el -- Lint Emacs Lisp
|
|
2
|
|
3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
|
|
4
|
|
5 ;; Author: Peter Liljenberg <petli@lysator.liu.se>
|
|
6 ;; Created: May 1997
|
|
7 ;; Keywords: lisp
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
14 ;; any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
24 ;; Boston, MA 02111-1307, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27
|
|
28 ;; This is a linter for Emacs Lisp. Currently, it mainly catches
|
|
29 ;; mispellings and undefined variables, although it can also catch
|
|
30 ;; function calls with the wrong number of arguments.
|
|
31
|
|
32 ;; Before using, call `elint-initialize' to set up som argument
|
|
33 ;; data. This takes a while. Then call elint-current-buffer or
|
|
34 ;; elint-defun to lint a buffer or a defun.
|
|
35
|
|
36 ;; The linter will try to "include" any require'd libraries to find
|
|
37 ;; the variables defined in those. There is a fair amount of voodoo
|
|
38 ;; involved in this, but it seems to work in normal situations.
|
|
39
|
|
40 ;;; History:
|
|
41
|
|
42 ;;; To do:
|
|
43
|
|
44 ;; * A list of all standard Emacs variables would be nice to have...
|
|
45 ;; * Adding type checking. (Stop that sniggering!)
|
|
46
|
|
47 ;;; Code:
|
|
48
|
|
49 (defvar elint-log-buffer "*Elint*"
|
|
50 "*The buffer to insert lint messages in.")
|
|
51
|
|
52 ;;;
|
|
53 ;;; ADT: top-form
|
|
54 ;;;
|
|
55
|
|
56 (defsubst elint-make-top-form (form pos)
|
|
57 "Create a top form.
|
|
58 FORM is the form, and POS is the point where it starts in the buffer."
|
|
59 (cons form pos))
|
|
60
|
|
61 (defsubst elint-top-form-form (top-form)
|
|
62 "Extract the form from a TOP-FORM."
|
|
63 (car top-form))
|
|
64
|
|
65 (defsubst elint-top-form-pos (top-form)
|
|
66 "Extract the position from a TOP-FORM."
|
|
67 (cdr top-form))
|
|
68
|
|
69 ;;;
|
|
70 ;;; ADT: env
|
|
71 ;;;
|
|
72
|
|
73 (defsubst elint-make-env ()
|
|
74 "Create an empty environment."
|
|
75 (list (list nil) nil nil))
|
|
76
|
|
77 (defsubst elint-env-add-env (env newenv)
|
|
78 "Augment ENV with NEWENV.
|
|
79 None of them is modified, and the new env is returned."
|
|
80 (list (append (car env) (car newenv))
|
|
81 (append (car (cdr env)) (car (cdr newenv)))
|
|
82 (append (car (cdr (cdr env))) (car (cdr (cdr newenv))))))
|
|
83
|
|
84 (defsubst elint-env-add-var (env var)
|
|
85 "Augment ENV with the variable VAR.
|
|
86 The new environment is returned, the old is unmodified."
|
|
87 (cons (cons (list var) (car env)) (cdr env)))
|
|
88
|
|
89 (defsubst elint-env-add-global-var (env var)
|
|
90 "Augment ENV with the variable VAR.
|
|
91 ENV is modified so VAR is seen everywhere.
|
|
92 ENV is returned."
|
|
93 (nconc (car env) (list (list var)))
|
|
94 env)
|
|
95
|
|
96 (defsubst elint-env-find-var (env var)
|
|
97 "Non-nil if ENV contains the variable VAR.
|
|
98 Actually, a list with VAR as a single element is returned."
|
|
99 (assq var (car env)))
|
|
100
|
|
101 (defsubst elint-env-add-func (env func args)
|
|
102 "Augment ENV with the function FUNC, which has the arguments ARGS.
|
|
103 The new environment is returned, the old is unmodified."
|
|
104 (list (car env)
|
|
105 (cons (list func args) (car (cdr env)))
|
|
106 (car (cdr (cdr env)))))
|
|
107
|
|
108 (defsubst elint-env-find-func (env func)
|
|
109 "Non-nil if ENV contains the function FUNC.
|
|
110 Actually, a list of (FUNC ARGS) is returned."
|
|
111 (assq func (car (cdr env))))
|
|
112
|
|
113 (defsubst elint-env-add-macro (env macro def)
|
|
114 "Augment ENV with the macro named MACRO.
|
|
115 DEF is the macro definition (a lambda expression or similar).
|
|
116 The new environment is returned, the old is unmodified."
|
|
117 (list (car env)
|
|
118 (car (cdr env))
|
|
119 (cons (cons macro def) (car (cdr (cdr env))))))
|
|
120
|
|
121 (defsubst elint-env-macro-env (env)
|
|
122 "Return the macro environment of ENV.
|
|
123 This environment can be passed to `macroexpand'."
|
|
124 (car (cdr (cdr env))))
|
|
125
|
|
126 (defsubst elint-env-macrop (env macro)
|
|
127 "Non-nil if ENV contains MACRO."
|
|
128 (assq macro (elint-env-macro-env env)))
|
|
129
|
|
130 ;;;
|
|
131 ;;; User interface
|
|
132 ;;;
|
|
133
|
|
134 (defun elint-current-buffer ()
|
|
135 "Lint the current buffer."
|
|
136 (interactive)
|
|
137 (elint-clear-log (format "Linting %s" (if (buffer-file-name)
|
|
138 (buffer-file-name)
|
|
139 (buffer-name))))
|
|
140 (elint-display-log)
|
|
141 (mapcar 'elint-top-form (elint-update-env))
|
|
142
|
|
143 ;; Tell the user we're finished. This is terribly klugy: we set
|
|
144 ;; elint-top-form-logged so elint-log-message doesn't print the
|
|
145 ;; ** top form ** header...
|
|
146 (let ((elint-top-form-logged t))
|
|
147 (elint-log-message "\nLinting complete.\n")))
|
|
148
|
|
149 (defun elint-defun ()
|
|
150 "Lint the function at point."
|
|
151 (interactive)
|
|
152 (save-excursion
|
|
153 (if (not (beginning-of-defun))
|
|
154 (error "Lint what?"))
|
|
155
|
|
156 (let ((pos (point))
|
|
157 (def (read (current-buffer))))
|
|
158 (elint-display-log)
|
|
159
|
|
160 (elint-update-env)
|
|
161 (elint-top-form (elint-make-top-form def pos)))))
|
|
162
|
|
163 ;;;
|
|
164 ;;; Top form functions
|
|
165 ;;;
|
|
166
|
|
167 (defvar elint-buffer-env nil
|
|
168 "The environment of a elisp buffer.
|
|
169 Will be local in linted buffers.")
|
|
170
|
|
171 (defvar elint-buffer-forms nil
|
|
172 "The top forms in a buffer.
|
|
173 Will be local in linted buffers.")
|
|
174
|
|
175 (defvar elint-last-env-time nil
|
|
176 "The last time the buffers env was updated.
|
|
177 Is measured in buffer-modified-ticks and is local in linted buffers.")
|
|
178
|
|
179 (defun elint-update-env ()
|
|
180 "Update the elint environment in the current buffer.
|
|
181 Don't do anything if the buffer hasn't been changed since this
|
|
182 function was called the last time.
|
|
183 Returns the forms."
|
|
184 (if (and (local-variable-p 'elint-buffer-env (current-buffer))
|
|
185 (local-variable-p 'elint-buffer-forms (current-buffer))
|
|
186 (local-variable-p 'elint-last-env-time (current-buffer))
|
|
187 (= (buffer-modified-tick) elint-last-env-time))
|
|
188 ;; Env is up to date
|
|
189 elint-buffer-forms
|
|
190 ;; Remake env
|
|
191 (set (make-local-variable 'elint-buffer-forms) (elint-get-top-forms))
|
|
192 (set (make-local-variable 'elint-buffer-env)
|
|
193 (elint-init-env elint-buffer-forms))
|
|
194 (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
|
|
195 elint-buffer-forms))
|
|
196
|
|
197 (defun elint-get-top-forms ()
|
|
198 "Collect all the top forms in the current buffer."
|
|
199 (save-excursion
|
|
200 (let ((tops nil))
|
|
201 (goto-char (point-min))
|
|
202 (while (elint-find-next-top-form)
|
|
203 (let ((pos (point)))
|
|
204 (condition-case nil
|
|
205 (setq tops (cons
|
|
206 (elint-make-top-form (read (current-buffer)) pos)
|
|
207 tops))
|
|
208 (end-of-file
|
|
209 (goto-char pos)
|
|
210 (end-of-line)
|
|
211 (error "Missing ')' in top form: %s" (buffer-substring pos (point)))))
|
|
212 ))
|
|
213 (nreverse tops))))
|
|
214
|
|
215 (defun elint-find-next-top-form ()
|
|
216 "Find the next top form from point.
|
|
217 Returns nil if there are no more forms, T otherwise."
|
|
218 (parse-partial-sexp (point) (point-max) nil t)
|
|
219 (not (eobp)))
|
|
220
|
|
221 (defun elint-init-env (forms)
|
|
222 "Initialise the environment from FORMS."
|
|
223 (let ((env (elint-make-env))
|
|
224 form)
|
|
225 (while forms
|
|
226 (setq form (elint-top-form-form (car forms))
|
|
227 forms (cdr forms))
|
|
228 (cond
|
|
229 ;; Add defined variable
|
|
230 ((memq (car form) '(defvar defconst defcustom))
|
|
231 (setq env (elint-env-add-var env (car (cdr form)))))
|
|
232 ;; Add function
|
|
233 ((memq (car form) '(defun defsubst))
|
|
234 (setq env (elint-env-add-func env (car (cdr form))
|
|
235 (car (cdr (cdr form))))))
|
|
236 ;; Add macro, both as a macro and as a function
|
|
237 ((eq (car form) 'defmacro)
|
|
238 (setq env (elint-env-add-macro env (car (cdr form))
|
|
239 (cons 'lambda
|
|
240 (cdr (cdr form))))
|
|
241 env (elint-env-add-func env (car (cdr form))
|
|
242 (car (cdr (cdr form))))))
|
|
243
|
|
244 ;; Import variable definitions
|
|
245 ((eq (car form) 'require)
|
|
246 (let ((name (eval (car (cdr form))))
|
|
247 (file (eval (car (cdr (cdr form))))))
|
|
248 (setq env (elint-add-required-env env name file))))
|
|
249 ))
|
|
250 env))
|
|
251
|
|
252 (defun elint-add-required-env (env name file)
|
|
253 "Augment ENV with the variables definied by feature NAME in FILE."
|
|
254 (condition-case nil
|
|
255 (let* ((libname (if (stringp file)
|
|
256 file
|
|
257 (symbol-name name)))
|
|
258
|
|
259 ;; First try to find .el files, then the raw name
|
|
260 (lib1 (locate-library (concat libname ".el") t))
|
|
261 (lib (if lib1 lib1 (locate-library libname t))))
|
|
262 ;; Clear the messages :-/
|
|
263 (message nil)
|
|
264 (if lib
|
|
265 (save-excursion
|
|
266 (set-buffer (find-file-noselect lib))
|
|
267 (elint-update-env)
|
|
268 (setq env (elint-env-add-env env elint-buffer-env)))
|
|
269 (error "dummy error...")))
|
|
270 (error
|
|
271 (ding)
|
|
272 (message "Can't get variables from require'd library %s" name)))
|
|
273 env)
|
|
274
|
|
275 (defun regexp-assoc (regexp alist)
|
|
276 "Search for a key matching REGEXP in ALIST."
|
|
277 (let ((res nil))
|
|
278 (while (and alist (not res))
|
|
279 (if (and (stringp (car (car alist)))
|
|
280 (string-match regexp (car (car alist))))
|
|
281 (setq res (car alist))
|
|
282 (setq alist (cdr alist))))
|
|
283 res))
|
|
284
|
|
285 (defvar elint-top-form nil
|
|
286 "The currently linted top form, or nil.")
|
|
287
|
|
288 (defvar elint-top-form-logged nil
|
|
289 "T if the currently linted top form has been mentioned in the log buffer.")
|
|
290
|
|
291 (defun elint-top-form (form)
|
|
292 "Lint a top FORM."
|
|
293 (let ((elint-top-form form)
|
|
294 (elint-top-form-logged nil))
|
|
295 (elint-form (elint-top-form-form form) elint-buffer-env)))
|
|
296
|
|
297 ;;;
|
|
298 ;;; General form linting functions
|
|
299 ;;;
|
|
300
|
|
301 (defconst elint-special-forms
|
|
302 '((let . elint-check-let-form)
|
|
303 (let* . elint-check-let-form)
|
|
304 (setq . elint-check-setq-form)
|
|
305 (quote . elint-check-quote-form)
|
|
306 (cond . elint-check-cond-form)
|
|
307 (lambda . elint-check-defun-form)
|
|
308 (function . elint-check-function-form)
|
|
309 (setq-default . elint-check-setq-form)
|
|
310 (defun . elint-check-defun-form)
|
|
311 (defsubst . elint-check-defun-form)
|
|
312 (defmacro . elint-check-defun-form)
|
|
313 (defvar . elint-check-defvar-form)
|
|
314 (defconst . elint-check-defvar-form)
|
|
315 (defcustom . elint-check-defvar-form)
|
|
316 (macro . elint-check-macro-form)
|
|
317 (condition-case . elint-check-condition-case-form))
|
|
318 "Functions to call when some special form should be linted.")
|
|
319
|
|
320 (defun elint-form (form env)
|
|
321 "Lint FORM in the environment ENV.
|
|
322 The environment created by the form is returned."
|
|
323 (cond
|
|
324 ((consp form)
|
|
325 (let ((func (cdr (assq (car form) elint-special-forms))))
|
|
326 (if func
|
|
327 ;; Special form
|
|
328 (funcall func form env)
|
|
329
|
|
330 (let* ((func (car form))
|
|
331 (args (elint-get-args func env))
|
|
332 (argsok t))
|
|
333 (cond
|
|
334 ((eq args 'undefined)
|
|
335 (setq argsok nil)
|
|
336 (elint-error "Call to undefined function: %s" form))
|
|
337
|
|
338 ((eq args 'unknown) nil)
|
|
339
|
|
340 (t (setq argsok (elint-match-args form args))))
|
|
341
|
|
342 ;; Is this a macro?
|
|
343 (if (elint-env-macrop env func)
|
|
344 ;; Macro defined in buffer, expand it
|
|
345 (if argsok
|
|
346 (elint-form (macroexpand form (elint-env-macro-env env)) env)
|
|
347 env)
|
|
348
|
|
349 (let ((fcode (if (symbolp func)
|
|
350 (if (fboundp func)
|
|
351 (indirect-function func)
|
|
352 nil)
|
|
353 func)))
|
|
354 (if (and (listp fcode) (eq (car fcode) 'macro))
|
|
355 ;; Macro defined outside buffer
|
|
356 (if argsok
|
|
357 (elint-form (macroexpand form) env)
|
|
358 env)
|
|
359 ;; Function, lint its parameters
|
|
360 (elint-forms (cdr form) env))))
|
|
361 ))
|
|
362 ))
|
|
363 ((symbolp form)
|
|
364 ;; :foo variables are quoted
|
|
365 (if (and (/= (aref (symbol-name form) 0) ?:)
|
|
366 (elint-unbound-variable form env))
|
|
367 (elint-warning "Reference to unbound symbol: %s" form))
|
|
368 env)
|
|
369
|
|
370 (t env)
|
|
371 ))
|
|
372
|
|
373 (defun elint-forms (forms env)
|
|
374 "Lint the FORMS, accumulating an environment, starting with ENV."
|
|
375 ;; grumblegrumbletailrecursiongrumblegrumble
|
|
376 (while forms
|
|
377 (setq env (elint-form (car forms) env)
|
|
378 forms (cdr forms)))
|
|
379 env)
|
|
380
|
|
381 (defun elint-unbound-variable (var env)
|
|
382 "T if VAR is unbound in ENV."
|
|
383 (not (or (eq var nil)
|
|
384 (eq var t)
|
|
385 (elint-env-find-var env var)
|
|
386 (memq var elint-standard-variables))))
|
|
387
|
|
388 ;;;
|
|
389 ;;; Function argument checking
|
|
390 ;;;
|
|
391
|
|
392 (defun elint-match-args (arglist argpattern)
|
|
393 "Match ARGLIST against ARGPATTERN."
|
|
394
|
|
395 (let ((state 'all)
|
|
396 (al (cdr arglist))
|
|
397 (ap argpattern)
|
|
398 (ok t))
|
|
399 (while
|
|
400 (cond
|
|
401 ((and (null al) (null ap)) nil)
|
|
402 ((eq (car ap) '&optional)
|
|
403 (setq state 'optional)
|
|
404 (setq ap (cdr ap))
|
|
405 t)
|
|
406 ((eq (car ap) '&rest)
|
|
407 nil)
|
|
408 ((or (and (eq state 'all) (or (null al) (null ap)))
|
|
409 (and (eq state 'optional) (and al (null ap))))
|
|
410 (elint-error "Wrong number of args: %s, %s" arglist argpattern)
|
|
411 (setq ok nil)
|
|
412 nil)
|
|
413 ((and (eq state 'optional) (null al))
|
|
414 nil)
|
|
415 (t (setq al (cdr al)
|
|
416 ap (cdr ap))
|
|
417 t)))
|
|
418 ok))
|
|
419
|
|
420 (defun elint-get-args (func env)
|
|
421 "Find the args of FUNC in ENV.
|
|
422 Returns `unknown' if we couldn't find arguments."
|
|
423 (let ((f (elint-env-find-func env func)))
|
|
424 (if f
|
|
425 (car (cdr f))
|
|
426 (if (symbolp func)
|
|
427 (if (fboundp func)
|
|
428 (let ((fcode (indirect-function func)))
|
|
429 (if (subrp fcode)
|
|
430 (let ((args (get func 'elint-args)))
|
|
431 (if args args 'unknown))
|
|
432 (elint-find-args-in-code fcode)))
|
|
433 'undefined)
|
|
434 (elint-find-args-in-code func)))))
|
|
435
|
|
436 (defun elint-find-args-in-code (code)
|
|
437 "Extract the arguments from CODE.
|
|
438 CODE can be a lambda expression, a macro, or byte-compiled code."
|
|
439 (cond
|
|
440 ((byte-code-function-p code)
|
|
441 (aref code 0))
|
|
442 ((and (listp code) (eq (car code) 'lambda))
|
|
443 (car (cdr code)))
|
|
444 ((and (listp code) (eq (car code) 'macro))
|
|
445 (elint-find-args-in-code (cdr code)))
|
|
446 (t 'unknown)))
|
|
447
|
|
448 ;;;
|
|
449 ;;; Functions to check some special forms
|
|
450 ;;;
|
|
451
|
|
452 (defun elint-check-cond-form (form env)
|
|
453 "Lint a cond FORM in ENV."
|
|
454 (setq form (cdr form))
|
|
455 (while form
|
|
456 (if (consp (car form))
|
|
457 (elint-forms (car form) env)
|
|
458 (elint-error "cond clause should be a list: %s" (car form)))
|
|
459 (setq form (cdr form)))
|
|
460 env)
|
|
461
|
|
462 (defun elint-check-defun-form (form env)
|
|
463 "Lint a defun/defmacro/lambda FORM in ENV."
|
|
464 (setq form (if (eq (car form) 'lambda) (cdr form) (cdr (cdr form))))
|
|
465 (mapcar (function (lambda (p)
|
|
466 (or (memq p '(&optional &rest))
|
|
467 (setq env (elint-env-add-var env p)))
|
|
468 ))
|
|
469 (car form))
|
|
470 (elint-forms (cdr form) env))
|
|
471
|
|
472 (defun elint-check-let-form (form env)
|
|
473 "Lint the let/let* FORM in ENV."
|
|
474 (let ((varlist (car (cdr form))))
|
|
475 (if (not varlist)
|
|
476 (progn
|
|
477 (elint-error "Missing varlist in let: %s" form)
|
|
478 env)
|
|
479
|
|
480 ;; Check for (let (a (car b)) ...) type of error
|
|
481 (if (and (= (length varlist) 2)
|
|
482 (symbolp (car varlist))
|
|
483 (listp (car (cdr varlist)))
|
|
484 (fboundp (car (car (cdr varlist)))))
|
|
485 (elint-warning "Suspect varlist: %s" form))
|
|
486
|
|
487 ;; Add variables to environment, and check the init values
|
|
488 (let ((newenv env))
|
|
489 (mapcar (function (lambda (s)
|
|
490 (cond
|
|
491 ((symbolp s)
|
|
492 (setq newenv (elint-env-add-var newenv s)))
|
|
493 ((and (consp s) (<= (length s) 2))
|
|
494 (elint-form (car (cdr s))
|
|
495 (if (eq (car form) 'let)
|
|
496 env
|
|
497 newenv))
|
|
498 (setq newenv
|
|
499 (elint-env-add-var newenv (car s))))
|
|
500 (t (elint-error
|
|
501 "Malformed `let' declaration: %s" s))
|
|
502 )))
|
|
503 varlist)
|
|
504
|
|
505 ;; Lint the body forms
|
|
506 (elint-forms (cdr (cdr form)) newenv)
|
|
507 ))))
|
|
508
|
|
509 (defun elint-check-setq-form (form env)
|
|
510 "Lint the setq FORM in ENV."
|
|
511 (or (= (mod (length form) 2) 1)
|
|
512 (elint-error "Missing value in setq: %s" form))
|
|
513
|
|
514 (let ((newenv env)
|
|
515 sym val)
|
|
516 (setq form (cdr form))
|
|
517 (while form
|
|
518 (setq sym (car form)
|
|
519 val (car (cdr form))
|
|
520 form (cdr (cdr form)))
|
|
521 (if (symbolp sym)
|
|
522 (if (elint-unbound-variable sym newenv)
|
|
523 (elint-warning "Setting previously unbound symbol: %s" sym))
|
|
524 (elint-error "Setting non-symbol in setq: %s" sym))
|
|
525 (elint-form val newenv)
|
|
526 (if (symbolp sym)
|
|
527 (setq newenv (elint-env-add-var newenv sym))))
|
|
528 newenv))
|
|
529
|
|
530 (defun elint-check-defvar-form (form env)
|
|
531 "Lint the defvar/defconst FORM in ENV."
|
|
532 (if (or (= (length form) 2)
|
|
533 (= (length form) 3)
|
|
534 (and (= (length form) 4) (stringp (nth 3 form))))
|
|
535 (elint-env-add-global-var (elint-form (nth 2 form) env)
|
|
536 (car (cdr form)))
|
|
537 (elint-error "Malformed variable declaration: %s" form)
|
|
538 env))
|
|
539
|
|
540 (defun elint-check-function-form (form env)
|
|
541 "Lint the function FORM in ENV."
|
|
542 (let ((func (car (cdr-safe form))))
|
|
543 (cond
|
|
544 ((symbolp func)
|
|
545 (or (elint-env-find-func env func)
|
|
546 (fboundp func)
|
|
547 (elint-warning "Reference to undefined function: %s" form))
|
|
548 env)
|
|
549 ((and (consp func) (memq (car func) '(lambda macro)))
|
|
550 (elint-form func env))
|
|
551 ((stringp func) env)
|
|
552 (t (elint-error "Not a function object: %s" form)
|
|
553 env)
|
|
554 )))
|
|
555
|
|
556 (defun elint-check-quote-form (form env)
|
|
557 "Lint the quote FORM in ENV."
|
|
558 env)
|
|
559
|
|
560 (defun elint-check-macro-form (form env)
|
|
561 "Check the macro FORM in ENV."
|
|
562 (elint-check-function-form (list (car form) (cdr form)) env))
|
|
563
|
|
564 (defun elint-check-condition-case-form (form env)
|
|
565 "Check the condition-case FORM in ENV."
|
|
566 (let ((resenv env))
|
|
567 (if (< (length form) 3)
|
|
568 (elint-error "Malformed condition-case: %s" form)
|
|
569 (or (symbolp (car (cdr form)))
|
|
570 (elint-warning "First parameter should be a symbol: %s" form))
|
|
571 (setq resenv (elint-form (nth 2 form) env))
|
|
572
|
|
573 (let ((newenv (elint-env-add-var env (car (cdr form))))
|
|
574 (errforms (nthcdr 3 form))
|
|
575 errlist)
|
|
576 (while errforms
|
|
577 (setq errlist (car (car errforms)))
|
|
578 (mapcar (function (lambda (s)
|
|
579 (or (get s 'error-conditions)
|
|
580 (get s 'error-message)
|
|
581 (elint-warning
|
|
582 "Not an error symbol in error handler: %s" s))))
|
|
583 (cond
|
|
584 ((symbolp errlist) (list errlist))
|
|
585 ((listp errlist) errlist)
|
|
586 (t (elint-error "Bad error list in error handler: %s"
|
|
587 errlist)
|
|
588 nil))
|
|
589 )
|
|
590 (elint-forms (cdr (car errforms)) newenv)
|
|
591 (setq errforms (cdr errforms))
|
|
592 )))
|
|
593 resenv))
|
|
594
|
|
595 ;;;
|
|
596 ;;; Message functions
|
|
597 ;;;
|
|
598
|
|
599 ;; elint-error and elint-warning are identical, but they might change
|
|
600 ;; to reflect different seriousness of linting errors
|
|
601
|
|
602 (defun elint-error (string &rest args)
|
|
603 "Report an linting error.
|
|
604 STRING and ARGS are thrown on `format' to get the message."
|
|
605 (let ((errstr (apply 'format string args)))
|
|
606 (elint-log-message errstr)
|
|
607 ))
|
|
608
|
|
609 (defun elint-warning (string &rest args)
|
|
610 "Report an linting warning.
|
|
611 STRING and ARGS are thrown on `format' to get the message."
|
|
612 (let ((errstr (apply 'format string args)))
|
|
613 (elint-log-message errstr)
|
|
614 ))
|
|
615
|
|
616 (defun elint-log-message (errstr)
|
|
617 "Insert ERRSTR last in the lint log buffer."
|
|
618 (save-excursion
|
|
619 (set-buffer (elint-get-log-buffer))
|
|
620 (goto-char (point-max))
|
|
621 (or (bolp) (newline))
|
|
622
|
|
623 ;; Do we have to say where we are?
|
|
624 (if elint-top-form-logged
|
|
625 nil
|
|
626 (insert
|
|
627 (let* ((form (elint-top-form-form elint-top-form))
|
|
628 (top (car form)))
|
|
629 (cond
|
|
630 ((memq top '(defun defsubst))
|
|
631 (format "\n** function %s **\n" (car (cdr form))))
|
|
632 ((eq top 'defmacro)
|
|
633 (format "\n** macro %s **\n" (car (cdr form))))
|
|
634 ((memq top '(defvar defconst))
|
|
635 (format "\n** variable %s **\n" (car (cdr form))))
|
|
636 (t "\n** top level expression **\n"))))
|
|
637 (setq elint-top-form-logged t))
|
|
638
|
|
639 (insert errstr)
|
|
640 (newline)))
|
|
641
|
|
642 (defun elint-clear-log (&optional header)
|
|
643 "Clear the lint log buffer.
|
|
644 Insert HEADER followed by a blank line if non-nil."
|
|
645 (save-excursion
|
|
646 (set-buffer (elint-get-log-buffer))
|
|
647 (erase-buffer)
|
|
648 (if header
|
|
649 (progn
|
|
650 (insert header)
|
|
651 (newline))
|
|
652 )))
|
|
653
|
|
654 (defun elint-display-log ()
|
|
655 "Display the lint log buffer."
|
|
656 (let ((pop-up-windows t))
|
|
657 (display-buffer (elint-get-log-buffer))
|
|
658 (sit-for 0)))
|
|
659
|
|
660 (defun elint-get-log-buffer ()
|
|
661 "Return a log buffer for elint."
|
|
662 (let ((buf (get-buffer elint-log-buffer)))
|
|
663 (if buf
|
|
664 buf
|
|
665 (let ((oldbuf (current-buffer)))
|
|
666 (prog1
|
|
667 (set-buffer (get-buffer-create elint-log-buffer))
|
|
668 (setq truncate-lines t)
|
|
669 (set-buffer oldbuf)))
|
|
670 )))
|
|
671
|
|
672 ;;;
|
|
673 ;;; Initializing code
|
|
674 ;;;
|
|
675
|
|
676 ;;;###autoload
|
|
677 (defun elint-initialize ()
|
|
678 "Initialize elint."
|
|
679 (interactive)
|
|
680 (mapcar (function (lambda (x)
|
|
681 (or (not (symbolp (car x)))
|
|
682 (eq (cdr x) 'unknown)
|
|
683 (put (car x) 'elint-args (cdr x)))))
|
|
684 (elint-find-builtin-args))
|
|
685 (mapcar (function (lambda (x)
|
|
686 (put (car x) 'elint-args (cdr x))))
|
|
687 elint-unknown-builtin-args))
|
|
688
|
|
689
|
|
690 (defun elint-find-builtins ()
|
|
691 "Returns a list of all built-in functions."
|
|
692 (let ((subrs nil))
|
|
693 (mapatoms (lambda (s) (if (and (fboundp s) (subrp (symbol-function s)))
|
|
694 (setq subrs (cons s subrs)))))
|
|
695 subrs
|
|
696 ))
|
|
697
|
|
698 (defun elint-find-builtin-args (&optional list)
|
|
699 "Returns a list of the built-in functions and their arguments.
|
|
700
|
|
701 If LIST is nil, call `elint-find-builtins' to get a list of all built-in
|
|
702 functions, otherwise use LIST.
|
|
703
|
|
704 Each functions is represented by a cons cell:
|
|
705 \(function-symbol . args)
|
|
706 If no documentation could be found args will be `unknown'."
|
|
707
|
|
708 (mapcar (function (lambda (f)
|
|
709 (let ((doc (documentation f t)))
|
|
710 (if (and doc (string-match "\n\n\\((.*)\\)" doc))
|
|
711 (read (match-string 1 doc))
|
|
712 (cons f 'unknown))
|
|
713 )))
|
|
714 (if list list
|
|
715 (elint-find-builtins))))
|
|
716
|
|
717 ;;;
|
|
718 ;;; Data
|
|
719 ;;;
|
|
720
|
|
721 (defconst elint-standard-variables
|
|
722 '(abbrev-mode auto-fill-function buffer-auto-save-file-name
|
|
723 buffer-backed-up buffer-display-table buffer-file-format
|
|
724 buffer-file-name buffer-file-number buffer-file-truename
|
|
725 buffer-file-type buffer-invisibility-spec buffer-offer-save
|
|
726 buffer-read-only buffer-saved-size buffer-undo-list
|
|
727 cache-long-line-scans case-fold-search ctl-arrow comment-column
|
|
728 default-directory defun-prompt-regexp fill-column goal-column
|
|
729 left-margin local-abbrev-table local-write-file-hooks major-mode
|
|
730 mark-active mark-ring minor-modes mode-line-buffer-identification
|
|
731 mode-line-format mode-line-modified mode-line-process mode-name
|
|
732 overwrite-mode paragraph-separate paragraph-start
|
|
733 point-before-scroll require-final-newline selective-display
|
|
734 selective-display-ellipses tab-width truncate-lines vc-mode)
|
|
735 "Standard buffer local vars.")
|
|
736
|
|
737 (defconst elint-unknown-builtin-args
|
|
738 '((while test &rest forms)
|
|
739 (insert-before-markers-and-inherit &rest text)
|
|
740 (catch tag &rest body)
|
|
741 (and &rest args)
|
|
742 (funcall func &rest args)
|
|
743 (insert-string &rest args)
|
|
744 (insert &rest args)
|
|
745 (vconcat &rest args)
|
|
746 (run-hook-with-args hook &rest args)
|
|
747 (message-or-box string &rest args)
|
|
748 (save-window-excursion &rest body)
|
|
749 (append &rest args)
|
|
750 (logior &rest args)
|
|
751 (progn &rest body)
|
|
752 (insert-and-inherit &rest args)
|
|
753 (message-box string &rest args)
|
|
754 (prog2 x y &rest body)
|
|
755 (prog1 first &rest body)
|
|
756 (ml-provide-prefix-argument prefix form)
|
|
757 (insert-before-markers &rest args)
|
|
758 (call-process-region start end program &optional delete
|
|
759 destination display &rest args)
|
|
760 (concat &rest args)
|
|
761 (vector &rest args)
|
|
762 (run-hook-with-args-until-success hook &rest args)
|
|
763 (track-mouse &rest body)
|
|
764 (unwind-protect bodyform &rest unwindforms)
|
|
765 (save-restriction &rest body)
|
|
766 (ml-prefix-argument-loop)
|
|
767 (quote arg)
|
|
768 (make-byte-code &rest args)
|
|
769 (or &rest args)
|
|
770 (cond &rest clauses)
|
|
771 (start-process name buffer program &rest args)
|
|
772 (run-hook-with-args-until-failure hook &rest args)
|
|
773 (if cond then &rest else)
|
|
774 (ml-if)
|
|
775 (apply function &rest args)
|
|
776 (format string &rest args)
|
|
777 (encode-time second minute hour day month year zone &rest args)
|
|
778 (min &rest args)
|
|
779 (logand &rest args)
|
|
780 (logxor &rest args)
|
|
781 (max &rest args)
|
|
782 (list &rest args)
|
|
783 (message string &rest args)
|
|
784 (defvar symbol init doc)
|
|
785 (call-process program &optional infile destination display &rest args)
|
|
786 (with-output-to-temp-buffer bufname &rest body)
|
|
787 (nconc &rest args)
|
|
788 (save-excursion &rest body)
|
|
789 (run-hooks &rest hooks)
|
|
790 (/ x y &rest zs)
|
|
791 (- x &rest y)
|
|
792 (+ &rest args)
|
|
793 (* &rest args)
|
|
794 (interactive &optional args))
|
|
795 "Those built-ins for which we can't find arguments.")
|
|
796
|
|
797 (provide 'elint)
|
|
798
|
|
799 ;;; elint.el ends here
|
|
800
|