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