Mercurial > emacs
comparison lisp/custom.el @ 17334:1effe507ea85
Initial revision
author | Per Abrahamsen <abraham@dina.kvl.dk> |
---|---|
date | Mon, 07 Apr 1997 13:42:59 +0000 |
parents | |
children | 7cba1521d0ca |
comparison
equal
deleted
inserted
replaced
17333:0cc83e8612f0 | 17334:1effe507ea85 |
---|---|
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 | |
7 ;; Version: 1.71 | |
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 | |
16 ;; `cus-edit.el'. | |
17 | |
18 ;; The code implementing face declarations is in `cus-face.el' | |
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) | |
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")) | |
41 | |
42 ;;; The `defcustom' Macro. | |
43 | |
44 (defun custom-declare-variable (symbol value doc &rest args) | |
45 "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." | |
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 | |
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. | |
329 | |
330 (provide 'custom) | |
331 | |
332 ;; custom.el ends here |