lisp/emacs-lisp/check-declare.el

   1 ;;; check-declare.el --- Check declare-function statements
   2
   3 ;; Copyright (C) 2007-2017 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 ;; 2. defmethod, defclass argument checking.
  38 ;; 3. defclass also defines -p and -child-p.
  39
  40 ;;; Code:
  41
  42 (defconst check-declare-warning-buffer "*Check Declarations Warnings*"
  43   "Name of buffer used to display any `check-declare' warnings.")
  44
  45 (defun check-declare-locate (file basefile)
  46   "Return the relative name of FILE.
  47 Expands files with a \".c\" or \".m\" extension relative to the Emacs
  48 \"src/\" directory.  Otherwise, `locate-library' searches for FILE.
  49 If that fails, expands FILE relative to BASEFILE's directory part.
  50 The returned file might not exist.  If FILE has an \"ext:\" prefix, so does
  51 the result."
  52   (let ((ext (string-match "^ext:" file))
  53         tfile)
  54     (if ext
  55         (setq file (substring file 4)))
  56     (setq file
  57           (if (member (file-name-extension file) '("c" "m"))
  58               (expand-file-name file (expand-file-name "src" source-directory))
  59             (if (setq tfile (locate-library file))
  60                 (progn
  61                   (setq tfile
  62                         (replace-regexp-in-string "\\.elc\\'" ".el" tfile))
  63                   (if (and (not (file-exists-p tfile))
  64                            (file-exists-p (concat tfile ".gz")))
  65                       (concat tfile ".gz")
  66                     tfile))
  67               (setq tfile (expand-file-name file
  68                                             (file-name-directory basefile)))
  69               (if (or (file-exists-p tfile)
  70                       (string-match "\\.el\\'" tfile))
  71                   tfile
  72                 (concat tfile ".el")))))
  73     (setq file (file-relative-name file))
  74     (if ext (concat "ext:" file)
  75       file)))
  76
  77 (defun check-declare-scan (file)
  78   "Scan FILE for `declare-function' calls.
  79 Return a list with elements of the form (FNFILE FN ARGLIST FILEONLY),
  80 where only the first two elements need be present.  This claims that FNFILE
  81 defines FN, with ARGLIST.  FILEONLY non-nil means only check that FNFILE
  82 exists, not that it defines FN.  This is for function definitions that we
  83 don't know how to recognize (e.g. some macros)."
  84   (let (alist)
  85     (with-temp-buffer
  86       (insert-file-contents file)
  87       ;; FIXME we could theoretically be inside a string.
  88       (while (re-search-forward "^[ \t]*\\((declare-function\\)[ \t\n]" nil t)
  89         (let ((pos (match-beginning 1)))
  90           (goto-char pos)
  91           (let ((form (ignore-errors (read (current-buffer))))
  92                 len fn formfile fnfile arglist fileonly)
  93             (if (and
  94                  ;; Exclude element of byte-compile-initial-macro-environment.
  95                  (or (listp (cdr form)) (setq form nil))
  96                  (> (setq len (length form)) 2)
  97                  (< len 6)
  98                  (setq formfile (nth 2 form))
  99                  (symbolp (setq fn (cadr form)))
 100                  (setq fn (symbol-name fn)) ; later we use as a search string
 101                  (stringp formfile)
 102                  (setq fnfile (check-declare-locate formfile file))
 103                  ;; Use t to distinguish unspecified arglist from empty one.
 104                  (or (eq t (setq arglist (if (> len 3)
 105                                              (nth 3 form)
 106                                            t)))
 107                      (listp arglist))
 108                  (symbolp (setq fileonly (nth 4 form))))
 109                 (setq alist (cons (list fnfile fn arglist fileonly) alist))
 110               (when form
 111                 (check-declare-warn file (or fn "unknown function")
 112                                     (if (stringp formfile) formfile
 113                                       "unknown file")
 114                                     "Malformed declaration"
 115                                     (line-number-at-pos pos))))))))
 116     alist))
 117
 118 (autoload 'byte-compile-arglist-signature "bytecomp")
 119
 120 (defgroup check-declare nil
 121   "Check declare-function statements."
 122   :group 'tools)
 123
 124 (defcustom check-declare-ext-errors nil
 125   "When non-nil, warn about functions not found in :ext."
 126   :version "25.1"
 127   :type 'boolean)
 128
 129 (defun check-declare-verify (fnfile fnlist)
 130   "Check that FNFILE contains function definitions matching FNLIST.
 131 Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
 132 only the first two elements need be present.  This means FILE claimed FN
 133 was defined in FNFILE with the specified ARGLIST.  FILEONLY non-nil means
 134 to only check that FNFILE exists, not that it actually defines FN.
 135
 136 Returns nil if all claims are found to be true, otherwise a list
 137 of errors with elements of the form \(FILE FN TYPE), where TYPE
 138 is a string giving details of the error."
 139   (let ((cflag (member (file-name-extension fnfile) '("c" "m")))
 140         (ext (string-match "^ext:" fnfile))
 141         re fn sig siglist arglist type errlist minargs maxargs)
 142     (if ext
 143         (setq fnfile (substring fnfile 4)))
 144     (if (file-regular-p fnfile)
 145         (with-temp-buffer
 146           (insert-file-contents fnfile)
 147           ;; defsubst's don't _have_ to be known at compile time.
 148           (setq re (format (if cflag
 149                                "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
 150                              "^[ \t]*(\\(fset[ \t]+'\\|\
 151 cl-def\\(?:generic\\|method\\)\\|\
 152 def\\(?:un\\|subst\\|foo\\|method\\|class\\|\
 153 ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\
 154 \\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\
 155 ine-overloadable-function\\)\\)\
 156 [ \t]*%s\\([ \t;]+\\|$\\)")
 157                            (regexp-opt (mapcar 'cadr fnlist) t)))
 158           (while (re-search-forward re nil t)
 159             (skip-chars-forward " \t\n")
 160             (setq fn (match-string 2)
 161                   type (match-string 1)
 162                   ;; (min . max) for a fixed number of arguments, or
 163                   ;; arglists with optional elements.
 164                   ;; (min) for arglists with &rest.
 165                   ;; sig = 'err means we could not find an arglist.
 166                   sig (cond (cflag
 167                              (or
 168                               (when (search-forward "," nil t 3)
 169                                 (skip-chars-forward " \t\n")
 170                                 ;; Assuming minargs and maxargs on same line.
 171                                 (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
 172 \\([0-9]+\\|MANY\\|UNEVALLED\\)")
 173                                   (setq minargs (string-to-number
 174                                                  (match-string 1))
 175                                         maxargs (match-string 2))
 176                                   (cons minargs (unless (string-match "[^0-9]"
 177                                                                       maxargs)
 178                                                  (string-to-number
 179                                                   maxargs)))))
 180                               'err))
 181                             ((string-match
 182                               "\\`define-\\(derived\\|generic\\)-mode\\'"
 183                               type)
 184                              '(0 . 0))
 185                             ((string-match
 186                               "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
 187                               type)
 188                              '(0 . 1))
 189                             ;; Prompt to update.
 190                             ((string-match
 191                               "\\`define-obsolete-function-alias\\>"
 192                               type)
 193                              'obsolete)
 194                             ;; Can't easily check arguments in these cases.
 195                             ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
 196 fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
 197                              t)
 198                             ((looking-at "\\((\\|nil\\)")
 199                              (byte-compile-arglist-signature
 200                               (read (current-buffer))))
 201                             (t
 202                              'err))
 203                   ;; alist of functions and arglist signatures.
 204                   siglist (cons (cons fn sig) siglist)))))
 205     (dolist (e fnlist)
 206       (setq arglist (nth 2 e)
 207             type
 208             (if (not re)
 209                 (when (or check-declare-ext-errors (not ext))
 210                   "file not found")
 211               (if (not (setq sig (assoc (cadr e) siglist)))
 212                   (unless (nth 3 e)     ; fileonly
 213                     "function not found")
 214                 (setq sig (cdr sig))
 215                 (cond ((eq sig 'obsolete) ; check even when no arglist specified
 216                        "obsolete alias")
 217                       ;; arglist t means no arglist specified, as
 218                       ;; opposed to an empty arglist.
 219                       ((eq arglist t) nil)
 220                       ((eq sig t) nil) ; eg defalias - can't check arguments
 221                       ((eq sig 'err)
 222                        "arglist not found") ; internal error
 223                       ((not (equal (byte-compile-arglist-signature
 224                                     arglist)
 225                                    sig))
 226                        "arglist mismatch")))))
 227       (when type
 228         (setq errlist (cons (list (car e) (cadr e) type) errlist))))
 229     errlist))
 230
 231 (defun check-declare-sort (alist)
 232   "Sort a list with elements FILE (FNFILE ...).
 233 Returned list has elements FNFILE (FILE ...)."
 234   (let (file fnfile rest sort a)
 235     (dolist (e alist)
 236       (setq file (car e))
 237       (dolist (f (cdr e))
 238         (setq fnfile (car f)
 239               rest (cdr f))
 240         (if (setq a (assoc fnfile sort))
 241             (setcdr a (append (cdr a) (list (cons file rest))))
 242           (setq sort (cons (list fnfile (cons file rest)) sort)))))
 243     sort))
 244
 245 (defun check-declare-warn (file fn fnfile type &optional line)
 246   "Warn that FILE made a false claim about FN in FNFILE.
 247 TYPE is a string giving the nature of the error.
 248 Optional LINE is the claim's line number; otherwise, search for the claim.
 249 Display warning in `check-declare-warning-buffer'."
 250   (let ((warning-prefix-function
 251          (lambda (level entry)
 252            (insert (format "%s:%d:" (file-relative-name file) (or line 0)))
 253            entry))
 254         (warning-fill-prefix "    "))
 255     (unless line
 256       (with-current-buffer (find-file-noselect file)
 257         (goto-char (point-min))
 258         (when (and (not line)
 259                    (re-search-forward
 260                     (format "(declare-function[ \t\n]+%s" fn) nil t))
 261           (goto-char (match-beginning 0))
 262           (setq line (line-number-at-pos)))))
 263     (display-warning 'check-declare
 264                      (format-message "said `%s' was defined in %s: %s"
 265                                      fn (file-relative-name fnfile) type)
 266                      nil check-declare-warning-buffer)))
 267
 268 (declare-function compilation-forget-errors "compile" ())
 269
 270 (defun check-declare-files (&rest files)
 271   "Check veracity of all `declare-function' statements in FILES.
 272 Return a list of any errors found."
 273   (if (get-buffer check-declare-warning-buffer)
 274       (kill-buffer check-declare-warning-buffer))
 275   (let ((buf (get-buffer-create check-declare-warning-buffer))
 276         alist err errlist)
 277     (with-current-buffer buf
 278       (unless (derived-mode-p 'compilation-mode)
 279         (compilation-mode))
 280       (setq mode-line-process
 281             '(:propertize ":run" face compilation-mode-line-run))
 282       (let ((inhibit-read-only t))
 283         (insert "\f\n"))
 284       (compilation-forget-errors))
 285     (dolist (file files)
 286       (setq alist (cons (cons file (check-declare-scan file)) alist)))
 287     ;; Sort so that things are ordered by the files supposed to
 288     ;; contain the defuns.
 289     (dolist (e (check-declare-sort alist))
 290       (if (setq err (check-declare-verify (car e) (cdr e)))
 291           (setq errlist (cons (cons (car e) err) errlist))))
 292     (setq errlist (nreverse errlist))
 293     ;; Sort back again so that errors are ordered by the files
 294     ;; containing the declare-function statements.
 295     (dolist (e (check-declare-sort errlist))
 296       (dolist (f (cdr e))
 297         (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
 298     (with-current-buffer buf
 299       (setq mode-line-process
 300             '(:propertize ":exit" face compilation-mode-line-run))
 301       (force-mode-line-update))
 302     errlist))
 303
 304 ;;;###autoload
 305 (defun check-declare-file (file)
 306   "Check veracity of all `declare-function' statements in FILE.
 307 See `check-declare-directory' for more information."
 308   (interactive "fFile to check: ")
 309   (or (file-exists-p file)
 310       (error "File `%s' not found" file))
 311   (check-declare-files file))
 312
 313 ;;;###autoload
 314 (defun check-declare-directory (root)
 315   "Check veracity of all `declare-function' statements under directory ROOT.
 316 Returns non-nil if any false statements are found."
 317   (interactive "DDirectory to check: ")
 318   (setq root (directory-file-name (file-relative-name root)))
 319   (or (file-directory-p root)
 320       (error "Directory `%s' not found" root))
 321   (let ((files (process-lines find-program root
 322                               "-name" "*.el"
 323                               "-exec" grep-program
 324                               "-l" "^[ \t]*(declare-function" "{}" "+")))
 325     (when files
 326       (apply #'check-declare-files files))))
 327
 328 (provide 'check-declare)
 329
 330 ;;; check-declare.el ends here.