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