admin/cus-test.el

   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.  E.g., invoke
  67 ;;
  68 ;;   src/emacs -batch -l admin/cus-test.el -f cus-test-all
  69 ;;
  70 ;; in the emacs source directory.
  71 ;;
  72 ;; To make cus-test work one has usually to work-around some existing
  73 ;; bugs/problems.  Therefore this file contains a "Workaround"
  74 ;; section, to be edited once in a while.
  75 ;;
  76 ;; Options with a custom-get property, usually defined by a :get
  77 ;; declaration, are stored in the variable
  78 ;;
  79 ;; `cus-test-vars-with-custom-get'
  80 ;;
  81 ;; Options with a state of 'changed ("changed outside the customize
  82 ;; buffer") are stored in the variable
  83 ;;
  84 ;; `cus-test-vars-with-changed-state'
  85 ;;
  86 ;; These lists are prepared just in case one wants to investigate
  87 ;; those options further.
  88 ;;
  89 ;; Current result (Oct 6, 2002) of cus-test-all:
  90 ;;
  91 ;; Cus Test tested 4514 variables.
  92 ;; The following variables might have problems:
  93 ;; (ps-mule-font-info-database-default)
  94
  95 ;;; Code:
  96
  97 ;;; User variables:
  98
  99 (defvar cus-test-strange-vars nil
 100   "*List of variables to disregard by `cus-test-apropos'.")
 101
 102 (defvar cus-test-strange-libs nil
 103   "*List of libraries to avoid by `cus-test-load-libs'.")
 104
 105 (defvar cus-test-after-load-libs-hook nil
 106   "*Hook to repair the worst side effects of loading buggy libraries.
 107 It is run after `cus-test-load-custom-loads' and `cus-test-load-libs'")
 108
 109 ;;; Workarounds:
 110
 111 ;; The file eudc-export.el loads libraries "bbdb" and "bbdb-com" which
 112 ;; are not part of GNU Emacs.
 113 (provide 'bbdb)
 114 (provide 'bbdb-com)
 115 ;; (locate-library "bbdb")
 116
 117 ;; reftex must be loaded before reftex-vars.
 118 (load "reftex")
 119
 120 ;; eshell must be loaded before em-script.  eshell loads esh-util,
 121 ;; which must be loaded before em-cmpl, em-dirs and similar libraries.
 122 (load "eshell")
 123
 124 ;; Loading dunnet in batch mode leads to a dead end.
 125 (when noninteractive
 126   (let (noninteractive) (load "dunnet"))
 127   (add-to-list 'cus-test-strange-libs "dunnet"))
 128
 129 ;; Loading filesets.el currently disables mini-buffer echoes.
 130 ;; (add-to-list 'cus-test-strange-libs "filesets")
 131 (add-hook
 132  'cus-test-after-load-libs-hook
 133  (lambda nil
 134    (remove-hook 'menu-bar-update-hook 'filesets-build-menu-maybe)
 135    (remove-hook 'kill-emacs-hook 'filesets-exit)
 136    (remove-hook 'kill-buffer-hook 'filesets-remove-from-ubl)
 137    (remove-hook 'first-change-hook 'filesets-reset-filename-on-change)
 138    ))
 139 ;; (setq cus-test-after-load-libs-hook nil)
 140
 141 ;;; Silencing:
 142
 143 ;; Don't create a file filesets-menu-cache-file.
 144 (setq filesets-menu-cache-file "")
 145
 146 ;; Don't create a file save-place-file.
 147 (eval-after-load "saveplace"
 148   '(remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
 149
 150 ;; Don't create a file abbrev-file-name.
 151 (setq save-abbrevs nil)
 152
 153 ;; Avoid compile logs from adviced functions.
 154 (eval-after-load "bytecomp"
 155   '(setq ad-default-compilation-action 'never))
 156
 157 ;; We want to log all messages.
 158 (setq message-log-max t)
 159
 160 \f
 161 ;;; Main Code:
 162
 163 (defvar cus-test-tested-variables nil
 164   "Options tested by last call of `cus-test-apropos'.")
 165
 166 (defvar cus-test-errors nil
 167   "List of problematic variables found by `cus-test-apropos'.")
 168
 169 ;; I haven't understood this :get stuff.  However, there are only very
 170 ;; few variables with a custom-get property.  Such symbols are stored
 171 ;; in `cus-test-vars-with-custom-get'.
 172 (defvar cus-test-vars-with-custom-get nil
 173   "Set by `cus-test-apropos' to a list of options with :get property.")
 174
 175 (defvar cus-test-vars-with-changed-state nil
 176   "Set by `cus-test-apropos' to a list of options with state 'changed.")
 177
 178 (require 'cus-edit)
 179 (require 'cus-load)
 180
 181 (defun cus-test-apropos (regexp)
 182   "Check the options matching REGEXP.
 183 The detected problematic options are stored in `cus-test-errors'."
 184   (interactive "sVariable regexp: ")
 185   (setq cus-test-errors nil)
 186   (setq cus-test-tested-variables nil)
 187   (mapcar
 188    (lambda (symbol)
 189      (push symbol cus-test-tested-variables)
 190      (unless noninteractive
 191        (message "Cus Test Running...[%s]"
 192                 (length cus-test-tested-variables)))
 193      (condition-case alpha
 194          (let* ((type (custom-variable-type symbol))
 195                 (conv (widget-convert type))
 196                 ;; I haven't understood this :get stuff.
 197                 (get (or (get symbol 'custom-get) 'default-value))
 198                 values
 199                 mismatch)
 200            (when (default-boundp symbol)
 201              (add-to-list 'values
 202                           (funcall get symbol))
 203              (add-to-list 'values
 204                           (eval (car (get symbol 'standard-value)))))
 205            (if (boundp symbol)
 206                (add-to-list 'values (symbol-value symbol)))
 207            ;; That does not work.
 208            ;; (add-to-list 'values (widget-get conv :value))
 209
 210            ;; Check the values
 211            (mapcar (lambda (value)
 212                      (unless (widget-apply conv :match value)
 213                        (setq mismatch 'mismatch)))
 214                    values)
 215
 216            ;; Changed outside the customize buffer?
 217            ;; This routine is not very much tested.
 218            (let ((c-value
 219                   (or (get symbol 'customized-value)
 220                       (get symbol 'saved-value)
 221                       (get symbol 'standard-value))))
 222              (and (consp c-value)
 223                   (boundp symbol)
 224                   (not (equal (eval (car c-value)) (symbol-value symbol)))
 225                   (add-to-list 'cus-test-vars-with-changed-state symbol)))
 226
 227            ;; Store symbols with a custom-get property.
 228            (when (get symbol 'custom-get)
 229              (add-to-list 'cus-test-vars-with-custom-get symbol)
 230              ;; No need anymore to ignore them.
 231              ;; (setq mismatch nil)
 232              )
 233
 234            (if mismatch
 235                (add-to-list 'cus-test-errors symbol)))
 236
 237        (error
 238         (add-to-list 'cus-test-errors symbol)
 239         (if (y-or-n-p
 240              (format "Error for %s: %s\nContinue? "
 241                      symbol alpha))
 242             (message "Error for %s: %s" symbol alpha)
 243           (error "Error for %s: %s" symbol alpha)))))
 244    (cus-test-get-options regexp))
 245   (message "Cus Test tested %s variables."
 246            (length cus-test-tested-variables))
 247   ;; (describe-variable 'cus-test-errors)
 248   (cus-test-errors-display)
 249   )
 250
 251 (defun cus-test-get-options (regexp)
 252   "Return a list of custom options matching REGEXP."
 253   (let (found)
 254     (mapatoms
 255      (lambda (symbol)
 256        (and
 257         (or
 258          ;; (user-variable-p symbol)
 259          (get symbol 'standard-value)
 260          ;; (get symbol 'saved-value)
 261          (get symbol 'custom-type))
 262         (string-match regexp (symbol-name symbol))
 263         (not (member symbol cus-test-strange-vars))
 264         (push symbol found))))
 265     found))
 266
 267 (defun cus-test-errors-display ()
 268   "Report about the errors found by cus-test."
 269   (with-output-to-temp-buffer "*cus-test-errors*"
 270     (set-buffer standard-output)
 271     (insert (format "Cus Test tested %s variables.\
 272   See `cus-test-tested-variables'.\n\n"
 273                     (length cus-test-tested-variables)))
 274     (if cus-test-errors
 275         (let ((L cus-test-errors))
 276           (insert "The following variables seem to have errors:\n\n")
 277           (while L (insert (symbol-name (car L))) (insert "\n")
 278                  (setq L (cdr L))))
 279       (insert "No errors found by cus-test."))))
 280
 281 (defun cus-test-library (lib)
 282   "Load library LIB and call `cus-test-apropos' on LIB."
 283   (interactive "sTest variables in library: ")
 284   (load-library lib)
 285   (cus-test-apropos lib))
 286
 287 (defun cus-test-load-custom-loads nil
 288   "Call `custom-load-symbol' on all atoms."
 289   (interactive)
 290   (mapatoms 'custom-load-symbol)
 291   (run-hooks 'cus-test-after-load-libs-hook))
 292
 293 (defun cus-test-load-libs ()
 294   "Load the libraries with autoloads in loaddefs.el.
 295 Don't load libraries in `cus-test-strange-libs'.
 296
 297 This function is useful to detect load problems of libraries."
 298   (interactive)
 299   (set-buffer (find-file-noselect (locate-library "loaddefs")))
 300   (goto-char (point-min))
 301   (let (file)
 302     (while
 303         (search-forward "\n;;; Generated autoloads from " nil t)
 304       (goto-char (match-end 0))
 305       (setq file (buffer-substring (point)
 306                                    (progn (end-of-line) (point))))
 307       ;; If it is, load that library.
 308       (when file
 309         (setq file (file-name-nondirectory file))
 310         (when (string-match "\\.el\\'" file)
 311           (setq file (substring file 0 (match-beginning 0)))))
 312       (condition-case alpha
 313           (unless (member file cus-test-strange-libs)
 314             (load-library file))
 315         (error (or
 316                 (y-or-n-p
 317                  (format "Load Error for %s: %s\nContinue Loading? "
 318                          file alpha))
 319                 (error "Load Error for %s: %s" file alpha))))
 320       ))
 321   (run-hooks 'cus-test-after-load-libs-hook))
 322
 323 (defun cus-test-all nil
 324   "Run a maximal test by cus-test.
 325 This function is suitable for batch mode.  E.g., invoke
 326
 327   src/emacs -batch -l admin/cus-test.el -f cus-test-all
 328
 329 in the emacs source directory."
 330   (interactive)
 331   ;; This does not seem to increase the number of tested options.
 332   ;;  (message "Running %s" 'cus-test-load-libs)
 333   ;;  (cus-test-load-libs)
 334   (message "Running %s" 'cus-test-load-custom-loads)
 335   (cus-test-load-custom-loads)
 336   ;; If the second call loads libraries, this indicates that there
 337   ;; were load errors in the first run.
 338   (message "Running %s again" 'cus-test-load-custom-loads)
 339   (cus-test-load-custom-loads)
 340   (message "Running %s" 'cus-test-apropos)
 341   (cus-test-apropos "")
 342   (if cus-test-errors
 343       (message "The following variables might have problems:\n%s"
 344                cus-test-errors)
 345     (message "No problems found by Cus Test")))
 346
 347 (provide 'cus-test)
 348
 349 ;;; cus-test.el ends here