Merge from emacs--rel--22
[bpt/emacs.git] / 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, or (at your option)
13 ;; 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; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
27 ;; The byte-compiler often warns about undefined functions that you
28 ;; know will actually be defined when it matters. The `declare-function'
29 ;; statement allows you to suppress these warnings. This package
30 ;; checks that all such statements in a file or directory are accurate.
31 ;; The entry points are `check-declare-file' and `check-declare-directory'.
32
33 ;; For more information, see Info node `elisp(Declaring Functions)'.
34
35 ;;; TODO:
36
37 ;; 1. Warn about functions marked as obsolete, eg
38 ;; password-read-and-add in smime.el.
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\" 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 (string-equal "c" (file-name-extension file))
58 (expand-file-name file (expand-file-name "src" source-directory))
59 (if (setq tfile (locate-library (file-name-nondirectory 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 fnfile fn arglist fileonly)
85 (message "%s" m)
86 (with-temp-buffer
87 (insert-file-contents file)
88 (while (re-search-forward
89 "^[ \t]*(declare-function[ \t]+\\(\\S-+\\)[ \t]+\
90 \"\\(\\S-+\\)\"" nil t)
91 (setq fn (match-string 1)
92 fnfile (match-string 2)
93 fnfile (check-declare-locate fnfile (expand-file-name file))
94 arglist (progn
95 (skip-chars-forward " \t\n")
96 ;; Use `t' to distinguish no arglist
97 ;; specified from an empty one.
98 (if (looking-at "\\((\\|nil\\|t\\)")
99 (read (current-buffer))
100 t))
101 fileonly (progn
102 (skip-chars-forward " \t\n")
103 (if (looking-at "\\(t\\|'\\sw+\\)")
104 (match-string 1)))
105 alist (cons (list fnfile fn arglist fileonly) alist))))
106 (message "%sdone" m)
107 alist))
108
109 (defun check-declare-errmsg (errlist &optional full)
110 "Return a string with the number of errors in ERRLIST, if any.
111 Normally just counts the number of elements in ERRLIST.
112 With optional argument FULL, sums the number of elements in each element."
113 (if errlist
114 (let ((l (length errlist)))
115 (when full
116 (setq l 0)
117 (dolist (e errlist)
118 (setq l (1+ l))))
119 (format "%d problem%s found" l (if (= l 1) "" "s")))
120 "OK"))
121
122 (autoload 'byte-compile-arglist-signature "bytecomp")
123
124 (defun check-declare-verify (fnfile fnlist)
125 "Check that FNFILE contains function definitions matching FNLIST.
126 Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
127 only the first two elements need be present. This means FILE claimed FN
128 was defined in FNFILE with the specified ARGLIST. FILEONLY non-nil means
129 to only check that FNFILE exists, not that it actually defines FN.
130
131 Returns nil if all claims are found to be true, otherwise a list
132 of errors with elements of the form \(FILE FN TYPE), where TYPE
133 is a string giving details of the error."
134 (let ((m (format "Checking %s..." fnfile))
135 (cflag (string-equal "c" (file-name-extension fnfile)))
136 (ext (string-match "^ext:" fnfile))
137 re fn sig siglist arglist type errlist minargs maxargs)
138 (message "%s" m)
139 (if ext
140 (setq fnfile (substring fnfile 4)))
141 (if (file-exists-p fnfile)
142 (with-temp-buffer
143 (insert-file-contents fnfile)
144 ;; defsubst's don't _have_ to be known at compile time.
145 (setq re (format (if cflag
146 "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
147 "^[ \t]*(\\(fset[ \t]+'\\|\
148 def\\(?:un\\|subst\\|foo\\|\
149 ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\
150 \\|\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\)\\)\
151 \[ \t]*%s\\([ \t;]+\\|$\\)")
152 (regexp-opt (mapcar 'cadr fnlist) t)))
153 (while (re-search-forward re nil t)
154 (skip-chars-forward " \t\n")
155 (setq fn (match-string 2)
156 type (match-string 1)
157 ;; (min . max) for a fixed number of arguments, or
158 ;; arglists with optional elements.
159 ;; (min) for arglists with &rest.
160 ;; sig = 'err means we could not find an arglist.
161 sig (cond (cflag
162 (or
163 (when (re-search-forward "," nil t 3)
164 (skip-chars-forward " \t\n")
165 ;; Assuming minargs and maxargs on same line.
166 (when (looking-at "\\([0-9]+\\)[ \t]*,[ \t]*\
167 \\([0-9]+\\|MANY\\|UNEVALLED\\)")
168 (setq minargs (string-to-number
169 (match-string 1))
170 maxargs (match-string 2))
171 (cons minargs (unless (string-match "[^0-9]"
172 maxargs)
173 (string-to-number
174 maxargs)))))
175 'err))
176 ((string-match
177 "\\`define-\\(derived\\|generic\\)-mode\\'"
178 type)
179 '(0 . 0))
180 ((string-match
181 "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
182 type)
183 '(0 . 1))
184 ;; Prompt to update.
185 ((string-match
186 "\\`define-obsolete-function-alias\\>"
187 type)
188 'obsolete)
189 ;; Can't easily check arguments in these cases.
190 ((string-match "\\`\\(defalias\\|fset\\)\\>" type)
191 t)
192 ((looking-at "\\((\\|nil\\)")
193 (byte-compile-arglist-signature
194 (read (current-buffer))))
195 (t
196 'err))
197 ;; alist of functions and arglist signatures.
198 siglist (cons (cons fn sig) siglist)))))
199 (dolist (e fnlist)
200 (setq arglist (nth 2 e)
201 type
202 (if (not re)
203 "file not found"
204 (if (not (setq sig (assoc (cadr e) siglist)))
205 (unless (nth 3 e) ; fileonly
206 "function not found")
207 (setq sig (cdr sig))
208 (cond ((eq sig 'obsolete) ; check even when no arglist specified
209 "obsolete alias")
210 ;; arglist t means no arglist specified, as
211 ;; opposed to an empty arglist.
212 ((eq arglist t) nil)
213 ((eq sig t) nil) ; eg defalias - can't check arguments
214 ((eq sig 'err)
215 "arglist not found") ; internal error
216 ((not (equal (byte-compile-arglist-signature
217 arglist)
218 sig))
219 "arglist mismatch")))))
220 (when type
221 (setq errlist (cons (list (car e) (cadr e) type) errlist))))
222 (message "%s%s" m
223 (if (or re (not ext))
224 (check-declare-errmsg errlist)
225 (progn
226 (setq errlist nil)
227 "skipping external file")))
228 errlist))
229
230 (defun check-declare-sort (alist)
231 "Sort a list with elements FILE (FNFILE ...).
232 Returned list has elements FNFILE (FILE ...)."
233 (let (file fnfile rest sort a)
234 (dolist (e alist)
235 (setq file (car e))
236 (dolist (f (cdr e))
237 (setq fnfile (car f)
238 rest (cdr f))
239 (if (setq a (assoc fnfile sort))
240 (setcdr a (append (cdr a) (list (cons file rest))))
241 (setq sort (cons (list fnfile (cons file rest)) sort)))))
242 sort))
243
244 (defun check-declare-warn (file fn fnfile type)
245 "Warn that FILE made a false claim about FN in FNFILE.
246 TYPE is a string giving the nature of the error. Warning is displayed in
247 `check-declare-warning-buffer'."
248 (display-warning 'check-declare
249 (format "%s said `%s' was defined in %s: %s"
250 (file-name-nondirectory file) fn
251 (file-name-nondirectory fnfile)
252 type)
253 nil check-declare-warning-buffer))
254
255 (defun check-declare-files (&rest files)
256 "Check veracity of all `declare-function' statements in FILES.
257 Return a list of any errors found."
258 (let (alist err errlist)
259 (dolist (file files)
260 (setq alist (cons (cons file (check-declare-scan file)) alist)))
261 ;; Sort so that things are ordered by the files supposed to
262 ;; contain the defuns.
263 (dolist (e (check-declare-sort alist))
264 (if (setq err (check-declare-verify (car e) (cdr e)))
265 (setq errlist (cons (cons (car e) err) errlist))))
266 (if (get-buffer check-declare-warning-buffer)
267 (kill-buffer check-declare-warning-buffer))
268 ;; Sort back again so that errors are ordered by the files
269 ;; containing the declare-function statements.
270 (dolist (e (check-declare-sort errlist))
271 (dolist (f (cdr e))
272 (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
273 errlist))
274
275 ;;;###autoload
276 (defun check-declare-file (file)
277 "Check veracity of all `declare-function' statements in FILE.
278 See `check-declare-directory' for more information."
279 (interactive "fFile to check: ")
280 (or (file-exists-p file)
281 (error "File `%s' not found" file))
282 (let ((m (format "Checking %s..." file))
283 errlist)
284 (message "%s" m)
285 (setq errlist (check-declare-files file))
286 (message "%s%s" m (check-declare-errmsg errlist))
287 errlist))
288
289 ;;;###autoload
290 (defun check-declare-directory (root)
291 "Check veracity of all `declare-function' statements under directory ROOT.
292 Returns non-nil if any false statements are found. For this to
293 work correctly, the statements must adhere to the format
294 described in the documentation of `declare-function'."
295 (interactive "DDirectory to check: ")
296 (or (file-directory-p (setq root (expand-file-name root)))
297 (error "Directory `%s' not found" root))
298 (let ((m "Checking `declare-function' statements...")
299 (m2 "Finding files with declarations...")
300 errlist files)
301 (message "%s" m)
302 (message "%s" m2)
303 (setq files (process-lines find-program root
304 "-name" "*.el"
305 "-exec" grep-program
306 "-l" "^[ \t]*(declare-function" "{}" ";"))
307 (message "%s%d found" m2 (length files))
308 (when files
309 (setq errlist (apply 'check-declare-files files))
310 (message "%s%s" m (check-declare-errmsg errlist t))
311 errlist)))
312
313 (provide 'check-declare)
314
315 ;; arch-tag: a4d6cdc4-deb7-4502-b327-0e4ef3d82d96
316 ;;; check-declare.el ends here.