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