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