lisp/emacs-lisp/elint.el

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