Mercurial > emacs
annotate lisp/emacs-lisp/elint.el @ 83220:fe1db7935e1a
Fix core dump in redisplay window. (Reported by Yoshiaki Kasahara.) Plus cleanups.
* src/xdisp.c (handle_single_display_prop): Use FRAME_WINDOW_P instead of
checking against specific frame types. Ignore images on non-window
frames.
(echo_area_display): Use FRAME_INITIAL_P to check for initial frame.
(redisplay_preserve_echo_area): Update for multi-tty support.
(redisplay_window): Don't bother with toolbars, fringe bitmaps or
vertical borders on tty frames.
(display_line): Remove superflous #ifdefs.
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-260
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Thu, 14 Oct 2004 14:58:43 +0000 |
parents | 9417a94488d3 |
children | 4ea947ec3dac |
rev | line source |
---|---|
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
20014
diff
changeset
|
1 ;;; elint.el --- Lint Emacs Lisp |
19210 | 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"))) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
148 |
19210 | 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)) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
196 |
19210 | 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. | |
42206 | 217 Return nil if there are no more forms, t otherwise." |
19210 | 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) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
274 |
19210 | 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) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
315 (defcustom . elint-check-defcustom-form) |
19210 | 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.") | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
319 |
19210 | 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)) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
337 |
19210 | 338 ((eq args 'unknown) nil) |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
339 |
19210 | 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)) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
529 |
19210 | 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)) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
539 |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
540 (defun elint-check-defcustom-form (form env) |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
541 "Lint the defcustom FORM in ENV." |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
542 (if (and (> (length form) 3) |
52880
9417a94488d3
(elint-check-defcustom-form): Don't use `evenp' so we don't implicitly
John Paul Wallington <jpw@pobox.com>
parents:
52401
diff
changeset
|
543 ;; even no. of keyword/value args ? |
9417a94488d3
(elint-check-defcustom-form): Don't use `evenp' so we don't implicitly
John Paul Wallington <jpw@pobox.com>
parents:
52401
diff
changeset
|
544 (zerop (logand (length form) 1))) |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
545 (elint-env-add-global-var (elint-form (nth 2 form) env) |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
546 (car (cdr form))) |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
547 (elint-error "Malformed variable declaration: %s" form) |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
548 env)) |
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
549 |
19210 | 550 (defun elint-check-function-form (form env) |
551 "Lint the function FORM in ENV." | |
552 (let ((func (car (cdr-safe form)))) | |
553 (cond | |
554 ((symbolp func) | |
555 (or (elint-env-find-func env func) | |
556 (fboundp func) | |
557 (elint-warning "Reference to undefined function: %s" form)) | |
558 env) | |
559 ((and (consp func) (memq (car func) '(lambda macro))) | |
560 (elint-form func env)) | |
561 ((stringp func) env) | |
562 (t (elint-error "Not a function object: %s" form) | |
563 env) | |
564 ))) | |
565 | |
566 (defun elint-check-quote-form (form env) | |
567 "Lint the quote FORM in ENV." | |
568 env) | |
569 | |
570 (defun elint-check-macro-form (form env) | |
571 "Check the macro FORM in ENV." | |
572 (elint-check-function-form (list (car form) (cdr form)) env)) | |
573 | |
574 (defun elint-check-condition-case-form (form env) | |
575 "Check the condition-case FORM in ENV." | |
576 (let ((resenv env)) | |
577 (if (< (length form) 3) | |
578 (elint-error "Malformed condition-case: %s" form) | |
579 (or (symbolp (car (cdr form))) | |
580 (elint-warning "First parameter should be a symbol: %s" form)) | |
581 (setq resenv (elint-form (nth 2 form) env)) | |
582 | |
583 (let ((newenv (elint-env-add-var env (car (cdr form)))) | |
584 (errforms (nthcdr 3 form)) | |
585 errlist) | |
586 (while errforms | |
587 (setq errlist (car (car errforms))) | |
588 (mapcar (function (lambda (s) | |
589 (or (get s 'error-conditions) | |
590 (get s 'error-message) | |
591 (elint-warning | |
592 "Not an error symbol in error handler: %s" s)))) | |
593 (cond | |
594 ((symbolp errlist) (list errlist)) | |
595 ((listp errlist) errlist) | |
596 (t (elint-error "Bad error list in error handler: %s" | |
597 errlist) | |
598 nil)) | |
599 ) | |
600 (elint-forms (cdr (car errforms)) newenv) | |
601 (setq errforms (cdr errforms)) | |
602 ))) | |
603 resenv)) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
604 |
19210 | 605 ;;; |
606 ;;; Message functions | |
607 ;;; | |
608 | |
609 ;; elint-error and elint-warning are identical, but they might change | |
610 ;; to reflect different seriousness of linting errors | |
611 | |
612 (defun elint-error (string &rest args) | |
47923
07d91c802db4
(elint-error, elint-warning): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
42268
diff
changeset
|
613 "Report a linting error. |
19210 | 614 STRING and ARGS are thrown on `format' to get the message." |
615 (let ((errstr (apply 'format string args))) | |
616 (elint-log-message errstr) | |
617 )) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
618 |
19210 | 619 (defun elint-warning (string &rest args) |
47923
07d91c802db4
(elint-error, elint-warning): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
42268
diff
changeset
|
620 "Report a linting warning. |
19210 | 621 STRING and ARGS are thrown on `format' to get the message." |
622 (let ((errstr (apply 'format string args))) | |
623 (elint-log-message errstr) | |
624 )) | |
625 | |
626 (defun elint-log-message (errstr) | |
627 "Insert ERRSTR last in the lint log buffer." | |
628 (save-excursion | |
629 (set-buffer (elint-get-log-buffer)) | |
630 (goto-char (point-max)) | |
631 (or (bolp) (newline)) | |
632 | |
633 ;; Do we have to say where we are? | |
634 (if elint-top-form-logged | |
635 nil | |
636 (insert | |
637 (let* ((form (elint-top-form-form elint-top-form)) | |
638 (top (car form))) | |
639 (cond | |
640 ((memq top '(defun defsubst)) | |
641 (format "\n** function %s **\n" (car (cdr form)))) | |
642 ((eq top 'defmacro) | |
643 (format "\n** macro %s **\n" (car (cdr form)))) | |
644 ((memq top '(defvar defconst)) | |
645 (format "\n** variable %s **\n" (car (cdr form)))) | |
646 (t "\n** top level expression **\n")))) | |
647 (setq elint-top-form-logged t)) | |
648 | |
649 (insert errstr) | |
650 (newline))) | |
651 | |
652 (defun elint-clear-log (&optional header) | |
653 "Clear the lint log buffer. | |
654 Insert HEADER followed by a blank line if non-nil." | |
655 (save-excursion | |
656 (set-buffer (elint-get-log-buffer)) | |
657 (erase-buffer) | |
658 (if header | |
659 (progn | |
660 (insert header) | |
661 (newline)) | |
662 ))) | |
663 | |
664 (defun elint-display-log () | |
665 "Display the lint log buffer." | |
666 (let ((pop-up-windows t)) | |
667 (display-buffer (elint-get-log-buffer)) | |
668 (sit-for 0))) | |
669 | |
670 (defun elint-get-log-buffer () | |
671 "Return a log buffer for elint." | |
672 (let ((buf (get-buffer elint-log-buffer))) | |
673 (if buf | |
674 buf | |
675 (let ((oldbuf (current-buffer))) | |
676 (prog1 | |
677 (set-buffer (get-buffer-create elint-log-buffer)) | |
678 (setq truncate-lines t) | |
679 (set-buffer oldbuf))) | |
680 ))) | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
681 |
19210 | 682 ;;; |
683 ;;; Initializing code | |
684 ;;; | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
685 |
19210 | 686 ;;;###autoload |
687 (defun elint-initialize () | |
688 "Initialize elint." | |
689 (interactive) | |
690 (mapcar (function (lambda (x) | |
691 (or (not (symbolp (car x))) | |
692 (eq (cdr x) 'unknown) | |
693 (put (car x) 'elint-args (cdr x))))) | |
694 (elint-find-builtin-args)) | |
695 (mapcar (function (lambda (x) | |
696 (put (car x) 'elint-args (cdr x)))) | |
697 elint-unknown-builtin-args)) | |
698 | |
699 | |
700 (defun elint-find-builtins () | |
701 "Returns a list of all built-in functions." | |
702 (let ((subrs nil)) | |
703 (mapatoms (lambda (s) (if (and (fboundp s) (subrp (symbol-function s))) | |
704 (setq subrs (cons s subrs))))) | |
705 subrs | |
706 )) | |
707 | |
708 (defun elint-find-builtin-args (&optional list) | |
709 "Returns a list of the built-in functions and their arguments. | |
710 | |
711 If LIST is nil, call `elint-find-builtins' to get a list of all built-in | |
712 functions, otherwise use LIST. | |
713 | |
714 Each functions is represented by a cons cell: | |
715 \(function-symbol . args) | |
716 If no documentation could be found args will be `unknown'." | |
717 | |
718 (mapcar (function (lambda (f) | |
719 (let ((doc (documentation f t))) | |
720 (if (and doc (string-match "\n\n\\((.*)\\)" doc)) | |
721 (read (match-string 1 doc)) | |
722 (cons f 'unknown)) | |
723 ))) | |
724 (if list list | |
725 (elint-find-builtins)))) | |
726 | |
727 ;;; | |
728 ;;; Data | |
729 ;;; | |
730 | |
731 (defconst elint-standard-variables | |
732 '(abbrev-mode auto-fill-function buffer-auto-save-file-name | |
733 buffer-backed-up buffer-display-table buffer-file-format | |
734 buffer-file-name buffer-file-number buffer-file-truename | |
735 buffer-file-type buffer-invisibility-spec buffer-offer-save | |
736 buffer-read-only buffer-saved-size buffer-undo-list | |
737 cache-long-line-scans case-fold-search ctl-arrow comment-column | |
738 default-directory defun-prompt-regexp fill-column goal-column | |
739 left-margin local-abbrev-table local-write-file-hooks major-mode | |
740 mark-active mark-ring minor-modes mode-line-buffer-identification | |
741 mode-line-format mode-line-modified mode-line-process mode-name | |
742 overwrite-mode paragraph-separate paragraph-start | |
743 point-before-scroll require-final-newline selective-display | |
744 selective-display-ellipses tab-width truncate-lines vc-mode) | |
745 "Standard buffer local vars.") | |
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
746 |
19210 | 747 (defconst elint-unknown-builtin-args |
748 '((while test &rest forms) | |
749 (insert-before-markers-and-inherit &rest text) | |
750 (catch tag &rest body) | |
751 (and &rest args) | |
752 (funcall func &rest args) | |
753 (insert &rest args) | |
754 (vconcat &rest args) | |
755 (run-hook-with-args hook &rest args) | |
756 (message-or-box string &rest args) | |
757 (save-window-excursion &rest body) | |
758 (append &rest args) | |
759 (logior &rest args) | |
760 (progn &rest body) | |
761 (insert-and-inherit &rest args) | |
762 (message-box string &rest args) | |
763 (prog2 x y &rest body) | |
764 (prog1 first &rest body) | |
765 (insert-before-markers &rest args) | |
766 (call-process-region start end program &optional delete | |
767 destination display &rest args) | |
768 (concat &rest args) | |
769 (vector &rest args) | |
770 (run-hook-with-args-until-success hook &rest args) | |
771 (track-mouse &rest body) | |
772 (unwind-protect bodyform &rest unwindforms) | |
773 (save-restriction &rest body) | |
774 (quote arg) | |
775 (make-byte-code &rest args) | |
776 (or &rest args) | |
777 (cond &rest clauses) | |
778 (start-process name buffer program &rest args) | |
779 (run-hook-with-args-until-failure hook &rest args) | |
780 (if cond then &rest else) | |
781 (apply function &rest args) | |
782 (format string &rest args) | |
783 (encode-time second minute hour day month year zone &rest args) | |
784 (min &rest args) | |
785 (logand &rest args) | |
786 (logxor &rest args) | |
787 (max &rest args) | |
788 (list &rest args) | |
789 (message string &rest args) | |
790 (defvar symbol init doc) | |
791 (call-process program &optional infile destination display &rest args) | |
792 (with-output-to-temp-buffer bufname &rest body) | |
793 (nconc &rest args) | |
794 (save-excursion &rest body) | |
795 (run-hooks &rest hooks) | |
796 (/ x y &rest zs) | |
797 (- x &rest y) | |
798 (+ &rest args) | |
799 (* &rest args) | |
800 (interactive &optional args)) | |
801 "Those built-ins for which we can't find arguments.") | |
802 | |
803 (provide 'elint) | |
804 | |
52401 | 805 ;;; arch-tag: b2f061e2-af84-4ddc-8e39-f5e969ac228f |
19210 | 806 ;;; elint.el ends here |