Mercurial > hg > xemacs-beta

comparison lisp/custom/custom.el @ 120:cca96a509cfe r20-1b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b12
author cvs
date Mon, 13 Aug 2007 09:25:29 +0200
parents 7d55a9ba150c
children 9b50b4588a93
comparison
equal deleted inserted replaced
119:d101af7320b8 120:cca96a509cfe
2 ;; 2 ;;
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
4 ;; 4 ;;
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> 5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
6 ;; Keywords: help, faces 6 ;; Keywords: help, faces
7 ;; Version: 1.69 7 ;; Version: 1.74
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 9
10 ;;; Commentary: 10 ;;; Commentary:
11 ;; 11 ;;
12 ;; If you want to use this code, please visit the URL above. 12 ;; If you want to use this code, please visit the URL above.
20 ;;; Code: 20 ;;; Code:
21 21
22 (require 'widget) 22 (require 'widget)
23 23
24 (define-widget-keywords :prefix :tag :load :link :options :type :group) 24 (define-widget-keywords :prefix :tag :load :link :options :type :group)
25
26 (defvar custom-define-hook nil
27 "Hook called after defining each customize option.")
25 28
26 ;; These autoloads should be deleted when the file is added to Emacs 29 ;; These autoloads should be deleted when the file is added to Emacs
27 30
28 (unless (fboundp 'load-gc) 31 (unless (fboundp 'load-gc)
29 ;; From cus-edit.el 32 ;; From cus-edit.el
31 (autoload 'customize-variable "cus-edit" nil t) 34 (autoload 'customize-variable "cus-edit" nil t)
32 (autoload 'customize-face "cus-edit" nil t) 35 (autoload 'customize-face "cus-edit" nil t)
33 (autoload 'customize-apropos "cus-edit" nil t) 36 (autoload 'customize-apropos "cus-edit" nil t)
34 (autoload 'customize-customized "cus-edit" nil t) 37 (autoload 'customize-customized "cus-edit" nil t)
35 (autoload 'custom-buffer-create "cus-edit") 38 (autoload 'custom-buffer-create "cus-edit")
36 (autoload 'custom-menu-update "cus-edit")
37 (autoload 'custom-make-dependencies "cus-edit") 39 (autoload 'custom-make-dependencies "cus-edit")
38 ;; From cus-face.el 40 ;; From cus-face.el
39 (autoload 'custom-declare-face "cus-face") 41 (autoload 'custom-declare-face "cus-face")
40 (autoload 'custom-set-faces "cus-face")) 42 (autoload 'custom-set-faces "cus-face"))
41 43
42 ;;; The `defcustom' Macro. 44 ;;; The `defcustom' Macro.
43 45
44 (defun custom-declare-variable (symbol value doc &rest args) 46 (defun custom-declare-variable (symbol value doc &rest args)
45 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." 47 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
46 (unless (and (default-boundp symbol) 48 ;; Bind this variable unless it already is bound.
47 (not (get symbol 'saved-value))) 49 (unless (default-boundp symbol)
50 ;; Use the saved value if it exists, otherwise the factory setting.
48 (set-default symbol (if (get symbol 'saved-value) 51 (set-default symbol (if (get symbol 'saved-value)
49 (eval (car (get symbol 'saved-value))) 52 (eval (car (get symbol 'saved-value)))
50 (eval value)))) 53 (eval value))))
54 ;; Remember the factory setting.
51 (put symbol 'factory-value (list value)) 55 (put symbol 'factory-value (list value))
56 ;; Maybe this option was rogue in an earlier version. It no longer is.
57 (when (get symbol 'force-value)
58 ;; It no longer is.
59 (put symbol 'force-value nil))
52 (when doc 60 (when doc
53 (put symbol 'variable-documentation doc)) 61 (put symbol 'variable-documentation doc))
54 (while args 62 (while args
55 (let ((arg (car args))) 63 (let ((arg (car args)))
56 (setq args (cdr args)) 64 (setq args (cdr args))
276 (if (listp entry) 284 (if (listp entry)
277 (let ((symbol (nth 0 entry)) 285 (let ((symbol (nth 0 entry))
278 (value (nth 1 entry)) 286 (value (nth 1 entry))
279 (now (nth 2 entry))) 287 (now (nth 2 entry)))
280 (put symbol 'saved-value (list value)) 288 (put symbol 'saved-value (list value))
281 (when now 289 (cond (now
282 (put symbol 'force-value t) 290 ;; Rogue variable, set it now.
283 (set-default symbol (eval value))) 291 (put symbol 'force-value t)
292 (set-default symbol (eval value)))
293 ((default-boundp symbol)
294 ;; Something already set this, overwrite it.
295 (set-default symbol (eval value))))
284 (setq args (cdr args))) 296 (setq args (cdr args)))
285 ;; Old format, a plist of SYMBOL VALUE pairs. 297 ;; Old format, a plist of SYMBOL VALUE pairs.
286 (let ((symbol (nth 0 args)) 298 (let ((symbol (nth 0 args))
287 (value (nth 1 args))) 299 (value (nth 1 args)))
288 (put symbol 'saved-value (list value))) 300 (put symbol 'saved-value (list value)))
289 (setq args (cdr (cdr args))))))) 301 (setq args (cdr (cdr args)))))))
290 302
291 ;;; Meta Customization
292
293 (defcustom custom-define-hook nil
294 "Hook called after defining each customize option."
295 :group 'customize
296 :type 'hook)
297
298 ;;; Menu support
299
300 (defconst custom-help-menu
301 `("Customize"
302 ,(if (string-match "XEmacs" emacs-version)
303 '("Emacs" :filter (lambda (&rest junk)
304 (cdr (custom-menu-create 'emacs))))
305 ["Update menu..." custom-menu-update t])
306 ["Group..." customize t]
307 ["Variable..." customize-variable t]
308 ["Face..." customize-face t]
309 ["Saved..." customize-customized t]
310 ["Apropos..." customize-apropos t])
311 "Customize menu")
312
313 (defun custom-menu-reset ()
314 "Reset customize menu."
315 (remove-hook 'custom-define-hook 'custom-menu-reset)
316 (if (string-match "XEmacs" emacs-version)
317 (when (fboundp 'add-submenu)
318 (add-submenu '("Options") custom-help-menu))
319 (define-key global-map [menu-bar help-menu customize-menu]
320 (cons (car custom-help-menu)
321 (easy-menu-create-keymaps (car custom-help-menu)
322 (cdr custom-help-menu))))))
323
324 (if (string-match "XEmacs" emacs-version)
325 (autoload 'custom-menu-create "cus-edit")
326 (custom-menu-reset))
327
328 ;;; The End. 303 ;;; The End.
329 304
330 (provide 'custom) 305 (provide 'custom)
331 306
332 ;; custom.el ends here 307 ;; custom.el ends here