Mercurial > emacs

comparison lisp/emacs-lisp/check-declare.el @ 86457:47fc5bc30170

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(check-declare-locate): Handle compressed files. (check-declare-verify): Handle define-generic-mode, define-global(ized)-minor-mode, define-obsolete-function-alias.
author Glenn Morris <rgm@gnu.org>
date Tue, 27 Nov 2007 03:54:47 +0000
parents b8e2c95bbb6e
children db04d9e790f1
comparison
equal deleted inserted replaced
86456:b3d5d8240204 86457:47fc5bc30170
33 ;; For more information, see Info node `elisp(Declaring Functions)'. 33 ;; For more information, see Info node `elisp(Declaring Functions)'.
34 34
35 ;;; TODO: 35 ;;; TODO:
36 36
37 ;; 1. Handle defstructs (eg uniquify-item-base in desktop.el). 37 ;; 1. Handle defstructs (eg uniquify-item-base in desktop.el).
38
39 ;; 2. Handle fset (eg dired-omit-old-add-entry in dired-x.el).
38 40
39 ;;; Code: 41 ;;; Code:
40 42
41 (defconst check-declare-warning-buffer "*Check Declarations Warnings*" 43 (defconst check-declare-warning-buffer "*Check Declarations Warnings*"
42 "Name of buffer used to display any `check-declare' warnings.") 44 "Name of buffer used to display any `check-declare' warnings.")
49 directory part. The returned file might not exist." 51 directory part. The returned file might not exist."
50 (if (string-equal "c" (file-name-extension file)) 52 (if (string-equal "c" (file-name-extension file))
51 (expand-file-name file (expand-file-name "src" source-directory)) 53 (expand-file-name file (expand-file-name "src" source-directory))
52 (let ((tfile (locate-library (file-name-nondirectory file)))) 54 (let ((tfile (locate-library (file-name-nondirectory file))))
53 (if tfile 55 (if tfile
54 (replace-regexp-in-string "\\.elc\\'" ".el" tfile) 56 (progn
57 (setq tfile (replace-regexp-in-string "\\.elc\\'" ".el" tfile))
58 (if (and (not (file-exists-p tfile))
59 (file-exists-p (concat tfile ".gz")))
60 (concat tfile ".gz")
61 tfile))
55 (setq tfile (expand-file-name file (file-name-directory basefile))) 62 (setq tfile (expand-file-name file (file-name-directory basefile)))
56 (if (or (file-exists-p tfile) 63 (if (or (file-exists-p tfile)
57 (string-match "\\.el\\'" tfile)) 64 (string-match "\\.el\\'" tfile))
58 tfile 65 tfile
59 (concat tfile ".el")))))) 66 (concat tfile ".el"))))))
104 (insert-file-contents fnfile) 111 (insert-file-contents fnfile)
105 ;; defsubst's don't _have_ to be known at compile time. 112 ;; defsubst's don't _have_ to be known at compile time.
106 (setq re (format (if cflag 113 (setq re (format (if cflag
107 "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\"" 114 "^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
108 "^[ \t]*(\\(def\\(?:un\\|subst\\|\ 115 "^[ \t]*(\\(def\\(?:un\\|subst\\|\
109 ine-derived-mode\\|ine-minor-mode\\|alias[ \t]+'\\)\\)\ 116 ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\
117 \\|\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\)\\)\
110 \[ \t]*%s\\([ \t;]+\\|$\\)") 118 \[ \t]*%s\\([ \t;]+\\|$\\)")
111 (regexp-opt (mapcar 'cadr fnlist) t))) 119 (regexp-opt (mapcar 'cadr fnlist) t)))
112 (while (re-search-forward re nil t) 120 (while (re-search-forward re nil t)
113 (skip-chars-forward " \t\n") 121 (skip-chars-forward " \t\n")
114 (setq fn (match-string 2) 122 (setq fn (match-string 2)
123 type (match-string 1)
115 ;; (min . max) for a fixed number of arguments, or 124 ;; (min . max) for a fixed number of arguments, or
116 ;; arglists with optional elements. 125 ;; arglists with optional elements.
117 ;; (min) for arglists with &rest. 126 ;; (min) for arglists with &rest.
118 ;; sig = 'err means we could not find an arglist. 127 ;; sig = 'err means we could not find an arglist.
119 sig (cond (cflag 128 sig (cond (cflag
129 (cons minargs (unless (string-match "[^0-9]" 138 (cons minargs (unless (string-match "[^0-9]"
130 maxargs) 139 maxargs)
131 (string-to-number 140 (string-to-number
132 maxargs))))) 141 maxargs)))))
133 'err)) 142 'err))
134 ((string-equal (match-string 1) 143 ((string-match
135 "define-derived-mode") 144 "\\`define-\\(derived\\|generic\\)-mode\\'"
145 type)
136 '(0 . 0)) 146 '(0 . 0))
137 ((string-equal (match-string 1) 147 ((string-match
138 "define-minor-mode") 148 "\\`define\\(-global\\(ized\\)?\\)?-minor-mode\\'"
149 type)
139 '(0 . 1)) 150 '(0 . 1))
151 ;; Prompt to update.
152 ((string-match
153 "\\`define-obsolete-function-alias\\>"
154 type)
155 'obsolete)
140 ;; Can't easily check alias arguments. 156 ;; Can't easily check alias arguments.
141 ((string-equal (match-string 1) 157 ((string-match "\\`defalias\\>" type)
142 "defalias")
143 t) 158 t)
144 ((looking-at "\\((\\|nil\\)") 159 ((looking-at "\\((\\|nil\\)")
145 (byte-compile-arglist-signature 160 (byte-compile-arglist-signature
146 (read (current-buffer)))) 161 (read (current-buffer))))
147 (t 162 (t
149 ;; alist of functions and arglist signatures. 164 ;; alist of functions and arglist signatures.
150 siglist (cons (cons fn sig) siglist))))) 165 siglist (cons (cons fn sig) siglist)))))
151 (dolist (e fnlist) 166 (dolist (e fnlist)
152 (setq arglist (nth 2 e) 167 (setq arglist (nth 2 e)
153 type 168 type
154 (if re ; re non-nil means found a file 169 (if (not re)
155 (if (setq sig (assoc (cadr e) siglist)) ; found function 170 "file not found"
156 ;; Recall we use t to mean no arglist specified, 171 (if (not (setq sig (assoc (cadr e) siglist)))
157 ;; to distinguish from an empty arglist. 172 "function not found"
158 (unless (eq arglist t) 173 (setq sig (cdr sig))
159 (setq sig (cdr-safe sig)) 174 (cond ((eq sig 'obsolete) ; check even when no arglist specified
160 (cond ((eq sig t)) ; defalias, can't check 175 "obsolete alias")
161 ((eq sig 'err) 176 ;; arglist t means no arglist specified, as
162 "arglist not found") ; internal error 177 ;; opposed to an empty arglist.
163 ((not (equal (byte-compile-arglist-signature 178 ((eq arglist t) nil)
164 arglist) 179 ((eq sig t) nil) ; defalias, can't check
165 sig)) 180 ((eq sig 'err)
166 "arglist mismatch"))) 181 "arglist not found") ; internal error
167 "function not found") 182 ((not (equal (byte-compile-arglist-signature
168 "file not found")) 183 arglist)
184 sig))
185 "arglist mismatch")))))
169 (when type 186 (when type
170 (setq errlist (cons (list (car e) (cadr e) type) errlist)))) 187 (setq errlist (cons (list (car e) (cadr e) type) errlist))))
171 (message "%s%s" m (if errlist "problems found" "OK")) 188 (message "%s%s" m (if errlist "problems found" "OK"))
172 errlist)) 189 errlist))
173 190