code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/elint.el

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