Mercurial > emacs
comparison admin/cus-test.el @ 47801:6a024dc61d30
Initial version as part of GNU Emacs.
Revision of the 1998, 2000 code designed for Emacs 20.3 resp. 21.1.
author | Markus Rost <rost@math.uni-bielefeld.de> |
---|---|
date | Tue, 08 Oct 2002 18:42:36 +0000 |
parents | |
children | e635ea5fd015 |
comparison
equal
deleted
inserted
replaced
47800:ef10fe99a92f | 47801:6a024dc61d30 |
---|---|
1 ;;; cus-test.el --- functions for testing custom variable definitions | |
2 | |
3 ;; Copyright (C) 1998, 2000, 2002 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Markus Rost <markus.rost@mathematik.uni-regensburg.de> | |
6 ;; Maintainer: Markus Rost <rost@math.ohio-state.edu> | |
7 ;; Created: 13 Sep 1998 | |
8 ;; Keywords: maint | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; Some user options in GNU Emacs have been defined with incorrect | |
30 ;; customization types. As a result the customization of these | |
31 ;; options is disabled. This file provides functions to detect such | |
32 ;; options. | |
33 ;; | |
34 ;; Usage: Load this file. Then | |
35 ;; | |
36 ;; M-x cus-test-apropos REGEXP RET | |
37 ;; | |
38 ;; checks the options matching REGEXP. In particular | |
39 ;; | |
40 ;; M-x cus-test-apropos RET | |
41 ;; | |
42 ;; checks all options. The detected options are stored in the | |
43 ;; variable `cus-test-errors'. | |
44 ;; | |
45 ;; Only those options are checked which have been already loaded. | |
46 ;; Therefore `cus-test-apropos' is more efficient after loading many | |
47 ;; libraries. | |
48 ;; | |
49 ;; M-x cus-test-library LIB RET | |
50 ;; | |
51 ;; loads library LIB and checks the options matching LIB. | |
52 ;; | |
53 ;; M-x cus-test-load-custom-loads RET | |
54 ;; | |
55 ;; loads all (!) custom dependencies. | |
56 ;; | |
57 ;; M-x cus-test-load-libs RET | |
58 ;; | |
59 ;; loads all (!) libraries with autoloads. This function is useful to | |
60 ;; detect load problems of libraries. | |
61 ;; | |
62 ;; For a maximal test of custom options invoke | |
63 ;; | |
64 ;; M-x cus-test-all | |
65 ;; | |
66 ;; This function is suitable for batch mode. | |
67 ;; | |
68 ;; To make cus-test work one has usually to work-around some existing | |
69 ;; bugs/problems. Therefore this file contains a "Workaround" | |
70 ;; section, to be edited once in a while. | |
71 ;; | |
72 ;; There is an additional experimental option | |
73 ;; `cus-test-include-changed-variables'. | |
74 ;; | |
75 ;; Options with a custom-get property, usually defined by a :get | |
76 ;; declararation, are stored in the variable | |
77 ;; `cus-test-variables-with-custom-get', just in case one wants to | |
78 ;; investigate them further. | |
79 | |
80 ;;; Code: | |
81 | |
82 ;;; User variables: | |
83 | |
84 (defvar cus-test-strange-variables nil | |
85 "*List of variables to disregard by `cus-test-apropos'.") | |
86 | |
87 (defvar cus-test-strange-libs nil | |
88 "*List of libraries to avoid by `cus-test-load-libs'.") | |
89 | |
90 (defvar cus-test-after-load-libraries-hook nil | |
91 "*Hook to repair the worst side effects of loading buggy libraries. | |
92 It is run after `cus-test-load-custom-loads' and `cus-test-load-libs'") | |
93 | |
94 (defvar cus-test-include-changed-variables nil | |
95 "*If non-nil, consider variables with state 'changed as buggy.") | |
96 | |
97 ;;; Workarounds: | |
98 | |
99 ;; avoid error when loading speedbar.el | |
100 ;; bug in speedbar.el in 20.3: | |
101 ;; (define-key speedbar-key-map "Q" 'delete c-frame) | |
102 ;; (setq speedbar-key-map (make-keymap)) | |
103 | |
104 ;; avoid binding of M-x to `save-buffers-exit-emacs' after loading | |
105 ;; crisp.el (in 20.3): | |
106 ;; (setq crisp-override-meta-x nil) | |
107 | |
108 ;; Work around bugs in 21.0: | |
109 | |
110 ;; (defvar msb-after-load-hooks) | |
111 | |
112 ;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which | |
113 ;; are not part of GNU Emacs. | |
114 (provide 'bbdb) | |
115 (provide 'bbdb-com) | |
116 ;; (locate-library "bbdb") | |
117 | |
118 ;; Work around bugs in 21.3.50: | |
119 | |
120 ;; ada load problems are fixed now. | |
121 ;; (add-to-list 'cus-test-strange-libs "ada-xref") | |
122 | |
123 ;; Loading filesets.el currently disables mini-buffer echoes. | |
124 ;; (add-to-list 'cus-test-strange-libs "filesets") | |
125 (add-hook | |
126 'cus-test-after-load-libraries-hook | |
127 (lambda nil | |
128 (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe) | |
129 (remove-hook 'kill-emacs-hook 'filesets-exit) | |
130 (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl) | |
131 (remove-hook 'first-change-hook 'filesets-reset-filename-on-change) | |
132 )) | |
133 ;; (setq cus-test-after-load-libraries-hook nil) | |
134 | |
135 ;; After loading many libraries there appears an error: | |
136 ;; Loading filesets... | |
137 ;; tpu-current-line: Args out of range: 44, 84185 | |
138 | |
139 ;; vc-cvs-registered in loaddefs.el runs a loop if vc-cvs.el is | |
140 ;; already loaded. | |
141 (eval-after-load "loaddefs" '(load-library "vc-cvs")) | |
142 | |
143 ;; reftex must be loaded before reftex-vars. | |
144 (require 'reftex) | |
145 | |
146 ;;; Current result (Oct 6, 2002) of cus-test-all: | |
147 | |
148 ;; Cus Test tested 4514 variables. | |
149 ;; The following variables might have problems: | |
150 ;; (ps-mule-font-info-database-default) | |
151 | |
152 ;;; Silencing: | |
153 | |
154 ;; Don't create a file filesets-menu-cache-file. | |
155 (setq filesets-menu-cache-file "") | |
156 | |
157 ;; Don't create a file save-place-file. | |
158 (eval-after-load "saveplace" | |
159 '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)) | |
160 | |
161 ;; Don't create a file abbrev-file-name. | |
162 (setq save-abbrevs nil) | |
163 | |
164 ;; Avoid compile logs from adviced functions. | |
165 (eval-after-load "bytecomp" | |
166 '(setq ad-default-compilation-action 'never)) | |
167 | |
168 ;; We want to log all messages. | |
169 (setq message-log-max t) | |
170 | |
171 | |
172 ;;; Main Code: | |
173 | |
174 (defvar cus-test-tested-variables nil | |
175 "Options tested by last call of `cus-test-apropos'.") | |
176 | |
177 (defvar cus-test-errors nil | |
178 "List of problematic variables found by `cus-test-apropos'.") | |
179 | |
180 ;; I haven't understood this :get stuff. However, there are only very | |
181 ;; few variables with a custom-get property. Such Symbols are stored | |
182 ;; in `cus-test-variables-with-custom-get'. | |
183 (defvar cus-test-variables-with-custom-get nil | |
184 "Set by `cus-test-apropos' to a list of options with :get property.") | |
185 | |
186 ;; This loads cus-loads.el, too. | |
187 (require 'cus-edit) | |
188 | |
189 (defun cus-test-apropos (regexp) | |
190 "Check the options matching REGEXP. | |
191 The detected problematic options are stored in `cus-test-errors'." | |
192 (interactive "sVariable regexp: ") | |
193 (setq cus-test-errors nil) | |
194 (setq cus-test-tested-variables nil) | |
195 (mapcar | |
196 (lambda (symbol) | |
197 (push symbol cus-test-tested-variables) | |
198 (unless noninteractive | |
199 (message "Cus Test Running...[%s]" | |
200 (length cus-test-tested-variables))) | |
201 (condition-case alpha | |
202 (let* ((type (custom-variable-type symbol)) | |
203 (conv (widget-convert type)) | |
204 ;; I haven't understood this :get stuff. | |
205 (get (or (get symbol 'custom-get) 'default-value)) | |
206 values | |
207 mismatch) | |
208 (when (default-boundp symbol) | |
209 (add-to-list 'values | |
210 (funcall get symbol)) | |
211 (add-to-list 'values | |
212 (eval (car (get symbol 'standard-value))))) | |
213 (if (boundp symbol) | |
214 (add-to-list 'values (symbol-value symbol))) | |
215 ;; That does not work. | |
216 ;; (add-to-list 'values (widget-get conv :value)) | |
217 | |
218 ;; Check the values | |
219 (mapcar (lambda (value) | |
220 (unless (widget-apply conv :match value) | |
221 (setq mismatch 'mismatch))) | |
222 values) | |
223 | |
224 ;; Changed outside the customize buffer? | |
225 (when cus-test-include-changed-variables | |
226 (let ((c-value | |
227 (or (get symbol 'customized-value) | |
228 (get symbol 'saved-value) | |
229 (get symbol 'standard-value)))) | |
230 (if c-value | |
231 (unless (equal (eval (car c-value)) | |
232 (symbol-value symbol)) | |
233 (setq mismatch 'changed))))) | |
234 | |
235 ;; Store symbols with a custom-get property. | |
236 (when (get symbol 'custom-get) | |
237 (add-to-list 'cus-test-variables-with-custom-get symbol) | |
238 ;; No need anymore to ignore them. | |
239 ;; (setq mismatch nil) | |
240 ) | |
241 | |
242 (if mismatch | |
243 (add-to-list 'cus-test-errors symbol))) | |
244 | |
245 (error | |
246 (add-to-list 'cus-test-errors symbol) | |
247 (if (y-or-n-p | |
248 (format "Error for %s: %s\nContinue? " | |
249 symbol alpha)) | |
250 (message "Error for %s: %s" symbol alpha) | |
251 (error "Error for %s: %s" symbol alpha))))) | |
252 (cus-test-get-options regexp)) | |
253 (message "Cus Test tested %s variables." | |
254 (length cus-test-tested-variables)) | |
255 ;; (describe-variable 'cus-test-errors) | |
256 (cus-test-errors-display) | |
257 ;; (describe-variable 'cus-test-variables-with-custom-get) | |
258 ) | |
259 | |
260 (defun cus-test-get-options (regexp) | |
261 "Return a list of custom options matching REGEXP." | |
262 (let (found) | |
263 (mapatoms | |
264 (lambda (symbol) | |
265 (and | |
266 (or | |
267 ;; (user-variable-p symbol) | |
268 (get symbol 'standard-value) | |
269 ;; (get symbol 'saved-value) | |
270 (get symbol 'custom-type)) | |
271 (string-match regexp (symbol-name symbol)) | |
272 (not (member symbol cus-test-strange-variables)) | |
273 (push symbol found)))) | |
274 found)) | |
275 | |
276 (defun cus-test-errors-display () | |
277 "Report about the errors found by cus-test." | |
278 (with-output-to-temp-buffer "*cus-test-errors*" | |
279 (set-buffer standard-output) | |
280 (insert (format "Cus Test tested %s variables.\ | |
281 See `cus-test-tested-variables'.\n\n" | |
282 (length cus-test-tested-variables))) | |
283 (if cus-test-errors | |
284 (let ((L cus-test-errors)) | |
285 (insert "The following variables seem to have errors:\n\n") | |
286 (while L (insert (symbol-name (car L))) (insert "\n") | |
287 (setq L (cdr L)))) | |
288 (insert "No errors found by cus-test.")))) | |
289 | |
290 (defun cus-test-library (lib) | |
291 "Load library LIB and call `cus-test-apropos' on LIB." | |
292 (interactive "sTest variables in library: ") | |
293 (load-library lib) | |
294 (cus-test-apropos lib)) | |
295 | |
296 (defun cus-test-load-custom-loads nil | |
297 "Call `custom-load-symbol' on all atoms." | |
298 (interactive) | |
299 (mapatoms 'custom-load-symbol) | |
300 (run-hooks 'cus-test-after-load-libraries-hook)) | |
301 | |
302 (defun cus-test-load-libs () | |
303 "Load the libraries with autoloads in loaddefs.el. | |
304 Don't load libraries in `cus-test-strange-libs'. | |
305 | |
306 This function is useful to detect load problems of libraries." | |
307 (interactive) | |
308 (set-buffer (find-file-noselect (locate-library "loaddefs"))) | |
309 (goto-char (point-min)) | |
310 (let (file) | |
311 (while | |
312 (search-forward "\n;;; Generated autoloads from " nil t) | |
313 (goto-char (match-end 0)) | |
314 (setq file (buffer-substring (point) | |
315 (progn (end-of-line) (point)))) | |
316 ;; If it is, load that library. | |
317 (when file | |
318 (setq file (file-name-nondirectory file)) | |
319 (when (string-match "\\.el\\'" file) | |
320 (setq file (substring file 0 (match-beginning 0))))) | |
321 (condition-case alpha | |
322 (unless (member file cus-test-strange-libs) | |
323 (load-library file)) | |
324 (error (or | |
325 (y-or-n-p | |
326 (format "Load Error for %s: %s\nContinue Loading? " | |
327 file alpha)) | |
328 (error "Load Error for %s: %s" file alpha)))) | |
329 )) | |
330 (run-hooks 'cus-test-after-load-libraries-hook)) | |
331 | |
332 (defun cus-test-all nil | |
333 "Run a maximal test by cus-test. | |
334 This function is suitable for batch mode, e.g., invoke | |
335 | |
336 emacs -batch -l cus-test.el -f cus-test-all" | |
337 (interactive) | |
338 ;; This does not seem to increase the number of tested options. | |
339 ;; (message "Running %s" 'cus-test-load-libs) | |
340 ;; (cus-test-load-libs) | |
341 (message "Running %s" 'cus-test-load-custom-loads) | |
342 (cus-test-load-custom-loads) | |
343 ;; A second call increases the number of tested options. | |
344 (message "Running %s again" 'cus-test-load-custom-loads) | |
345 (cus-test-load-custom-loads) | |
346 (message "Running %s" 'cus-test-apropos) | |
347 (cus-test-apropos "") | |
348 (if cus-test-errors | |
349 (message "The following variables might have problems:\n%s" | |
350 cus-test-errors) | |
351 (message "No problems found by Cus Test"))) | |
352 | |
353 (provide 'cus-test) | |
354 | |
355 ;;; cus-test.el ends here |