code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/check-declare.el

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