lisp/emacs-lisp/check-declare.el

   1 ;;; check-declare.el --- Check declare-function statements
   2
   3 ;; Copyright (C) 2007, 2008  Free Software Foundation, Inc.
   4
   5 ;; Author: Glenn Morris <rgm@gnu.org>
   6 ;; Keywords: lisp, tools, maint
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; The byte-compiler often warns about undefined functions that you
  26 ;; know will actually be defined when it matters.  The `declare-function'
  27 ;; statement allows you to suppress these warnings.  This package
  28 ;; checks that all such statements in a file or directory are accurate.
  29 ;; The entry points are `check-declare-file' and `check-declare-directory'.
  30
  31 ;; For more information, see Info node `elisp(Declaring Functions)'.
  32
  33 ;;; TODO:
  34
  35 ;; 1. Warn about functions marked as obsolete, eg
  36 ;; password-read-and-add in smime.el.
  37
  38 ;;; Code:
  39
  40 (defconst check-declare-warning-buffer "*Check Declarations Warnings*"
  41   "Name of buffer used to display any `check-declare' warnings.")
  42
  43 (defun check-declare-locate (file basefile)
  44   "Return the full path of FILE.
  45 Expands files with a \".c\" or \".m\" extension relative to the Emacs
  46 \"src/\" directory.  Otherwise, `locate-library' searches for FILE.
  47 If that fails, expands FILE relative to BASEFILE's directory part.
  48 The returned file might not exist.  If FILE has an \"ext:\" prefix, so does
  49 the result."
  50   (let ((ext (string-match "^ext:" file))
  51         tfile)
  52     (if ext
  53         (setq file (substring file 4)))
  54     (setq file
  55           (if (member (file-name-extension file) '("c" "m"))
  56               (expand-file-name file (expand-file-name "src" source-directory))
  57             (if (setq tfile (locate-library (file-name-nondirectory file)))
  58                 (progn
  59                   (setq tfile
  60                         (replace-regexp-in-string "\\.elc\\'" ".el" tfile))
  61                   (if (and (not (file-exists-p tfile))
  62                            (file-exists-p (concat tfile ".gz")))
  63                       (concat tfile ".gz")
  64                     tfile))
  65               (setq tfile (expand-file-name file
  66                                             (file-name-directory basefile)))
  67               (if (or (file-exists-p tfile)
  68                       (string-match "\\.el\\'" tfile))
  69                   tfile
  70                 (concat tfile ".el")))))
  71     (if ext (concat "ext:" file)
  72       file)))
  73
  74 (defun check-declare-scan (file)
  75   "Scan FILE for `declare-function' calls.
  76 Return a list with elements of the form (FNFILE FN ARGLIST FILEONLY),
  77 where only the first two elements need be present.  This claims that FNFILE
  78 defines FN, with ARGLIST.  FILEONLY non-nil means only check that FNFILE
  79 exists, not that it defines FN.  This is for function definitions that we
  80 don't know how to recognize (e.g. some macros)."
  81   (let ((m (format "Scanning %s..." file))
  82         alist fnfile fn arglist fileonly)
  83     (message "%s" m)
  84     (with-temp-buffer
  85       (insert-file-contents file)
  86       (while (re-search-forward
  87               "^[ \t]*(declare-function[ \t]+\\(\\S-+\\)[ \t]+\
  88 \"\\(\\S-+\\)\"" nil t)
  89         (setq fn (match-string 1)
  90               fnfile (match-string 2)
  91               fnfile (check-declare-locate fnfile (expand-file-name file))
  92               arglist (progn
  93                         (skip-chars-forward " \t\n")
  94                         ;; Use `t' to distinguish no arglist
  95                         ;; specified from an empty one.
  96                         (if (looking-at "\\((\\|nil\\|t\\)")
  97                             (read (current-buffer))
  98                           t))
  99               fileonly (progn
 100                         (skip-chars-forward " \t\n")
 101                         (if (looking-at "\\(t\\|'\\sw+\\)")
 102                             (match-string 1)))
 103               alist (cons (list fnfile fn arglist fileonly) alist))))
 104     (message "%sdone" m)
 105     alist))
 106
 107 (defun check-declare-errmsg (errlist &optional full)
 108   "Return a string with the number of errors in ERRLIST, if any.
 109 Normally just counts the number of elements in ERRLIST.
 110 With optional argument FULL, sums the number of elements in each element."
 111   (if errlist
 112       (let ((l (length errlist)))
 113         (when full
 114           (setq l 0)
 115           (dolist (e errlist)
 116             (setq l (+ l (1- (length e))))))
 117         (format "%d problem%s found" l (if (= l 1) "" "s")))
 118     "OK"))
 119
 120 (autoload 'byte-compile-arglist-signature "bytecomp")
 121
 122 (defun check-declare-verify (fnfile fnlist)
 123   "Check that FNFILE contains function definitions matching FNLIST.
 124 Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
 125 only the first two elements need be present.  This means FILE claimed FN
 126 was defined in FNFILE with the specified ARGLIST.  FILEONLY non-nil means
 127 to only check that FNFILE exists, not that it actually defines FN.
 128
 129 Returns nil if all claims are found to be true, otherwise a list
 130 of errors with elements of the form \(FILE FN TYPE), where TYPE
 131 is a string giving details of the error."
 132   (let ((m (format "Checking %s..." fnfile))
 133         (cflag (member (file-name-extension fnfile) '("c" "m")))
 134         (ext (string-match "^ext:" fnfile))
 135         re fn sig siglist arglist type errlist minargs maxargs)
 136     (message "%s" m)
 137     (if ext
 138         (setq fnfile (substring fnfile 4)))
 139     (if (file-exists-p fnfile)
 140         (with-temp-buffer
 141           (insert-file-contents fnfile)
 142           ;; defsubst's don't _have_ to be known at compile time.
 143           (setq re (format (if cflag
 144                                "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
 145                              "^[ \t]*(\\(fset[ \t]+'\\|\
 146 def\\(?:un\\|subst\\|foo\\|\
 147 ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\
 148 \\|\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\)\\)\
 149 \[ \t]*%s\\([ \t;]+\\|$\\)")
 150                            (regexp-opt (mapcar 'cadr fnlist) t)))
 151           (while (re-search-forward re nil t)
 152             (skip-chars-forward " \t\n")
 153             (setq fn (match-string 2)
 154                   type (match-string 1)
 155                   ;; (min . max) for a fixed number of arguments, or
 156                   ;; arglists with optional elements.
 157                   ;; (min) for arglists with &rest.
 158                   ;; sig = 'err means we could not find an arglist.
 159                   sig (cond (cflag
 160                              (or
 161                               (when (re-search-forward "," nil t 3)
 162                                 (skip-chars-forward " \t\n")
 163                                 ;; Assuming minargs and maxargs on same line.
 164                                 (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
 165 \\([0-9]+\\|MANY\\|UNEVALLED\\)")
 166                                   (setq minargs (string-to-number
 167                                                  (match-string 1))
 168                                         maxargs (match-string 2))
 169                                   (cons minargs (unless (string-match "[^0-9]"
 170                                                                       maxargs)
 171                                                  (string-to-number
 172                                                   maxargs)))))
 173                               'err))
 174                             ((string-match
 175                               "\\`define-\\(derived\\|generic\\)-mode\\'"
 176                               type)
 177                              '(0 . 0))
 178                             ((string-match
 179                               "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
 180                               type)
 181                              '(0 . 1))
 182                             ;; Prompt to update.
 183                             ((string-match
 184                               "\\`define-obsolete-function-alias\\>"
 185                               type)
 186                              'obsolete)
 187                             ;; Can't easily check arguments in these cases.
 188                             ((string-match "\\`\\(defalias\\|fset\\)\\>" type)
 189                              t)
 190                             ((looking-at "\\((\\|nil\\)")
 191                              (byte-compile-arglist-signature
 192                               (read (current-buffer))))
 193                             (t
 194                              'err))
 195                   ;; alist of functions and arglist signatures.
 196                   siglist (cons (cons fn sig) siglist)))))
 197     (dolist (e fnlist)
 198       (setq arglist (nth 2 e)
 199             type
 200             (if (not re)
 201                 "file not found"
 202               (if (not (setq sig (assoc (cadr e) siglist)))
 203                   (unless (nth 3 e)     ; fileonly
 204                     "function not found")
 205                 (setq sig (cdr sig))
 206                 (cond ((eq sig 'obsolete) ; check even when no arglist specified
 207                        "obsolete alias")
 208                       ;; arglist t means no arglist specified, as
 209                       ;; opposed to an empty arglist.
 210                       ((eq arglist t) nil)
 211                       ((eq sig t) nil) ; eg defalias - can't check arguments
 212                       ((eq sig 'err)
 213                        "arglist not found") ; internal error
 214                       ((not (equal (byte-compile-arglist-signature
 215                                     arglist)
 216                                    sig))
 217                        "arglist mismatch")))))
 218       (when type
 219         (setq errlist (cons (list (car e) (cadr e) type) errlist))))
 220     (message "%s%s" m
 221              (if (or re (not ext))
 222                  (check-declare-errmsg errlist)
 223                (progn
 224                  (setq errlist nil)
 225                  "skipping external file")))
 226     errlist))
 227
 228 (defun check-declare-sort (alist)
 229   "Sort a list with elements FILE (FNFILE ...).
 230 Returned list has elements FNFILE (FILE ...)."
 231   (let (file fnfile rest sort a)
 232     (dolist (e alist)
 233       (setq file (car e))
 234       (dolist (f (cdr e))
 235         (setq fnfile (car f)
 236               rest (cdr f))
 237         (if (setq a (assoc fnfile sort))
 238             (setcdr a (append (cdr a) (list (cons file rest))))
 239           (setq sort (cons (list fnfile (cons file rest)) sort)))))
 240     sort))
 241
 242 (defun check-declare-warn (file fn fnfile type)
 243   "Warn that FILE made a false claim about FN in FNFILE.
 244 TYPE is a string giving the nature of the error.  Warning is displayed in
 245 `check-declare-warning-buffer'."
 246   (display-warning 'check-declare
 247                    (format "%s said `%s' was defined in %s: %s"
 248                            (file-name-nondirectory file) fn
 249                            (file-name-nondirectory fnfile)
 250                            type)
 251                    nil check-declare-warning-buffer))
 252
 253 (defun check-declare-files (&rest files)
 254   "Check veracity of all `declare-function' statements in FILES.
 255 Return a list of any errors found."
 256   (let (alist err errlist)
 257     (dolist (file files)
 258       (setq alist (cons (cons file (check-declare-scan file)) alist)))
 259     ;; Sort so that things are ordered by the files supposed to
 260     ;; contain the defuns.
 261     (dolist (e (check-declare-sort alist))
 262       (if (setq err (check-declare-verify (car e) (cdr e)))
 263           (setq errlist (cons (cons (car e) err) errlist))))
 264     (if (get-buffer check-declare-warning-buffer)
 265         (kill-buffer check-declare-warning-buffer))
 266     ;; Sort back again so that errors are ordered by the files
 267     ;; containing the declare-function statements.
 268     (dolist (e (check-declare-sort errlist))
 269         (dolist (f (cdr e))
 270           (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
 271     errlist))
 272
 273 ;;;###autoload
 274 (defun check-declare-file (file)
 275   "Check veracity of all `declare-function' statements in FILE.
 276 See `check-declare-directory' for more information."
 277   (interactive "fFile to check: ")
 278   (or (file-exists-p file)
 279       (error "File `%s' not found" file))
 280   (let ((m (format "Checking %s..." file))
 281         errlist)
 282     (message "%s" m)
 283     (setq errlist (check-declare-files file))
 284     (message "%s%s" m (check-declare-errmsg errlist))
 285     errlist))
 286
 287 ;;;###autoload
 288 (defun check-declare-directory (root)
 289   "Check veracity of all `declare-function' statements under directory ROOT.
 290 Returns non-nil if any false statements are found.  For this to
 291 work correctly, the statements must adhere to the format
 292 described in the documentation of `declare-function'."
 293   (interactive "DDirectory to check: ")
 294   (or (file-directory-p (setq root (expand-file-name root)))
 295       (error "Directory `%s' not found" root))
 296   (let ((m "Checking `declare-function' statements...")
 297         (m2 "Finding files with declarations...")
 298         errlist files)
 299     (message "%s" m)
 300     (message "%s" m2)
 301     (setq files (process-lines find-program root
 302                                "-name" "*.el"
 303                                "-exec" grep-program
 304                                "-l" "^[ \t]*(declare-function" "{}" ";"))
 305     (message "%s%d found" m2 (length files))
 306     (when files
 307       (setq errlist (apply 'check-declare-files files))
 308       (message "%s%s" m (check-declare-errmsg errlist t))
 309       errlist)))
 310
 311 (provide 'check-declare)
 312
 313 ;; arch-tag: a4d6cdc4-deb7-4502-b327-0e4ef3d82d96
 314 ;;; check-declare.el ends here.