|
98
|
1 ;;; custom.el -- Tools for declaring and initializing options.
|
|
|
2 ;;
|
|
|
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
|
|
|
4 ;;
|
|
|
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
|
|
|
6 ;; Keywords: help, faces
|
|
116
|
7 ;; Version: 1.68
|
|
98
|
8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
|
|
|
9
|
|
|
10 ;;; Commentary:
|
|
|
11 ;;
|
|
|
12 ;; If you want to use this code, please visit the URL above.
|
|
|
13 ;;
|
|
|
14 ;; This file only contain the code needed to declare and initialize
|
|
|
15 ;; user options. The code to customize options is autoloaded from
|
|
106
|
16 ;; `cus-edit.el'.
|
|
|
17
|
|
|
18 ;; The code implementing face declarations is in `cus-face.el'
|
|
98
|
19
|
|
|
20 ;;; Code:
|
|
|
21
|
|
|
22 (require 'widget)
|
|
|
23
|
|
|
24 (define-widget-keywords :prefix :tag :load :link :options :type :group)
|
|
|
25
|
|
|
26 ;; These autoloads should be deleted when the file is added to Emacs
|
|
|
27
|
|
|
28 (unless (fboundp 'load-gc)
|
|
106
|
29 ;; From cus-edit.el
|
|
|
30 (autoload 'customize "cus-edit" nil t)
|
|
|
31 (autoload 'customize-variable "cus-edit" nil t)
|
|
|
32 (autoload 'customize-face "cus-edit" nil t)
|
|
|
33 (autoload 'customize-apropos "cus-edit" nil t)
|
|
|
34 (autoload 'customize-customized "cus-edit" nil t)
|
|
|
35 (autoload 'custom-buffer-create "cus-edit")
|
|
|
36 (autoload 'custom-menu-update "cus-edit")
|
|
|
37 (autoload 'custom-make-dependencies "cus-edit")
|
|
|
38 ;; From cus-face.el
|
|
|
39 (autoload 'custom-declare-face "cus-face")
|
|
|
40 (autoload 'custom-set-faces "cus-face"))
|
|
98
|
41
|
|
|
42 ;;; The `defcustom' Macro.
|
|
|
43
|
|
|
44 (defun custom-declare-variable (symbol value doc &rest args)
|
|
100
|
45 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments."
|
|
98
|
46 (unless (and (default-boundp symbol)
|
|
|
47 (not (get symbol 'saved-value)))
|
|
|
48 (set-default symbol (if (get symbol 'saved-value)
|
|
|
49 (eval (car (get symbol 'saved-value)))
|
|
|
50 (eval value))))
|
|
|
51 (put symbol 'factory-value (list value))
|
|
|
52 (when doc
|
|
|
53 (put symbol 'variable-documentation doc))
|
|
|
54 (while args
|
|
|
55 (let ((arg (car args)))
|
|
|
56 (setq args (cdr args))
|
|
|
57 (unless (symbolp arg)
|
|
|
58 (error "Junk in args %S" args))
|
|
|
59 (let ((keyword arg)
|
|
|
60 (value (car args)))
|
|
|
61 (unless args
|
|
|
62 (error "Keyword %s is missing an argument" keyword))
|
|
|
63 (setq args (cdr args))
|
|
|
64 (cond ((eq keyword :type)
|
|
|
65 (put symbol 'custom-type value))
|
|
|
66 ((eq keyword :options)
|
|
|
67 (if (get symbol 'custom-options)
|
|
|
68 ;; Slow safe code to avoid duplicates.
|
|
|
69 (mapcar (lambda (option)
|
|
|
70 (custom-add-option symbol option))
|
|
|
71 value)
|
|
|
72 ;; Fast code for the common case.
|
|
|
73 (put symbol 'custom-options (copy-list value))))
|
|
|
74 (t
|
|
|
75 (custom-handle-keyword symbol keyword value
|
|
|
76 'custom-variable))))))
|
|
|
77 (run-hooks 'custom-define-hook)
|
|
|
78 symbol)
|
|
|
79
|
|
|
80 (defmacro defcustom (symbol value doc &rest args)
|
|
|
81 "Declare SYMBOL as a customizable variable that defaults to VALUE.
|
|
|
82 DOC is the variable documentation.
|
|
|
83
|
|
|
84 Neither SYMBOL nor VALUE needs to be quoted.
|
|
|
85 If SYMBOL is not already bound, initialize it to VALUE.
|
|
|
86 The remaining arguments should have the form
|
|
|
87
|
|
|
88 [KEYWORD VALUE]...
|
|
|
89
|
|
|
90 The following KEYWORD's are defined:
|
|
|
91
|
|
|
92 :type VALUE should be a widget type.
|
|
|
93 :options VALUE should be a list of valid members of the widget type.
|
|
|
94 :group VALUE should be a customization group.
|
|
|
95 Add SYMBOL to that group.
|
|
|
96
|
|
|
97 Read the section about customization in the emacs lisp manual for more
|
|
|
98 information."
|
|
|
99 `(eval-and-compile
|
|
|
100 (custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)))
|
|
|
101
|
|
|
102 ;;; The `defface' Macro.
|
|
|
103
|
|
|
104 (defmacro defface (face spec doc &rest args)
|
|
|
105 "Declare FACE as a customizable face that defaults to SPEC.
|
|
|
106 FACE does not need to be quoted.
|
|
|
107
|
|
|
108 Third argument DOC is the face documentation.
|
|
|
109
|
|
|
110 If FACE has been set with `custom-set-face', set the face attributes
|
|
|
111 as specified by that function, otherwise set the face attributes
|
|
|
112 according to SPEC.
|
|
|
113
|
|
|
114 The remaining arguments should have the form
|
|
|
115
|
|
|
116 [KEYWORD VALUE]...
|
|
|
117
|
|
|
118 The following KEYWORD's are defined:
|
|
|
119
|
|
|
120 :group VALUE should be a customization group.
|
|
|
121 Add FACE to that group.
|
|
|
122
|
|
|
123 SPEC should be an alist of the form ((DISPLAY ATTS)...).
|
|
|
124
|
|
|
125 ATTS is a list of face attributes and their values. The possible
|
|
|
126 attributes are defined in the variable `custom-face-attributes'.
|
|
|
127 Alternatively, ATTS can be a face in which case the attributes of that
|
|
|
128 face is used.
|
|
|
129
|
|
|
130 The ATTS of the first entry in SPEC where the DISPLAY matches the
|
|
|
131 frame should take effect in that frame. DISPLAY can either be the
|
|
|
132 symbol `t', which will match all frames, or an alist of the form
|
|
|
133 \((REQ ITEM...)...)
|
|
|
134
|
|
|
135 For the DISPLAY to match a FRAME, the REQ property of the frame must
|
|
|
136 match one of the ITEM. The following REQ are defined:
|
|
|
137
|
|
|
138 `type' (the value of (window-system))
|
|
|
139 Should be one of `x' or `tty'.
|
|
|
140
|
|
|
141 `class' (the frame's color support)
|
|
|
142 Should be one of `color', `grayscale', or `mono'.
|
|
|
143
|
|
|
144 `background' (what color is used for the background text)
|
|
|
145 Should be one of `light' or `dark'.
|
|
|
146
|
|
|
147 Read the section about customization in the emacs lisp manual for more
|
|
|
148 information."
|
|
|
149 `(custom-declare-face (quote ,face) ,spec ,doc ,@args))
|
|
|
150
|
|
|
151 ;;; The `defgroup' Macro.
|
|
|
152
|
|
|
153 (defun custom-declare-group (symbol members doc &rest args)
|
|
|
154 "Like `defgroup', but SYMBOL is evaluated as a normal argument."
|
|
|
155 (put symbol 'custom-group (nconc members (get symbol 'custom-group)))
|
|
|
156 (when doc
|
|
|
157 (put symbol 'group-documentation doc))
|
|
|
158 (while args
|
|
|
159 (let ((arg (car args)))
|
|
|
160 (setq args (cdr args))
|
|
|
161 (unless (symbolp arg)
|
|
|
162 (error "Junk in args %S" args))
|
|
|
163 (let ((keyword arg)
|
|
|
164 (value (car args)))
|
|
|
165 (unless args
|
|
|
166 (error "Keyword %s is missing an argument" keyword))
|
|
|
167 (setq args (cdr args))
|
|
|
168 (cond ((eq keyword :prefix)
|
|
|
169 (put symbol 'custom-prefix value))
|
|
|
170 (t
|
|
|
171 (custom-handle-keyword symbol keyword value
|
|
|
172 'custom-group))))))
|
|
|
173 (run-hooks 'custom-define-hook)
|
|
|
174 symbol)
|
|
|
175
|
|
|
176 (defmacro defgroup (symbol members doc &rest args)
|
|
|
177 "Declare SYMBOL as a customization group containing MEMBERS.
|
|
|
178 SYMBOL does not need to be quoted.
|
|
|
179
|
|
|
180 Third arg DOC is the group documentation.
|
|
|
181
|
|
|
182 MEMBERS should be an alist of the form ((NAME WIDGET)...) where
|
|
|
183 NAME is a symbol and WIDGET is a widget is a widget for editing that
|
|
|
184 symbol. Useful widgets are `custom-variable' for editing variables,
|
|
|
185 `custom-face' for edit faces, and `custom-group' for editing groups.
|
|
|
186
|
|
|
187 The remaining arguments should have the form
|
|
|
188
|
|
|
189 [KEYWORD VALUE]...
|
|
|
190
|
|
|
191 The following KEYWORD's are defined:
|
|
|
192
|
|
|
193 :group VALUE should be a customization group.
|
|
|
194 Add SYMBOL to that group.
|
|
|
195
|
|
|
196 Read the section about customization in the emacs lisp manual for more
|
|
|
197 information."
|
|
|
198 `(custom-declare-group (quote ,symbol) ,members ,doc ,@args))
|
|
|
199
|
|
|
200 (defun custom-add-to-group (group option widget)
|
|
|
201 "To existing GROUP add a new OPTION of type WIDGET,
|
|
|
202 If there already is an entry for that option, overwrite it."
|
|
|
203 (let* ((members (get group 'custom-group))
|
|
|
204 (old (assq option members)))
|
|
|
205 (if old
|
|
|
206 (setcar (cdr old) widget)
|
|
|
207 (put group 'custom-group (nconc members (list (list option widget)))))))
|
|
|
208
|
|
|
209 ;;; Properties.
|
|
|
210
|
|
|
211 (defun custom-handle-all-keywords (symbol args type)
|
|
|
212 "For customization option SYMBOL, handle keyword arguments ARGS.
|
|
|
213 Third argument TYPE is the custom option type."
|
|
|
214 (while args
|
|
|
215 (let ((arg (car args)))
|
|
|
216 (setq args (cdr args))
|
|
|
217 (unless (symbolp arg)
|
|
|
218 (error "Junk in args %S" args))
|
|
|
219 (let ((keyword arg)
|
|
|
220 (value (car args)))
|
|
|
221 (unless args
|
|
|
222 (error "Keyword %s is missing an argument" keyword))
|
|
|
223 (setq args (cdr args))
|
|
|
224 (custom-handle-keyword symbol keyword value type)))))
|
|
|
225
|
|
|
226 (defun custom-handle-keyword (symbol keyword value type)
|
|
|
227 "For customization option SYMBOL, handle KEYWORD with VALUE.
|
|
|
228 Fourth argument TYPE is the custom option type."
|
|
|
229 (cond ((eq keyword :group)
|
|
|
230 (custom-add-to-group value symbol type))
|
|
|
231 ((eq keyword :link)
|
|
|
232 (custom-add-link symbol value))
|
|
|
233 ((eq keyword :load)
|
|
|
234 (custom-add-load symbol value))
|
|
|
235 ((eq keyword :tag)
|
|
|
236 (put symbol 'custom-tag value))
|
|
|
237 (t
|
|
|
238 (error "Unknown keyword %s" symbol))))
|
|
|
239
|
|
|
240 (defun custom-add-option (symbol option)
|
|
|
241 "To the variable SYMBOL add OPTION.
|
|
|
242
|
|
|
243 If SYMBOL is a hook variable, OPTION should be a hook member.
|
|
|
244 For other types variables, the effect is undefined."
|
|
|
245 (let ((options (get symbol 'custom-options)))
|
|
|
246 (unless (member option options)
|
|
|
247 (put symbol 'custom-options (cons option options)))))
|
|
|
248
|
|
|
249 (defun custom-add-link (symbol widget)
|
|
|
250 "To the custom option SYMBOL add the link WIDGET."
|
|
|
251 (let ((links (get symbol 'custom-links)))
|
|
|
252 (unless (member widget links)
|
|
|
253 (put symbol 'custom-links (cons widget links)))))
|
|
|
254
|
|
|
255 (defun custom-add-load (symbol load)
|
|
|
256 "To the custom option SYMBOL add the dependency LOAD.
|
|
|
257 LOAD should be either a library file name, or a feature name."
|
|
|
258 (let ((loads (get symbol 'custom-loads)))
|
|
|
259 (unless (member load loads)
|
|
|
260 (put symbol 'custom-loads (cons load loads)))))
|
|
|
261
|
|
|
262 ;;; Initializing.
|
|
|
263
|
|
|
264 (defun custom-set-variables (&rest args)
|
|
|
265 "Initialize variables according to user preferences.
|
|
|
266
|
|
|
267 The arguments should be a list where each entry has the form:
|
|
|
268
|
|
|
269 (SYMBOL VALUE [NOW])
|
|
|
270
|
|
|
271 The unevaluated VALUE is stored as the saved value for SYMBOL.
|
|
|
272 If NOW is present and non-nil, VALUE is also evaluated and bound as
|
|
|
273 the default value for the SYMBOL."
|
|
|
274 (while args
|
|
|
275 (let ((entry (car args)))
|
|
|
276 (if (listp entry)
|
|
|
277 (let ((symbol (nth 0 entry))
|
|
|
278 (value (nth 1 entry))
|
|
|
279 (now (nth 2 entry)))
|
|
|
280 (put symbol 'saved-value (list value))
|
|
|
281 (when now
|
|
|
282 (put symbol 'force-value t)
|
|
|
283 (set-default symbol (eval value)))
|
|
|
284 (setq args (cdr args)))
|
|
|
285 ;; Old format, a plist of SYMBOL VALUE pairs.
|
|
|
286 (let ((symbol (nth 0 args))
|
|
|
287 (value (nth 1 args)))
|
|
|
288 (put symbol 'saved-value (list value)))
|
|
|
289 (setq args (cdr (cdr args)))))))
|
|
|
290
|
|
|
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
|
|
112
|
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])
|
|
98
|
311 "Customize menu")
|
|
|
312
|
|
106
|
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)
|
|
108
|
318 (add-submenu '("Options") custom-help-menu))
|
|
106
|
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))))))
|
|
98
|
323
|
|
112
|
324 (if (string-match "XEmacs" emacs-version)
|
|
|
325 (autoload 'custom-menu-create "cus-edit")
|
|
108
|
326 (custom-menu-reset))
|
|
|
327
|
|
98
|
328 ;;; The End.
|
|
|
329
|
|
|
330 (provide 'custom)
|
|
|
331
|
|
|
332 ;; custom.el ends here
|
