# HG changeset patch # User Markus Rost # Date 1034102556 0 # Node ID 6a024dc61d30ba1ee9efb440f5416824803bcede # Parent ef10fe99a92fedc3d93fbafb32befde822dcbeda Initial version as part of GNU Emacs. Revision of the 1998, 2000 code designed for Emacs 20.3 resp. 21.1. diff -r ef10fe99a92f -r 6a024dc61d30 admin/cus-test.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/admin/cus-test.el Tue Oct 08 18:42:36 2002 +0000 @@ -0,0 +1,355 @@ +;;; cus-test.el --- functions for testing custom variable definitions + +;; Copyright (C) 1998, 2000, 2002 Free Software Foundation, Inc. + +;; Author: Markus Rost +;; Maintainer: Markus Rost +;; Created: 13 Sep 1998 +;; Keywords: maint + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Some user options in GNU Emacs have been defined with incorrect +;; customization types. As a result the customization of these +;; options is disabled. This file provides functions to detect such +;; options. +;; +;; Usage: Load this file. Then +;; +;; M-x cus-test-apropos REGEXP RET +;; +;; checks the options matching REGEXP. In particular +;; +;; M-x cus-test-apropos RET +;; +;; checks all options. The detected options are stored in the +;; variable `cus-test-errors'. +;; +;; Only those options are checked which have been already loaded. +;; Therefore `cus-test-apropos' is more efficient after loading many +;; libraries. +;; +;; M-x cus-test-library LIB RET +;; +;; loads library LIB and checks the options matching LIB. +;; +;; M-x cus-test-load-custom-loads RET +;; +;; loads all (!) custom dependencies. +;; +;; M-x cus-test-load-libs RET +;; +;; loads all (!) libraries with autoloads. This function is useful to +;; detect load problems of libraries. +;; +;; For a maximal test of custom options invoke +;; +;; M-x cus-test-all +;; +;; This function is suitable for batch mode. +;; +;; To make cus-test work one has usually to work-around some existing +;; bugs/problems. Therefore this file contains a "Workaround" +;; section, to be edited once in a while. +;; +;; There is an additional experimental option +;; `cus-test-include-changed-variables'. +;; +;; Options with a custom-get property, usually defined by a :get +;; declararation, are stored in the variable +;; `cus-test-variables-with-custom-get', just in case one wants to +;; investigate them further. + +;;; Code: + +;;; User variables: + +(defvar cus-test-strange-variables nil + "*List of variables to disregard by `cus-test-apropos'.") + +(defvar cus-test-strange-libs nil + "*List of libraries to avoid by `cus-test-load-libs'.") + +(defvar cus-test-after-load-libraries-hook nil + "*Hook to repair the worst side effects of loading buggy libraries. +It is run after `cus-test-load-custom-loads' and `cus-test-load-libs'") + +(defvar cus-test-include-changed-variables nil + "*If non-nil, consider variables with state 'changed as buggy.") + +;;; Workarounds: + +;; avoid error when loading speedbar.el +;; bug in speedbar.el in 20.3: +;; (define-key speedbar-key-map "Q" 'delete c-frame) +;; (setq speedbar-key-map (make-keymap)) + +;; avoid binding of M-x to `save-buffers-exit-emacs' after loading +;; crisp.el (in 20.3): +;; (setq crisp-override-meta-x nil) + +;; Work around bugs in 21.0: + +;; (defvar msb-after-load-hooks) + +;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which +;; are not part of GNU Emacs. +(provide 'bbdb) +(provide 'bbdb-com) +;; (locate-library "bbdb") + +;; Work around bugs in 21.3.50: + +;; ada load problems are fixed now. +;; (add-to-list 'cus-test-strange-libs "ada-xref") + +;; Loading filesets.el currently disables mini-buffer echoes. +;; (add-to-list 'cus-test-strange-libs "filesets") +(add-hook + 'cus-test-after-load-libraries-hook + (lambda nil + (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe) + (remove-hook 'kill-emacs-hook 'filesets-exit) + (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl) + (remove-hook 'first-change-hook 'filesets-reset-filename-on-change) + )) +;; (setq cus-test-after-load-libraries-hook nil) + +;; After loading many libraries there appears an error: +;; Loading filesets... +;; tpu-current-line: Args out of range: 44, 84185 + +;; vc-cvs-registered in loaddefs.el runs a loop if vc-cvs.el is +;; already loaded. +(eval-after-load "loaddefs" '(load-library "vc-cvs")) + +;; reftex must be loaded before reftex-vars. +(require 'reftex) + +;;; Current result (Oct 6, 2002) of cus-test-all: + +;; Cus Test tested 4514 variables. +;; The following variables might have problems: +;; (ps-mule-font-info-database-default) + +;;; Silencing: + +;; Don't create a file filesets-menu-cache-file. +(setq filesets-menu-cache-file "") + +;; Don't create a file save-place-file. +(eval-after-load "saveplace" + '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)) + +;; Don't create a file abbrev-file-name. +(setq save-abbrevs nil) + +;; Avoid compile logs from adviced functions. +(eval-after-load "bytecomp" + '(setq ad-default-compilation-action 'never)) + +;; We want to log all messages. +(setq message-log-max t) + + +;;; Main Code: + +(defvar cus-test-tested-variables nil + "Options tested by last call of `cus-test-apropos'.") + +(defvar cus-test-errors nil + "List of problematic variables found by `cus-test-apropos'.") + +;; I haven't understood this :get stuff. However, there are only very +;; few variables with a custom-get property. Such Symbols are stored +;; in `cus-test-variables-with-custom-get'. +(defvar cus-test-variables-with-custom-get nil + "Set by `cus-test-apropos' to a list of options with :get property.") + +;; This loads cus-loads.el, too. +(require 'cus-edit) + +(defun cus-test-apropos (regexp) + "Check the options matching REGEXP. +The detected problematic options are stored in `cus-test-errors'." + (interactive "sVariable regexp: ") + (setq cus-test-errors nil) + (setq cus-test-tested-variables nil) + (mapcar + (lambda (symbol) + (push symbol cus-test-tested-variables) + (unless noninteractive + (message "Cus Test Running...[%s]" + (length cus-test-tested-variables))) + (condition-case alpha + (let* ((type (custom-variable-type symbol)) + (conv (widget-convert type)) + ;; I haven't understood this :get stuff. + (get (or (get symbol 'custom-get) 'default-value)) + values + mismatch) + (when (default-boundp symbol) + (add-to-list 'values + (funcall get symbol)) + (add-to-list 'values + (eval (car (get symbol 'standard-value))))) + (if (boundp symbol) + (add-to-list 'values (symbol-value symbol))) + ;; That does not work. + ;; (add-to-list 'values (widget-get conv :value)) + + ;; Check the values + (mapcar (lambda (value) + (unless (widget-apply conv :match value) + (setq mismatch 'mismatch))) + values) + + ;; Changed outside the customize buffer? + (when cus-test-include-changed-variables + (let ((c-value + (or (get symbol 'customized-value) + (get symbol 'saved-value) + (get symbol 'standard-value)))) + (if c-value + (unless (equal (eval (car c-value)) + (symbol-value symbol)) + (setq mismatch 'changed))))) + + ;; Store symbols with a custom-get property. + (when (get symbol 'custom-get) + (add-to-list 'cus-test-variables-with-custom-get symbol) + ;; No need anymore to ignore them. + ;; (setq mismatch nil) + ) + + (if mismatch + (add-to-list 'cus-test-errors symbol))) + + (error + (add-to-list 'cus-test-errors symbol) + (if (y-or-n-p + (format "Error for %s: %s\nContinue? " + symbol alpha)) + (message "Error for %s: %s" symbol alpha) + (error "Error for %s: %s" symbol alpha))))) + (cus-test-get-options regexp)) + (message "Cus Test tested %s variables." + (length cus-test-tested-variables)) + ;; (describe-variable 'cus-test-errors) + (cus-test-errors-display) + ;; (describe-variable 'cus-test-variables-with-custom-get) + ) + +(defun cus-test-get-options (regexp) + "Return a list of custom options matching REGEXP." + (let (found) + (mapatoms + (lambda (symbol) + (and + (or + ;; (user-variable-p symbol) + (get symbol 'standard-value) + ;; (get symbol 'saved-value) + (get symbol 'custom-type)) + (string-match regexp (symbol-name symbol)) + (not (member symbol cus-test-strange-variables)) + (push symbol found)))) + found)) + +(defun cus-test-errors-display () + "Report about the errors found by cus-test." + (with-output-to-temp-buffer "*cus-test-errors*" + (set-buffer standard-output) + (insert (format "Cus Test tested %s variables.\ + See `cus-test-tested-variables'.\n\n" + (length cus-test-tested-variables))) + (if cus-test-errors + (let ((L cus-test-errors)) + (insert "The following variables seem to have errors:\n\n") + (while L (insert (symbol-name (car L))) (insert "\n") + (setq L (cdr L)))) + (insert "No errors found by cus-test.")))) + +(defun cus-test-library (lib) + "Load library LIB and call `cus-test-apropos' on LIB." + (interactive "sTest variables in library: ") + (load-library lib) + (cus-test-apropos lib)) + +(defun cus-test-load-custom-loads nil + "Call `custom-load-symbol' on all atoms." + (interactive) + (mapatoms 'custom-load-symbol) + (run-hooks 'cus-test-after-load-libraries-hook)) + +(defun cus-test-load-libs () + "Load the libraries with autoloads in loaddefs.el. +Don't load libraries in `cus-test-strange-libs'. + +This function is useful to detect load problems of libraries." + (interactive) + (set-buffer (find-file-noselect (locate-library "loaddefs"))) + (goto-char (point-min)) + (let (file) + (while + (search-forward "\n;;; Generated autoloads from " nil t) + (goto-char (match-end 0)) + (setq file (buffer-substring (point) + (progn (end-of-line) (point)))) + ;; If it is, load that library. + (when file + (setq file (file-name-nondirectory file)) + (when (string-match "\\.el\\'" file) + (setq file (substring file 0 (match-beginning 0))))) + (condition-case alpha + (unless (member file cus-test-strange-libs) + (load-library file)) + (error (or + (y-or-n-p + (format "Load Error for %s: %s\nContinue Loading? " + file alpha)) + (error "Load Error for %s: %s" file alpha)))) + )) + (run-hooks 'cus-test-after-load-libraries-hook)) + +(defun cus-test-all nil + "Run a maximal test by cus-test. +This function is suitable for batch mode, e.g., invoke + +emacs -batch -l cus-test.el -f cus-test-all" + (interactive) + ;; This does not seem to increase the number of tested options. + ;; (message "Running %s" 'cus-test-load-libs) + ;; (cus-test-load-libs) + (message "Running %s" 'cus-test-load-custom-loads) + (cus-test-load-custom-loads) + ;; A second call increases the number of tested options. + (message "Running %s again" 'cus-test-load-custom-loads) + (cus-test-load-custom-loads) + (message "Running %s" 'cus-test-apropos) + (cus-test-apropos "") + (if cus-test-errors + (message "The following variables might have problems:\n%s" + cus-test-errors) + (message "No problems found by Cus Test"))) + +(provide 'cus-test) + +;;; cus-test.el ends here