Mercurial > emacs
annotate lisp/emacs-lisp/elint.el @ 37678:ebec0594dece
(compile-files): Redirect output of chmod to
/dev/null.
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Fri, 11 May 2001 10:53:56 +0000 |
| parents | 2ecea967337d |
| children | b174db545cfd |
| rev | line source |
|---|---|
| 19210 | 1 ;;; elint.el -- Lint Emacs Lisp |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Peter Liljenberg <petli@lysator.liu.se> | |
| 6 ;; Created: May 1997 | |
| 7 ;; Keywords: lisp | |
| 8 | |
| 9 ;; This file is part of GNU Emacs. | |
| 10 | |
| 11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
| 12 ;; it under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 19 ;; GNU General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Commentary: | |
| 27 | |
| 28 ;; This is a linter for Emacs Lisp. Currently, it mainly catches | |
| 29 ;; mispellings and undefined variables, although it can also catch | |
| 30 ;; function calls with the wrong number of arguments. | |
| 31 | |
| 32 ;; Before using, call `elint-initialize' to set up som argument | |
| 33 ;; data. This takes a while. Then call elint-current-buffer or | |
| 34 ;; elint-defun to lint a buffer or a defun. | |
| 35 | |
| 36 ;; The linter will try to "include" any require'd libraries to find | |
| 37 ;; the variables defined in those. There is a fair amount of voodoo | |
| 38 ;; involved in this, but it seems to work in normal situations. | |
| 39 | |
| 40 ;;; History: | |
| 41 | |
| 42 ;;; To do: | |
| 43 | |
| 44 ;; * A list of all standard Emacs variables would be nice to have... | |
| 45 ;; * Adding type checking. (Stop that sniggering!) | |
| 46 | |
| 47 ;;; Code: | |
| 48 | |
| 49 (defvar elint-log-buffer "*Elint*" | |
| 50 "*The buffer to insert lint messages in.") | |
| 51 | |
| 52 ;;; | |
| 53 ;;; ADT: top-form | |
| 54 ;;; | |
| 55 | |
| 56 (defsubst elint-make-top-form (form pos) | |
| 57 "Create a top form. | |
| 58 FORM is the form, and POS is the point where it starts in the buffer." | |
| 59 (cons form pos)) | |
| 60 | |
| 61 (defsubst elint-top-form-form (top-form) | |
| 62 "Extract the form from a TOP-FORM." | |
| 63 (car top-form)) | |
| 64 | |
| 65 (defsubst elint-top-form-pos (top-form) | |
| 66 "Extract the position from a TOP-FORM." | |
| 67 (cdr top-form)) | |
| 68 | |
| 69 ;;; | |
| 70 ;;; ADT: env | |
| 71 ;;; | |
| 72 | |
| 73 (defsubst elint-make-env () | |
| 74 "Create an empty environment." | |
| 75 (list (list nil) nil nil)) | |
| 76 | |
| 77 (defsubst elint-env-add-env (env newenv) | |
| 78 "Augment ENV with NEWENV. | |
| 79 None of them is modified, and the new env is returned." | |
| 80 (list (append (car env) (car newenv)) | |
| 81 (append (car (cdr env)) (car (cdr newenv))) | |
| 82 (append (car (cdr (cdr env))) (car (cdr (cdr newenv)))))) | |
| 83 | |
| 84 (defsubst elint-env-add-var (env var) | |
| 85 "Augment ENV with the variable VAR. | |
| 86 The new environment is returned, the old is unmodified." | |
| 87 (cons (cons (list var) (car env)) (cdr env))) | |
| 88 | |
| 89 (defsubst elint-env-add-global-var (env var) | |
| 90 "Augment ENV with the variable VAR. | |
| 91 ENV is modified so VAR is seen everywhere. | |
| 92 ENV is returned." | |
| 93 (nconc (car env) (list (list var))) | |
| 94 env) | |
| 95 | |
| 96 (defsubst elint-env-find-var (env var) | |
| 97 "Non-nil if ENV contains the variable VAR. | |
| 98 Actually, a list with VAR as a single element is returned." | |
| 99 (assq var (car env))) | |
| 100 | |
| 101 (defsubst elint-env-add-func (env func args) | |
| 102 "Augment ENV with the function FUNC, which has the arguments ARGS. | |
| 103 The new environment is returned, the old is unmodified." | |
| 104 (list (car env) | |
| 105 (cons (list func args) (car (cdr env))) | |
| 106 (car (cdr (cdr env))))) | |
| 107 | |
| 108 (defsubst elint-env-find-func (env func) | |
| 109 "Non-nil if ENV contains the function FUNC. | |
| 110 Actually, a list of (FUNC ARGS) is returned." | |
| 111 (assq func (car (cdr env)))) | |
| 112 | |
| 113 (defsubst elint-env-add-macro (env macro def) | |
| 114 "Augment ENV with the macro named MACRO. | |
| 115 DEF is the macro definition (a lambda expression or similar). | |
| 116 The new environment is returned, the old is unmodified." | |
| 117 (list (car env) | |
| 118 (car (cdr env)) | |
| 119 (cons (cons macro def) (car (cdr (cdr env)))))) | |
| 120 | |
| 121 (defsubst elint-env-macro-env (env) | |
| 122 "Return the macro environment of ENV. | |
| 123 This environment can be passed to `macroexpand'." | |
| 124 (car (cdr (cdr env)))) | |
| 125 | |
| 126 (defsubst elint-env-macrop (env macro) | |
| 127 "Non-nil if ENV contains MACRO." | |
| 128 (assq macro (elint-env-macro-env env))) | |
| 129 | |
| 130 ;;; | |
| 131 ;;; User interface | |
| 132 ;;; | |
| 133 | |
| 134 (defun elint-current-buffer () | |
| 135 "Lint the current buffer." | |
| 136 (interactive) | |
| 137 (elint-clear-log (format "Linting %s" (if (buffer-file-name) | |
| 138 (buffer-file-name) | |
| 139 (buffer-name)))) | |
| 140 (elint-display-log) | |
| 141 (mapcar 'elint-top-form (elint-update-env)) | |
| 142 | |
| 143 ;; Tell the user we're finished. This is terribly klugy: we set | |
| 144 ;; elint-top-form-logged so elint-log-message doesn't print the | |
| 145 ;; ** top form ** header... | |
| 146 (let ((elint-top-form-logged t)) | |
| 147 (elint-log-message "\nLinting complete.\n"))) | |
|
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. | |
| 217 Returns nil if there are no more forms, T otherwise." | |
| 218 (parse-partial-sexp (point) (point-max) nil t) | |
| 219 (not (eobp))) | |
| 220 | |
| 221 (defun elint-init-env (forms) | |
| 222 "Initialise the environment from FORMS." | |
| 223 (let ((env (elint-make-env)) | |
| 224 form) | |
| 225 (while forms | |
| 226 (setq form (elint-top-form-form (car forms)) | |
| 227 forms (cdr forms)) | |
| 228 (cond | |
| 229 ;; Add defined variable | |
| 230 ((memq (car form) '(defvar defconst defcustom)) | |
| 231 (setq env (elint-env-add-var env (car (cdr form))))) | |
| 232 ;; Add function | |
| 233 ((memq (car form) '(defun defsubst)) | |
| 234 (setq env (elint-env-add-func env (car (cdr form)) | |
| 235 (car (cdr (cdr form)))))) | |
| 236 ;; Add macro, both as a macro and as a function | |
| 237 ((eq (car form) 'defmacro) | |
| 238 (setq env (elint-env-add-macro env (car (cdr form)) | |
| 239 (cons 'lambda | |
| 240 (cdr (cdr form)))) | |
| 241 env (elint-env-add-func env (car (cdr form)) | |
| 242 (car (cdr (cdr form)))))) | |
| 243 | |
| 244 ;; Import variable definitions | |
| 245 ((eq (car form) 'require) | |
| 246 (let ((name (eval (car (cdr form)))) | |
| 247 (file (eval (car (cdr (cdr form)))))) | |
| 248 (setq env (elint-add-required-env env name file)))) | |
| 249 )) | |
| 250 env)) | |
| 251 | |
| 252 (defun elint-add-required-env (env name file) | |
| 253 "Augment ENV with the variables definied by feature NAME in FILE." | |
| 254 (condition-case nil | |
| 255 (let* ((libname (if (stringp file) | |
| 256 file | |
| 257 (symbol-name name))) | |
| 258 | |
| 259 ;; First try to find .el files, then the raw name | |
| 260 (lib1 (locate-library (concat libname ".el") t)) | |
| 261 (lib (if lib1 lib1 (locate-library libname t)))) | |
| 262 ;; Clear the messages :-/ | |
| 263 (message nil) | |
| 264 (if lib | |
| 265 (save-excursion | |
| 266 (set-buffer (find-file-noselect lib)) | |
| 267 (elint-update-env) | |
| 268 (setq env (elint-env-add-env env elint-buffer-env))) | |
| 269 (error "dummy error..."))) | |
| 270 (error | |
| 271 (ding) | |
| 272 (message "Can't get variables from require'd library %s" name))) | |
| 273 env) | |
|
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) |
|
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
543 (evenp (length form))) ; even no. of keyword/value args |
|
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
544 (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
|
545 (car (cdr form))) |
|
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
546 (elint-error "Malformed variable declaration: %s" form) |
|
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
547 env)) |
|
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
548 |
| 19210 | 549 (defun elint-check-function-form (form env) |
| 550 "Lint the function FORM in ENV." | |
| 551 (let ((func (car (cdr-safe form)))) | |
| 552 (cond | |
| 553 ((symbolp func) | |
| 554 (or (elint-env-find-func env func) | |
| 555 (fboundp func) | |
| 556 (elint-warning "Reference to undefined function: %s" form)) | |
| 557 env) | |
| 558 ((and (consp func) (memq (car func) '(lambda macro))) | |
| 559 (elint-form func env)) | |
| 560 ((stringp func) env) | |
| 561 (t (elint-error "Not a function object: %s" form) | |
| 562 env) | |
| 563 ))) | |
| 564 | |
| 565 (defun elint-check-quote-form (form env) | |
| 566 "Lint the quote FORM in ENV." | |
| 567 env) | |
| 568 | |
| 569 (defun elint-check-macro-form (form env) | |
| 570 "Check the macro FORM in ENV." | |
| 571 (elint-check-function-form (list (car form) (cdr form)) env)) | |
| 572 | |
| 573 (defun elint-check-condition-case-form (form env) | |
| 574 "Check the condition-case FORM in ENV." | |
| 575 (let ((resenv env)) | |
| 576 (if (< (length form) 3) | |
| 577 (elint-error "Malformed condition-case: %s" form) | |
| 578 (or (symbolp (car (cdr form))) | |
| 579 (elint-warning "First parameter should be a symbol: %s" form)) | |
| 580 (setq resenv (elint-form (nth 2 form) env)) | |
| 581 | |
| 582 (let ((newenv (elint-env-add-var env (car (cdr form)))) | |
| 583 (errforms (nthcdr 3 form)) | |
| 584 errlist) | |
| 585 (while errforms | |
| 586 (setq errlist (car (car errforms))) | |
| 587 (mapcar (function (lambda (s) | |
| 588 (or (get s 'error-conditions) | |
| 589 (get s 'error-message) | |
| 590 (elint-warning | |
| 591 "Not an error symbol in error handler: %s" s)))) | |
| 592 (cond | |
| 593 ((symbolp errlist) (list errlist)) | |
| 594 ((listp errlist) errlist) | |
| 595 (t (elint-error "Bad error list in error handler: %s" | |
| 596 errlist) | |
| 597 nil)) | |
| 598 ) | |
| 599 (elint-forms (cdr (car errforms)) newenv) | |
| 600 (setq errforms (cdr errforms)) | |
| 601 ))) | |
| 602 resenv)) | |
|
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
603 |
| 19210 | 604 ;;; |
| 605 ;;; Message functions | |
| 606 ;;; | |
| 607 | |
| 608 ;; elint-error and elint-warning are identical, but they might change | |
| 609 ;; to reflect different seriousness of linting errors | |
| 610 | |
| 611 (defun elint-error (string &rest args) | |
| 612 "Report an linting error. | |
| 613 STRING and ARGS are thrown on `format' to get the message." | |
| 614 (let ((errstr (apply 'format string args))) | |
| 615 (elint-log-message errstr) | |
| 616 )) | |
|
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
617 |
| 19210 | 618 (defun elint-warning (string &rest args) |
| 619 "Report an linting warning. | |
| 620 STRING and ARGS are thrown on `format' to get the message." | |
| 621 (let ((errstr (apply 'format string args))) | |
| 622 (elint-log-message errstr) | |
| 623 )) | |
| 624 | |
| 625 (defun elint-log-message (errstr) | |
| 626 "Insert ERRSTR last in the lint log buffer." | |
| 627 (save-excursion | |
| 628 (set-buffer (elint-get-log-buffer)) | |
| 629 (goto-char (point-max)) | |
| 630 (or (bolp) (newline)) | |
| 631 | |
| 632 ;; Do we have to say where we are? | |
| 633 (if elint-top-form-logged | |
| 634 nil | |
| 635 (insert | |
| 636 (let* ((form (elint-top-form-form elint-top-form)) | |
| 637 (top (car form))) | |
| 638 (cond | |
| 639 ((memq top '(defun defsubst)) | |
| 640 (format "\n** function %s **\n" (car (cdr form)))) | |
| 641 ((eq top 'defmacro) | |
| 642 (format "\n** macro %s **\n" (car (cdr form)))) | |
| 643 ((memq top '(defvar defconst)) | |
| 644 (format "\n** variable %s **\n" (car (cdr form)))) | |
| 645 (t "\n** top level expression **\n")))) | |
| 646 (setq elint-top-form-logged t)) | |
| 647 | |
| 648 (insert errstr) | |
| 649 (newline))) | |
| 650 | |
| 651 (defun elint-clear-log (&optional header) | |
| 652 "Clear the lint log buffer. | |
| 653 Insert HEADER followed by a blank line if non-nil." | |
| 654 (save-excursion | |
| 655 (set-buffer (elint-get-log-buffer)) | |
| 656 (erase-buffer) | |
| 657 (if header | |
| 658 (progn | |
| 659 (insert header) | |
| 660 (newline)) | |
| 661 ))) | |
| 662 | |
| 663 (defun elint-display-log () | |
| 664 "Display the lint log buffer." | |
| 665 (let ((pop-up-windows t)) | |
| 666 (display-buffer (elint-get-log-buffer)) | |
| 667 (sit-for 0))) | |
| 668 | |
| 669 (defun elint-get-log-buffer () | |
| 670 "Return a log buffer for elint." | |
| 671 (let ((buf (get-buffer elint-log-buffer))) | |
| 672 (if buf | |
| 673 buf | |
| 674 (let ((oldbuf (current-buffer))) | |
| 675 (prog1 | |
| 676 (set-buffer (get-buffer-create elint-log-buffer)) | |
| 677 (setq truncate-lines t) | |
| 678 (set-buffer oldbuf))) | |
| 679 ))) | |
|
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
680 |
| 19210 | 681 ;;; |
| 682 ;;; Initializing code | |
| 683 ;;; | |
|
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
684 |
| 19210 | 685 ;;;###autoload |
| 686 (defun elint-initialize () | |
| 687 "Initialize elint." | |
| 688 (interactive) | |
| 689 (mapcar (function (lambda (x) | |
| 690 (or (not (symbolp (car x))) | |
| 691 (eq (cdr x) 'unknown) | |
| 692 (put (car x) 'elint-args (cdr x))))) | |
| 693 (elint-find-builtin-args)) | |
| 694 (mapcar (function (lambda (x) | |
| 695 (put (car x) 'elint-args (cdr x)))) | |
| 696 elint-unknown-builtin-args)) | |
| 697 | |
| 698 | |
| 699 (defun elint-find-builtins () | |
| 700 "Returns a list of all built-in functions." | |
| 701 (let ((subrs nil)) | |
| 702 (mapatoms (lambda (s) (if (and (fboundp s) (subrp (symbol-function s))) | |
| 703 (setq subrs (cons s subrs))))) | |
| 704 subrs | |
| 705 )) | |
| 706 | |
| 707 (defun elint-find-builtin-args (&optional list) | |
| 708 "Returns a list of the built-in functions and their arguments. | |
| 709 | |
| 710 If LIST is nil, call `elint-find-builtins' to get a list of all built-in | |
| 711 functions, otherwise use LIST. | |
| 712 | |
| 713 Each functions is represented by a cons cell: | |
| 714 \(function-symbol . args) | |
| 715 If no documentation could be found args will be `unknown'." | |
| 716 | |
| 717 (mapcar (function (lambda (f) | |
| 718 (let ((doc (documentation f t))) | |
| 719 (if (and doc (string-match "\n\n\\((.*)\\)" doc)) | |
| 720 (read (match-string 1 doc)) | |
| 721 (cons f 'unknown)) | |
| 722 ))) | |
| 723 (if list list | |
| 724 (elint-find-builtins)))) | |
| 725 | |
| 726 ;;; | |
| 727 ;;; Data | |
| 728 ;;; | |
| 729 | |
| 730 (defconst elint-standard-variables | |
| 731 '(abbrev-mode auto-fill-function buffer-auto-save-file-name | |
| 732 buffer-backed-up buffer-display-table buffer-file-format | |
| 733 buffer-file-name buffer-file-number buffer-file-truename | |
| 734 buffer-file-type buffer-invisibility-spec buffer-offer-save | |
| 735 buffer-read-only buffer-saved-size buffer-undo-list | |
| 736 cache-long-line-scans case-fold-search ctl-arrow comment-column | |
| 737 default-directory defun-prompt-regexp fill-column goal-column | |
| 738 left-margin local-abbrev-table local-write-file-hooks major-mode | |
| 739 mark-active mark-ring minor-modes mode-line-buffer-identification | |
| 740 mode-line-format mode-line-modified mode-line-process mode-name | |
| 741 overwrite-mode paragraph-separate paragraph-start | |
| 742 point-before-scroll require-final-newline selective-display | |
| 743 selective-display-ellipses tab-width truncate-lines vc-mode) | |
| 744 "Standard buffer local vars.") | |
|
20014
2ecea967337d
(elint-check-defcustom-form): New function.
Karl Heuer <kwzh@gnu.org>
parents:
19210
diff
changeset
|
745 |
| 19210 | 746 (defconst elint-unknown-builtin-args |
| 747 '((while test &rest forms) | |
| 748 (insert-before-markers-and-inherit &rest text) | |
| 749 (catch tag &rest body) | |
| 750 (and &rest args) | |
| 751 (funcall func &rest args) | |
| 752 (insert-string &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 (ml-provide-prefix-argument prefix form) | |
| 766 (insert-before-markers &rest args) | |
| 767 (call-process-region start end program &optional delete | |
| 768 destination display &rest args) | |
| 769 (concat &rest args) | |
| 770 (vector &rest args) | |
| 771 (run-hook-with-args-until-success hook &rest args) | |
| 772 (track-mouse &rest body) | |
| 773 (unwind-protect bodyform &rest unwindforms) | |
| 774 (save-restriction &rest body) | |
| 775 (ml-prefix-argument-loop) | |
| 776 (quote arg) | |
| 777 (make-byte-code &rest args) | |
| 778 (or &rest args) | |
| 779 (cond &rest clauses) | |
| 780 (start-process name buffer program &rest args) | |
| 781 (run-hook-with-args-until-failure hook &rest args) | |
| 782 (if cond then &rest else) | |
| 783 (ml-if) | |
| 784 (apply function &rest args) | |
| 785 (format string &rest args) | |
| 786 (encode-time second minute hour day month year zone &rest args) | |
| 787 (min &rest args) | |
| 788 (logand &rest args) | |
| 789 (logxor &rest args) | |
| 790 (max &rest args) | |
| 791 (list &rest args) | |
| 792 (message string &rest args) | |
| 793 (defvar symbol init doc) | |
| 794 (call-process program &optional infile destination display &rest args) | |
| 795 (with-output-to-temp-buffer bufname &rest body) | |
| 796 (nconc &rest args) | |
| 797 (save-excursion &rest body) | |
| 798 (run-hooks &rest hooks) | |
| 799 (/ x y &rest zs) | |
| 800 (- x &rest y) | |
| 801 (+ &rest args) | |
| 802 (* &rest args) | |
| 803 (interactive &optional args)) | |
| 804 "Those built-ins for which we can't find arguments.") | |
| 805 | |
| 806 (provide 'elint) | |
| 807 | |
| 808 ;;; elint.el ends here | |
| 809 |
