Mercurial > hg > xemacs-beta

comparison lisp/custom/custom.el @ 195:a2f645c6b9f8 r20-3b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b24
author cvs
date Mon, 13 Aug 2007 09:59:05 +0200
parents f53b5ca2e663
children
comparison
equal deleted inserted replaced
194:2947057885e5 195:a2f645c6b9f8
1 ;;; custom.el -- Tools for declaring and initializing options. 1 ;;; custom.el -- Tools for declaring and initializing options.
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 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
6 ;; Keywords: help, faces 7 ;; Keywords: help, faces
7 ;; Version: 1.9960 8 ;; Version: 1.9960-x
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ 9 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
9 10
10 ;; This file is part of GNU Emacs. 11 ;; This file is part of XEmacs.
11 12
12 ;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;; XEmacs 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 ;; 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 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; any later version. 16 ;; any later version.
16 17
17 ;; GNU Emacs is distributed in the hope that it will be useful, 18 ;; XEmacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details. 21 ;; GNU General Public License for more details.
21 22
22 ;; You should have received a copy of the GNU General Public License 23 ;; 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 ;; along with XEmacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA. 26 ;; Boston, MA 02111-1307, USA.
26 27
27 ;;; Commentary: 28 ;;; Commentary:
28 ;; 29 ;;
31 ;; This file only contain the code needed to declare and initialize 32 ;; This file only contain the code needed to declare and initialize
32 ;; user options. The code to customize options is autoloaded from 33 ;; user options. The code to customize options is autoloaded from
33 ;; `cus-edit.el'. 34 ;; `cus-edit.el'.
34 ;; 35 ;;
35 ;; The code implementing face declarations is in `cus-face.el' 36 ;; The code implementing face declarations is in `cus-face.el'
36 ;;
37 ;; IMPORTANT: This version of custom is for Emacs 19.34 and XEmacs
38 ;; 19.15 - 20.2 only. If you use Emacs 20.1, XEmacs 20.3, or anything
39 ;; newer, please use the version of custom bundled with your emacs.
40 ;; If you use an older emacs, please upgrade.
41 37
42 ;;; Code: 38 ;;; Code:
43 39
44 (require 'widget) 40 (require 'widget)
45
46 (define-widget-keywords :initialize :set :get :require :prefix :tag
47 :load :link :options :type :group)
48
49 ;; These autoloads should be deleted eventually.
50 (unless (fboundp 'load-gc)
51 ;; From cus-edit.el
52 (autoload 'customize-set-value "cus-edit" nil t)
53 (autoload 'customize-set-variable "cus-edit" nil t)
54 (autoload 'customize "cus-edit" nil t)
55 (autoload 'customize-browse "cus-edit" nil t)
56 (autoload 'customize-group "cus-edit" nil t)
57 (autoload 'customize-group-other-window "cus-edit" nil t)
58 (autoload 'customize-variable "cus-edit" nil t)
59 (autoload 'customize-variable-other-window "cus-edit" nil t)
60 (autoload 'customize-face "cus-edit" nil t)
61 (autoload 'customize-face-other-window "cus-edit" nil t)
62 (autoload 'customize-apropos "cus-edit" nil t)
63 (autoload 'customize-customized "cus-edit" nil t)
64 (autoload 'customize-saved "cus-edit" nil t)
65 (autoload 'custom-buffer-create "cus-edit")
66 (autoload 'custom-make-dependencies "cus-edit")
67 (autoload 'custom-menu-create "cus-edit")
68 (autoload 'customize-menu-create "cus-edit")
69
70 ;; From cus-face.el
71 (autoload 'custom-declare-face "cus-face")
72 (autoload 'custom-set-faces "cus-face"))
73 41
74 (defvar custom-define-hook nil 42 (defvar custom-define-hook nil
75 ;; Customize information for this option is in `cus-edit.el'. 43 ;; Customize information for this option is in `cus-edit.el'.
76 "Hook called after defining each customize option.") 44 "Hook called after defining each customize option.")
77 45
164 ((eq keyword :type) 132 ((eq keyword :type)
165 (put symbol 'custom-type value)) 133 (put symbol 'custom-type value))
166 ((eq keyword :options) 134 ((eq keyword :options)
167 (if (get symbol 'custom-options) 135 (if (get symbol 'custom-options)
168 ;; Slow safe code to avoid duplicates. 136 ;; Slow safe code to avoid duplicates.
169 (mapcar (lambda (option) 137 (mapc (lambda (option)
170 (custom-add-option symbol option)) 138 (custom-add-option symbol option))
171 value) 139 value)
172 ;; Fast code for the common case. 140 ;; Fast code for the common case.
173 (put symbol 'custom-options (copy-sequence value)))) 141 (put symbol 'custom-options (copy-sequence value))))
174 (t 142 (t
175 (custom-handle-keyword symbol keyword value 143 (custom-handle-keyword symbol keyword value
176 'custom-variable)))))) 144 'custom-variable))))))
267 235
268 (defun custom-declare-group (symbol members doc &rest args) 236 (defun custom-declare-group (symbol members doc &rest args)
269 "Like `defgroup', but SYMBOL is evaluated as a normal argument." 237 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
270 (while members 238 (while members
271 (apply 'custom-add-to-group symbol (car members)) 239 (apply 'custom-add-to-group symbol (car members))
272 (setq members (cdr members))) 240 (pop members))
273 (put symbol 'custom-group (nconc members (get symbol 'custom-group))) 241 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
274 (when doc 242 (when doc
275 (put symbol 'group-documentation doc)) 243 (put symbol 'group-documentation doc))
276 (while args 244 (while args
277 (let ((arg (car args))) 245 (let ((arg (car args)))
278 (setq args (cdr args)) 246 (setq args (cdr args))
279 (unless (symbolp arg) 247 (unless (symbolp arg)
280 (error "Junk in args %S" args)) 248 (error "Junk in args %S" args))
281 (let ((keyword arg) 249 (let ((keyword arg)
313 281
314 Read the section about customization in the Emacs Lisp manual for more 282 Read the section about customization in the Emacs Lisp manual for more
315 information." 283 information."
316 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) 284 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
317 285
286 ;; This is preloaded very early, so we avoid using CL features.
287 (defvar custom-group-hash-table (make-hashtable 300 'eq)
288 "Hash-table of non-empty groups.")
289
318 (defun custom-add-to-group (group option widget) 290 (defun custom-add-to-group (group option widget)
319 "To existing GROUP add a new OPTION of type WIDGET. 291 "To existing GROUP add a new OPTION of type WIDGET.
320 If there already is an entry for that option, overwrite it." 292 If there already is an entry for that option, overwrite it."
321 (let* ((members (get group 'custom-group)) 293 (let* ((members (get group 'custom-group))
322 (old (assq option members))) 294 (old (assq option members)))
323 (if old 295 (if old
324 (setcar (cdr old) widget) 296 (setcar (cdr old) widget)
325 (put group 'custom-group (nconc members (list (list option widget))))))) 297 (put group 'custom-group (nconc members (list (list option widget))))))
298 (puthash group t custom-group-hash-table))
326 299
327 ;;; Properties. 300 ;;; Properties.
328 301
329 (defun custom-handle-all-keywords (symbol args type) 302 (defun custom-handle-all-keywords (symbol args type)
330 "For customization option SYMBOL, handle keyword arguments ARGS. 303 "For customization option SYMBOL, handle keyword arguments ARGS.
405 ((default-boundp symbol) 378 ((default-boundp symbol)
406 ;; Something already set this, overwrite it. 379 ;; Something already set this, overwrite it.
407 (funcall set symbol (eval value)))) 380 (funcall set symbol (eval value))))
408 (when requests 381 (when requests
409 (put symbol 'custom-requests requests) 382 (put symbol 'custom-requests requests)
410 (mapcar 'require requests)) 383 (mapc 'require requests))
411 (setq args (cdr args))) 384 (setq args (cdr args)))
412 ;; Old format, a plist of SYMBOL VALUE pairs. 385 ;; Old format, a plist of SYMBOL VALUE pairs.
413 (message "Warning: old format `custom-set-variables'") 386 (message "Warning: old format `custom-set-variables'")
414 (ding) 387 (ding)
415 (sit-for 2) 388 (sit-for 2)