Mercurial > hg > xemacs-beta

comparison lisp/custom/custom.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents 859a2309aef8
children 4103f0995bd7
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;;; custom.el -- Tools for declaring and initializing options. 1 ;;; custom.el -- Tools for declaring and initializing options.
2 ;; 2 ;;
3 ;; Copyright (C) 1996 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.30 7 ;; Version: 1.40
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
25 (unless (fboundp 'load-gc) 26 (unless (fboundp 'load-gc)
26 (autoload 'customize "custom-edit" nil t) 27 (autoload 'customize "custom-edit" nil t)
27 (autoload 'customize-variable "custom-edit" nil t) 28 (autoload 'customize-variable "custom-edit" nil t)
28 (autoload 'customize-face "custom-edit" nil t) 29 (autoload 'customize-face "custom-edit" nil t)
29 (autoload 'customize-apropos "custom-edit" nil t) 30 (autoload 'customize-apropos "custom-edit" nil t)
91 (t 92 (t
92 (defalias 'custom-facep 'facep))) 93 (defalias 'custom-facep 'facep)))
93 94
94 ;;; The `defcustom' Macro. 95 ;;; The `defcustom' Macro.
95 96
96 ;;; Don't ;;;###autoload
97 (defun custom-declare-variable (symbol value doc &rest args) 97 (defun custom-declare-variable (symbol value doc &rest args)
98 "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments." 98 "Like `defcustom', but SYMBOL and VALUE are evaluated as notmal arguments."
99 (unless (and (default-boundp symbol) 99 (unless (and (default-boundp symbol)
100 (not (get symbol 'saved-value))) 100 (not (get symbol 'saved-value)))
101 (set-default symbol (if (get symbol 'saved-value) 101 (set-default symbol (if (get symbol 'saved-value)
128 (custom-handle-keyword symbol keyword value 128 (custom-handle-keyword symbol keyword value
129 'custom-variable)))))) 129 'custom-variable))))))
130 (run-hooks 'custom-define-hook) 130 (run-hooks 'custom-define-hook)
131 symbol) 131 symbol)
132 132
133 ;;; Don't ;;;###autoload
134 (defmacro defcustom (symbol value doc &rest args) 133 (defmacro defcustom (symbol value doc &rest args)
135 "Declare SYMBOL as a customizable variable that defaults to VALUE. 134 "Declare SYMBOL as a customizable variable that defaults to VALUE.
136 DOC is the variable documentation. 135 DOC is the variable documentation.
137 136
138 Neither SYMBOL nor VALUE needs to be quoted. 137 Neither SYMBOL nor VALUE needs to be quoted.
153 `(eval-and-compile 152 `(eval-and-compile
154 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args))) 153 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)))
155 154
156 ;;; The `defface' Macro. 155 ;;; The `defface' Macro.
157 156
158 ;;; Don't ;;;###autoload
159 (defun custom-declare-face (face spec doc &rest args) 157 (defun custom-declare-face (face spec doc &rest args)
160 "Like `defface', but FACE is evaluated as a normal argument." 158 "Like `defface', but FACE is evaluated as a normal argument."
161 (put face 'factory-face spec) 159 (put face 'factory-face spec)
162 (when (fboundp 'facep) 160 (when (fboundp 'facep)
163 (unless (and (custom-facep face) 161 (unless (and (custom-facep face)
169 (put face 'face-documentation doc)) 167 (put face 'face-documentation doc))
170 (custom-handle-all-keywords face args 'custom-face) 168 (custom-handle-all-keywords face args 'custom-face)
171 (run-hooks 'custom-define-hook) 169 (run-hooks 'custom-define-hook)
172 face) 170 face)
173 171
174 ;;; Don't ;;;###autoload
175 (defmacro defface (face spec doc &rest args) 172 (defmacro defface (face spec doc &rest args)
176 "Declare FACE as a customizable face that defaults to SPEC. 173 "Declare FACE as a customizable face that defaults to SPEC.
177 FACE does not need to be quoted. 174 FACE does not need to be quoted.
178 175
179 Third argument DOC is the face documentation. 176 Third argument DOC is the face documentation.
219 information." 216 information."
220 `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) 217 `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
221 218
222 ;;; The `defgroup' Macro. 219 ;;; The `defgroup' Macro.
223 220
224 ;;; Don't ;;;###autoload
225 (defun custom-declare-group (symbol members doc &rest args) 221 (defun custom-declare-group (symbol members doc &rest args)
226 "Like `defgroup', but SYMBOL is evaluated as a normal argument." 222 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
227 (put symbol 'custom-group (nconc members (get symbol 'custom-group))) 223 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
228 (when doc 224 (when doc
229 (put symbol 'group-documentation doc)) 225 (put symbol 'group-documentation doc))
243 (custom-handle-keyword symbol keyword value 239 (custom-handle-keyword symbol keyword value
244 'custom-group)))))) 240 'custom-group))))))
245 (run-hooks 'custom-define-hook) 241 (run-hooks 'custom-define-hook)
246 symbol) 242 symbol)
247 243
248 ;;; Don't ;;;###autoload
249 (defmacro defgroup (symbol members doc &rest args) 244 (defmacro defgroup (symbol members doc &rest args)
250 "Declare SYMBOL as a customization group containing MEMBERS. 245 "Declare SYMBOL as a customization group containing MEMBERS.
251 SYMBOL does not need to be quoted. 246 SYMBOL does not need to be quoted.
252 247
253 Third arg DOC is the group documentation. 248 Third arg DOC is the group documentation.
268 263
269 Read the section about customization in the emacs lisp manual for more 264 Read the section about customization in the emacs lisp manual for more
270 information." 265 information."
271 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) 266 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
272 267
273 ;;; Don't ;;;###autoload
274 (defun custom-add-to-group (group option widget) 268 (defun custom-add-to-group (group option widget)
275 "To existing GROUP add a new OPTION of type WIDGET, 269 "To existing GROUP add a new OPTION of type WIDGET,
276 If there already is an entry for that option, overwrite it." 270 If there already is an entry for that option, overwrite it."
277 (let* ((members (get group 'custom-group)) 271 (let* ((members (get group 'custom-group))
278 (old (assq option members))) 272 (old (assq option members)))
466 "Set the italic property of FACE to VALUE." 460 "Set the italic property of FACE to VALUE."
467 (if value 461 (if value
468 (make-face-italic face frame) 462 (make-face-italic face frame)
469 (make-face-unitalic face frame))) 463 (make-face-unitalic face frame)))
470 464
471 ;;; Don't ;;;###autoload
472 (defun custom-initialize-faces (&optional frame) 465 (defun custom-initialize-faces (&optional frame)
473 "Initialize all custom faces for FRAME. 466 "Initialize all custom faces for FRAME.
474 If FRAME is nil or omitted, initialize them for all frames." 467 If FRAME is nil or omitted, initialize them for all frames."
475 (mapatoms (lambda (symbol) 468 (mapatoms (lambda (symbol)
476 (let ((spec (or (get symbol 'saved-face) 469 (let ((spec (or (get symbol 'saved-face)
478 (when spec 471 (when spec
479 (custom-face-display-set symbol spec frame)))))) 472 (custom-face-display-set symbol spec frame))))))
480 473
481 ;;; Initializing. 474 ;;; Initializing.
482 475
483 ;;; Don't ;;;###autoload
484 (defun custom-set-variables (&rest args) 476 (defun custom-set-variables (&rest args)
485 "Initialize variables according to user preferences. 477 "Initialize variables according to user preferences.
486 478
487 The arguments should be a list where each entry has the form: 479 The arguments should be a list where each entry has the form:
488 480
506 (let ((symbol (nth 0 args)) 498 (let ((symbol (nth 0 args))
507 (value (nth 1 args))) 499 (value (nth 1 args)))
508 (put symbol 'saved-value (list value))) 500 (put symbol 'saved-value (list value)))
509 (setq args (cdr (cdr args))))))) 501 (setq args (cdr (cdr args)))))))
510 502
511 ;;; Don't ;;;###autoload
512 (defun custom-set-faces (&rest args) 503 (defun custom-set-faces (&rest args)
513 "Initialize faces according to user preferences. 504 "Initialize faces according to user preferences.
514 The arguments should be a list where each entry has the form: 505 The arguments should be a list where each entry has the form:
515 506
516 (FACE SPEC [NOW]) 507 (FACE SPEC [NOW])