Mercurial > hg > xemacs-beta

comparison lisp/custom/custom.el @ 20:859a2309aef8 r19-15b93

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents d95e72db5c07
children 8fc7fe29b841
comparison
equal deleted inserted replaced
19:ac1f612d5250 20:859a2309aef8
2 ;; 2 ;;
3 ;; Copyright (C) 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1996 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.24 7 ;; Version: 1.30
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 (require 'widget) 20 (require 'widget)
21 21
22 (define-widget-keywords :prefix :tag :load :link :options :type :group) 22 (define-widget-keywords :prefix :tag :load :link :options :type :group)
23 23
24 ;; These autoloads should be deleted when the file is added to Emacs 24 ;; These autoloads should be deleted when the file is added to Emacs
25 (autoload 'customize "custom-edit" nil t) 25 (unless (fboundp 'load-gc)
26 (autoload 'customize-variable "custom-edit" nil t) 26 (autoload 'customize "custom-edit" nil t)
27 (autoload 'customize-face "custom-edit" nil t) 27 (autoload 'customize-variable "custom-edit" nil t)
28 (autoload 'customize-apropos "custom-edit" nil t) 28 (autoload 'customize-face "custom-edit" nil t)
29 (autoload 'customize-customized "custom-edit" nil t) 29 (autoload 'customize-apropos "custom-edit" nil t)
30 (autoload 'custom-buffer-create "custom-edit") 30 (autoload 'customize-customized "custom-edit" nil t)
31 (autoload 'custom-menu-update "custom-edit") 31 (autoload 'custom-buffer-create "custom-edit")
32 (autoload 'custom-make-dependencies "custom-edit") 32 (autoload 'custom-menu-update "custom-edit")
33 (autoload 'custom-make-dependencies "custom-edit"))
33 34
34 ;;; Compatibility. 35 ;;; Compatibility.
35 36
36 (unless (fboundp 'x-color-values) 37 (unless (fboundp 'x-color-values)
37 ;; Emacs function missing in XEmacs 19.14. 38 ;; Emacs function missing in XEmacs 19.14.
90 (t 91 (t
91 (defalias 'custom-facep 'facep))) 92 (defalias 'custom-facep 'facep)))
92 93
93 ;;; The `defcustom' Macro. 94 ;;; The `defcustom' Macro.
94 95
95 ;;;###autoload 96 ;;; Don't ;;;###autoload
96 (defun custom-declare-variable (symbol value doc &rest args) 97 (defun custom-declare-variable (symbol value doc &rest args)
97 "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments." 98 "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
98 (unless (and (default-boundp symbol) 99 (unless (and (default-boundp symbol)
99 (not (get symbol 'saved-value))) 100 (not (get symbol 'saved-value)))
100 (set-default symbol (if (get symbol 'saved-value) 101 (set-default symbol (if (get symbol 'saved-value)
127 (custom-handle-keyword symbol keyword value 128 (custom-handle-keyword symbol keyword value
128 'custom-variable)))))) 129 'custom-variable))))))
129 (run-hooks 'custom-define-hook) 130 (run-hooks 'custom-define-hook)
130 symbol) 131 symbol)
131 132
132 ;;;###autoload 133 ;;; Don't ;;;###autoload
133 (defmacro defcustom (symbol value doc &rest args) 134 (defmacro defcustom (symbol value doc &rest args)
134 "Declare SYMBOL as a customizable variable that defaults to VALUE. 135 "Declare SYMBOL as a customizable variable that defaults to VALUE.
135 DOC is the variable documentation. 136 DOC is the variable documentation.
136 137
137 Neither SYMBOL nor VALUE needs to be quoted. 138 Neither SYMBOL nor VALUE needs to be quoted.
152 `(eval-and-compile 153 `(eval-and-compile
153 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))) 154 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)))
154 155
155 ;;; The `defface' Macro. 156 ;;; The `defface' Macro.
156 157
157 ;;;###autoload 158 ;;; Don't ;;;###autoload
158 (defun custom-declare-face (face spec doc &rest args) 159 (defun custom-declare-face (face spec doc &rest args)
159 "Like `defface', but FACE is evaluated as a normal argument." 160 "Like `defface', but FACE is evaluated as a normal argument."
160 (put face 'factory-face spec) 161 (put face 'factory-face spec)
161 (when (fboundp 'facep) 162 (when (fboundp 'facep)
162 (unless (and (custom-facep face) 163 (unless (and (custom-facep face)
168 (put face 'face-documentation doc)) 169 (put face 'face-documentation doc))
169 (custom-handle-all-keywords face args 'custom-face) 170 (custom-handle-all-keywords face args 'custom-face)
170 (run-hooks 'custom-define-hook) 171 (run-hooks 'custom-define-hook)
171 face) 172 face)
172 173
173 ;;;###autoload 174 ;;; Don't ;;;###autoload
174 (defmacro defface (face spec doc &rest args) 175 (defmacro defface (face spec doc &rest args)
175 "Declare FACE as a customizable face that defaults to SPEC. 176 "Declare FACE as a customizable face that defaults to SPEC.
176 FACE does not need to be quoted. 177 FACE does not need to be quoted.
177 178
178 Third argument DOC is the face documentation. 179 Third argument DOC is the face documentation.
218 information." 219 information."
219 `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) 220 `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
220 221
221 ;;; The `defgroup' Macro. 222 ;;; The `defgroup' Macro.
222 223
223 ;;;###autoload 224 ;;; Don't ;;;###autoload
224 (defun custom-declare-group (symbol members doc &rest args) 225 (defun custom-declare-group (symbol members doc &rest args)
225 "Like `defgroup', but SYMBOL is evaluated as a normal argument." 226 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
226 (put symbol 'custom-group (nconc members (get symbol 'custom-group))) 227 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
227 (when doc 228 (when doc
228 (put symbol 'group-documentation doc)) 229 (put symbol 'group-documentation doc))
242 (custom-handle-keyword symbol keyword value 243 (custom-handle-keyword symbol keyword value
243 'custom-group)))))) 244 'custom-group))))))
244 (run-hooks 'custom-define-hook) 245 (run-hooks 'custom-define-hook)
245 symbol) 246 symbol)
246 247
247 ;;;###autoload 248 ;;; Don't ;;;###autoload
248 (defmacro defgroup (symbol members doc &rest args) 249 (defmacro defgroup (symbol members doc &rest args)
249 "Declare SYMBOL as a customization group containing MEMBERS. 250 "Declare SYMBOL as a customization group containing MEMBERS.
250 SYMBOL does not need to be quoted. 251 SYMBOL does not need to be quoted.
251 252
252 Third arg DOC is the group documentation. 253 Third arg DOC is the group documentation.
267 268
268 Read the section about customization in the emacs lisp manual for more 269 Read the section about customization in the emacs lisp manual for more
269 information." 270 information."
270 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) 271 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
271 272
272 ;;;###autoload 273 ;;; Don't ;;;###autoload
273 (defun custom-add-to-group (group option widget) 274 (defun custom-add-to-group (group option widget)
274 "To existing GROUP add a new OPTION of type WIDGET, 275 "To existing GROUP add a new OPTION of type WIDGET,
275 If there already is an entry for that option, overwrite it." 276 If there already is an entry for that option, overwrite it."
276 (let* ((members (get group 'custom-group)) 277 (let* ((members (get group 'custom-group))
277 (old (assq option members))) 278 (old (assq option members)))
394 (t 395 (t
395 (error "Unknown req `%S' with options `%S'" req options))))) 396 (error "Unknown req `%S' with options `%S'" req options)))))
396 match))) 397 match)))
397 398
398 (defconst custom-face-attributes 399 (defconst custom-face-attributes
399 '((:bold (toggle :format "Bold: %v") custom-set-face-bold) 400 '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold)
400 (:italic (toggle :format "Italic: %v") custom-set-face-italic) 401 (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic)
401 (:underline 402 (:underline
402 (toggle :format "Underline: %v") set-face-underline-p) 403 (toggle :format "Underline: %[%v%]\n") set-face-underline-p)
403 (:foreground (color :tag "Foreground") set-face-foreground) 404 (:foreground (color :tag "Foreground") set-face-foreground)
404 (:background (color :tag "Background") set-face-background) 405 (:background (color :tag "Background") set-face-background)
405 (:stipple (editable-field :format "Stipple: %v") set-face-stipple)) 406 (:stipple (editable-field :format "Stipple: %v") set-face-stipple))
406 "Alist of face attributes. 407 "Alist of face attributes.
407 408
465 "Set the italic property of FACE to VALUE." 466 "Set the italic property of FACE to VALUE."
466 (if value 467 (if value
467 (make-face-italic face frame) 468 (make-face-italic face frame)
468 (make-face-unitalic face frame))) 469 (make-face-unitalic face frame)))
469 470
470 ;;;###autoload 471 ;;; Don't ;;;###autoload
471 (defun custom-initialize-faces (&optional frame) 472 (defun custom-initialize-faces (&optional frame)
472 "Initialize all custom faces for FRAME. 473 "Initialize all custom faces for FRAME.
473 If FRAME is nil or omitted, initialize them for all frames." 474 If FRAME is nil or omitted, initialize them for all frames."
474 (mapatoms (lambda (symbol) 475 (mapatoms (lambda (symbol)
475 (let ((spec (or (get symbol 'saved-face) 476 (let ((spec (or (get symbol 'saved-face)
477 (when spec 478 (when spec
478 (custom-face-display-set symbol spec frame)))))) 479 (custom-face-display-set symbol spec frame))))))
479 480
480 ;;; Initializing. 481 ;;; Initializing.
481 482
482 ;;;###autoload 483 ;;; Don't ;;;###autoload
483 (defun custom-set-variables (&rest args) 484 (defun custom-set-variables (&rest args)
484 "Initialize variables according to user preferences. 485 "Initialize variables according to user preferences.
485 486
486 The arguments should be a list where each entry has the form: 487 The arguments should be a list where each entry has the form:
487 488
505 (let ((symbol (nth 0 args)) 506 (let ((symbol (nth 0 args))
506 (value (nth 1 args))) 507 (value (nth 1 args)))
507 (put symbol 'saved-value (list value))) 508 (put symbol 'saved-value (list value)))
508 (setq args (cdr (cdr args))))))) 509 (setq args (cdr (cdr args)))))))
509 510
510 ;;;###autoload 511 ;;; Don't ;;;###autoload
511 (defun custom-set-faces (&rest args) 512 (defun custom-set-faces (&rest args)
512 "Initialize faces according to user preferences. 513 "Initialize faces according to user preferences.
513 The arguments should be a list where each entry has the form: 514 The arguments should be a list where each entry has the form:
514 515
515 (FACE SPEC [NOW]) 516 (FACE SPEC [NOW])
579 (define-key global-map [menu-bar help-menu customize-menu] 580 (define-key global-map [menu-bar help-menu customize-menu]
580 (cons (car custom-help-menu) 581 (cons (car custom-help-menu)
581 (easy-menu-create-keymaps (car custom-help-menu) 582 (easy-menu-create-keymaps (car custom-help-menu)
582 (cdr custom-help-menu))))))) 583 (cdr custom-help-menu)))))))
583 584
584 ; (custom-menu-reset) 585 (unless (fboundp 'load-gc)
586 (custom-menu-reset))
585 587
586 ;;; The End. 588 ;;; The End.
587 589
588 (provide 'custom) 590 (provide 'custom)
589 591