Mercurial > emacs
comparison lisp/emacs-lisp/check-declare.el @ 86457:47fc5bc30170
(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 |