Mercurial > emacs
annotate lisp/cus-edit.el @ 18032:fd3f0a7e79b9
(custom-face-display-set): Define if not defined.
(custom-buffer-create-internal): Refer to the Emacs manual.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 29 May 1997 23:27:40 +0000 |
parents | ebc3066cd381 |
children | bccd356a3b7c |
rev | line source |
---|---|
17334 | 1 ;;; cus-edit.el --- Tools for customization Emacs. |
2 ;; | |
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. | |
4 ;; | |
5 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | |
6 ;; Keywords: help, faces | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
7 ;; Version: 1.97 |
17334 | 8 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ |
9 | |
17521
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
10 ;; This file is part of GNU Emacs. |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
11 |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
13 ;; it under the terms of the GNU General Public License as published by |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option) |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
15 ;; any later version. |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
16 |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
20 ;; GNU General Public License for more details. |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
21 |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
22 ;; You should have received a copy of the GNU General Public License |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
25 ;; Boston, MA 02111-1307, USA. |
ddce9ecc6f6a
(custom-face-set): Don't copy an empty face,
Richard M. Stallman <rms@gnu.org>
parents:
17415
diff
changeset
|
26 |
17334 | 27 ;;; Commentary: |
28 ;; | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
29 ;; This file implements the code to create and edit customize buffers. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
30 ;; |
17334 | 31 ;; See `custom.el'. |
32 | |
33 ;;; Code: | |
34 | |
35 (require 'cus-face) | |
36 (require 'wid-edit) | |
37 (require 'easymenu) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
38 (eval-when-compile (require 'cl)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
39 |
18032
fd3f0a7e79b9
(custom-face-display-set): Define if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
17800
diff
changeset
|
40 (or (fboundp 'custom-face-display-set) |
fd3f0a7e79b9
(custom-face-display-set): Define if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
17800
diff
changeset
|
41 (defalias 'custom-face-display-set 'face-spec-set)) |
fd3f0a7e79b9
(custom-face-display-set): Define if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
17800
diff
changeset
|
42 |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
43 (condition-case nil |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
44 (require 'cus-load) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
45 (error nil)) |
17334 | 46 |
47 (define-widget-keywords :custom-prefixes :custom-menu :custom-show | |
48 :custom-magic :custom-state :custom-level :custom-form | |
49 :custom-set :custom-save :custom-reset-current :custom-reset-saved | |
50 :custom-reset-factory) | |
51 | |
17415 | 52 (put 'custom-define-hook 'custom-type 'hook) |
53 (put 'custom-define-hook 'factory-value '(nil)) | |
54 (custom-add-to-group 'customize 'custom-define-hook 'custom-variable) | |
55 | |
17334 | 56 ;;; Customization Groups. |
57 | |
58 (defgroup emacs nil | |
59 "Customization of the One True Editor." | |
60 :link '(custom-manual "(emacs)Top")) | |
61 | |
62 ;; Most of these groups are stolen from `finder.el', | |
63 (defgroup editing nil | |
64 "Basic text editing facilities." | |
65 :group 'emacs) | |
66 | |
67 (defgroup abbrev nil | |
68 "Abbreviation handling, typing shortcuts, macros." | |
69 :tag "Abbreviations" | |
70 :group 'editing) | |
71 | |
72 (defgroup matching nil | |
73 "Various sorts of searching and matching." | |
74 :group 'editing) | |
75 | |
76 (defgroup emulations nil | |
77 "Emulations of other editors." | |
78 :group 'editing) | |
79 | |
80 (defgroup mouse nil | |
81 "Mouse support." | |
82 :group 'editing) | |
83 | |
84 (defgroup outlines nil | |
85 "Support for hierarchical outlining." | |
86 :group 'editing) | |
87 | |
88 (defgroup external nil | |
89 "Interfacing to external utilities." | |
90 :group 'emacs) | |
91 | |
92 (defgroup bib nil | |
93 "Code related to the `bib' bibliography processor." | |
94 :tag "Bibliography" | |
95 :group 'external) | |
96 | |
97 (defgroup processes nil | |
98 "Process, subshell, compilation, and job control support." | |
99 :group 'external | |
100 :group 'development) | |
101 | |
102 (defgroup programming nil | |
103 "Support for programming in other languages." | |
104 :group 'emacs) | |
105 | |
106 (defgroup languages nil | |
107 "Specialized modes for editing programming languages." | |
108 :group 'programming) | |
109 | |
110 (defgroup lisp nil | |
111 "Lisp support, including Emacs Lisp." | |
112 :group 'languages | |
113 :group 'development) | |
114 | |
115 (defgroup c nil | |
116 "Support for the C language and related languages." | |
117 :group 'languages) | |
118 | |
119 (defgroup tools nil | |
120 "Programming tools." | |
121 :group 'programming) | |
122 | |
123 (defgroup oop nil | |
124 "Support for object-oriented programming." | |
125 :group 'programming) | |
126 | |
127 (defgroup applications nil | |
128 "Applications written in Emacs." | |
129 :group 'emacs) | |
130 | |
131 (defgroup calendar nil | |
132 "Calendar and time management support." | |
133 :group 'applications) | |
134 | |
135 (defgroup mail nil | |
136 "Modes for electronic-mail handling." | |
137 :group 'applications) | |
138 | |
139 (defgroup news nil | |
140 "Support for netnews reading and posting." | |
141 :group 'applications) | |
142 | |
143 (defgroup games nil | |
144 "Games, jokes and amusements." | |
145 :group 'applications) | |
146 | |
147 (defgroup development nil | |
148 "Support for further development of Emacs." | |
149 :group 'emacs) | |
150 | |
151 (defgroup docs nil | |
152 "Support for Emacs documentation." | |
153 :group 'development) | |
154 | |
155 (defgroup extensions nil | |
156 "Emacs Lisp language extensions." | |
157 :group 'development) | |
158 | |
159 (defgroup internal nil | |
160 "Code for Emacs internals, build process, defaults." | |
161 :group 'development) | |
162 | |
163 (defgroup maint nil | |
164 "Maintenance aids for the Emacs development group." | |
165 :tag "Maintenance" | |
166 :group 'development) | |
167 | |
168 (defgroup environment nil | |
169 "Fitting Emacs with its environment." | |
170 :group 'emacs) | |
171 | |
172 (defgroup comm nil | |
173 "Communications, networking, remote access to files." | |
174 :tag "Communication" | |
175 :group 'environment) | |
176 | |
177 (defgroup hardware nil | |
178 "Support for interfacing with exotic hardware." | |
179 :group 'environment) | |
180 | |
181 (defgroup terminals nil | |
182 "Support for terminal types." | |
183 :group 'environment) | |
184 | |
185 (defgroup unix nil | |
186 "Front-ends/assistants for, or emulators of, UNIX features." | |
187 :group 'environment) | |
188 | |
189 (defgroup vms nil | |
190 "Support code for vms." | |
191 :group 'environment) | |
192 | |
193 (defgroup i18n nil | |
194 "Internationalization and alternate character-set support." | |
195 :group 'environment | |
196 :group 'editing) | |
197 | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
198 (defgroup x nil |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
199 "The X Window system." |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
200 :group 'environment) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
201 |
17334 | 202 (defgroup frames nil |
203 "Support for Emacs frames and window systems." | |
204 :group 'environment) | |
205 | |
206 (defgroup data nil | |
207 "Support editing files of data." | |
208 :group 'emacs) | |
209 | |
210 (defgroup wp nil | |
211 "Word processing." | |
212 :group 'emacs) | |
213 | |
214 (defgroup tex nil | |
215 "Code related to the TeX formatter." | |
216 :group 'wp) | |
217 | |
218 (defgroup faces nil | |
219 "Support for multiple fonts." | |
220 :group 'emacs) | |
221 | |
222 (defgroup hypermedia nil | |
223 "Support for links between text or other media types." | |
224 :group 'emacs) | |
225 | |
226 (defgroup help nil | |
227 "Support for on-line help systems." | |
228 :group 'emacs) | |
229 | |
230 (defgroup local nil | |
231 "Code local to your site." | |
232 :group 'emacs) | |
233 | |
234 (defgroup customize '((widgets custom-group)) | |
235 "Customization of the Customization support." | |
236 :link '(custom-manual "(custom)Top") | |
237 :link '(url-link :tag "Development Page" | |
238 "http://www.dina.kvl.dk/~abraham/custom/") | |
239 :prefix "custom-" | |
17415 | 240 :group 'help) |
241 | |
242 (defgroup custom-faces nil | |
243 "Faces used by customize." | |
244 :group 'customize | |
17334 | 245 :group 'faces) |
246 | |
17415 | 247 (defgroup abbrev-mode nil |
248 "Word abbreviations mode." | |
249 :group 'abbrev) | |
250 | |
251 (defgroup alloc nil | |
252 "Storage allocation and gc for GNU Emacs Lisp interpreter." | |
253 :tag "Storage Allocation" | |
254 :group 'internal) | |
255 | |
256 (defgroup undo nil | |
257 "Undoing changes in buffers." | |
258 :group 'editing) | |
259 | |
260 (defgroup modeline nil | |
261 "Content of the modeline." | |
262 :group 'environment) | |
263 | |
264 (defgroup fill nil | |
265 "Indenting and filling text." | |
266 :group 'editing) | |
267 | |
268 (defgroup editing-basics nil | |
269 "Most basic editing facilities." | |
270 :group 'editing) | |
271 | |
272 (defgroup display nil | |
273 "How characters are displayed in buffers." | |
274 :group 'environment) | |
275 | |
276 (defgroup execute nil | |
277 "Executing external commands." | |
278 :group 'processes) | |
279 | |
280 (defgroup installation nil | |
281 "The Emacs installation." | |
282 :group 'environment) | |
283 | |
284 (defgroup dired nil | |
285 "Directory editing." | |
286 :group 'environment) | |
287 | |
288 (defgroup limits nil | |
289 "Internal Emacs limits." | |
290 :group 'internal) | |
291 | |
292 (defgroup debug nil | |
293 "Debugging Emacs itself." | |
294 :group 'development) | |
295 | |
296 (defgroup minibuffer nil | |
297 "Controling the behaviour of the minibuffer." | |
298 :group 'environment) | |
299 | |
300 (defgroup keyboard nil | |
301 "Input from the keyboard." | |
302 :group 'environment) | |
303 | |
304 (defgroup mouse nil | |
305 "Input from the mouse." | |
306 :group 'environment) | |
307 | |
308 (defgroup menu nil | |
309 "Input from the menus." | |
310 :group 'environment) | |
311 | |
312 (defgroup auto-save nil | |
313 "Preventing accidential loss of data." | |
314 :group 'data) | |
315 | |
316 (defgroup processes-basics nil | |
317 "Basic stuff dealing with processes." | |
318 :group 'processes) | |
319 | |
320 (defgroup windows nil | |
321 "Windows within a frame." | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
322 :group 'environment) |
17415 | 323 |
17334 | 324 ;;; Utilities. |
325 | |
326 (defun custom-quote (sexp) | |
327 "Quote SEXP iff it is not self quoting." | |
328 (if (or (memq sexp '(t nil)) | |
329 (and (symbolp sexp) | |
330 (eq (aref (symbol-name sexp) 0) ?:)) | |
331 (and (listp sexp) | |
332 (memq (car sexp) '(lambda))) | |
333 (stringp sexp) | |
334 (numberp sexp) | |
335 (and (fboundp 'characterp) | |
336 (characterp sexp))) | |
337 sexp | |
338 (list 'quote sexp))) | |
339 | |
340 (defun custom-split-regexp-maybe (regexp) | |
341 "If REGEXP is a string, split it to a list at `\\|'. | |
342 You can get the original back with from the result with: | |
343 (mapconcat 'identity result \"\\|\") | |
344 | |
345 IF REGEXP is not a string, return it unchanged." | |
346 (if (stringp regexp) | |
347 (let ((start 0) | |
348 all) | |
349 (while (string-match "\\\\|" regexp start) | |
350 (setq all (cons (substring regexp start (match-beginning 0)) all) | |
351 start (match-end 0))) | |
352 (nreverse (cons (substring regexp start) all))) | |
353 regexp)) | |
354 | |
17415 | 355 (defun custom-variable-prompt () |
356 ;; Code stolen from `help.el'. | |
357 "Prompt for a variable, defaulting to the variable at point. | |
358 Return a list suitable for use in `interactive'." | |
359 (let ((v (variable-at-point)) | |
360 (enable-recursive-minibuffers t) | |
361 val) | |
362 (setq val (completing-read | |
363 (if v | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
364 (format "Customize variable: (default %s) " v) |
17415 | 365 "Customize variable: ") |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
366 obarray (lambda (symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
367 (and (boundp symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
368 (or (get symbol 'custom-type) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
369 (user-variable-p symbol)))))) |
17415 | 370 (list (if (equal val "") |
371 v (intern val))))) | |
372 | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
373 (defun custom-menu-filter (menu widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
374 "Convert MENU to the form used by `widget-choose'. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
375 MENU should be in the same format as `custom-variable-menu'. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
376 WIDGET is the widget to apply the filter entries of MENU on." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
377 (let ((result nil) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
378 current name action filter) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
379 (while menu |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
380 (setq current (car menu) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
381 name (nth 0 current) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
382 action (nth 1 current) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
383 filter (nth 2 current) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
384 menu (cdr menu)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
385 (if (or (null filter) (funcall filter widget)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
386 (push (cons name action) result) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
387 (push name result))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
388 (nreverse result))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
389 |
17415 | 390 ;;; Unlispify. |
391 | |
17334 | 392 (defvar custom-prefix-list nil |
393 "List of prefixes that should be ignored by `custom-unlispify'") | |
394 | |
395 (defcustom custom-unlispify-menu-entries t | |
396 "Display menu entries as words instead of symbols if non nil." | |
397 :group 'customize | |
398 :type 'boolean) | |
399 | |
400 (defun custom-unlispify-menu-entry (symbol &optional no-suffix) | |
401 "Convert symbol into a menu entry." | |
402 (cond ((not custom-unlispify-menu-entries) | |
403 (symbol-name symbol)) | |
404 ((get symbol 'custom-tag) | |
405 (if no-suffix | |
406 (get symbol 'custom-tag) | |
407 (concat (get symbol 'custom-tag) "..."))) | |
408 (t | |
409 (save-excursion | |
410 (set-buffer (get-buffer-create " *Custom-Work*")) | |
411 (erase-buffer) | |
412 (princ symbol (current-buffer)) | |
413 (goto-char (point-min)) | |
17415 | 414 (when (and (eq (get symbol 'custom-type) 'boolean) |
415 (re-search-forward "-p\\'" nil t)) | |
416 (replace-match "" t t) | |
417 (goto-char (point-min))) | |
17334 | 418 (let ((prefixes custom-prefix-list) |
419 prefix) | |
420 (while prefixes | |
421 (setq prefix (car prefixes)) | |
422 (if (search-forward prefix (+ (point) (length prefix)) t) | |
423 (progn | |
424 (setq prefixes nil) | |
425 (delete-region (point-min) (point))) | |
426 (setq prefixes (cdr prefixes))))) | |
427 (subst-char-in-region (point-min) (point-max) ?- ?\ t) | |
428 (capitalize-region (point-min) (point-max)) | |
429 (unless no-suffix | |
430 (goto-char (point-max)) | |
431 (insert "...")) | |
432 (buffer-string))))) | |
433 | |
434 (defcustom custom-unlispify-tag-names t | |
435 "Display tag names as words instead of symbols if non nil." | |
436 :group 'customize | |
437 :type 'boolean) | |
438 | |
439 (defun custom-unlispify-tag-name (symbol) | |
440 "Convert symbol into a menu entry." | |
441 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names)) | |
442 (custom-unlispify-menu-entry symbol t))) | |
443 | |
444 (defun custom-prefix-add (symbol prefixes) | |
445 ;; Addd SYMBOL to list of ignored PREFIXES. | |
446 (cons (or (get symbol 'custom-prefix) | |
447 (concat (symbol-name symbol) "-")) | |
448 prefixes)) | |
449 | |
17415 | 450 ;;; Guess. |
451 | |
452 (defcustom custom-guess-name-alist | |
453 '(("-p\\'" boolean) | |
454 ("-hook\\'" hook) | |
455 ("-face\\'" face) | |
456 ("-file\\'" file) | |
457 ("-function\\'" function) | |
458 ("-functions\\'" (repeat function)) | |
459 ("-list\\'" (repeat sexp)) | |
460 ("-alist\\'" (repeat (cons sexp sexp)))) | |
461 "Alist of (MATCH TYPE). | |
462 | |
463 MATCH should be a regexp matching the name of a symbol, and TYPE should | |
464 be a widget suitable for editing the value of that symbol. The TYPE | |
465 of the first entry where MATCH matches the name of the symbol will be | |
466 used. | |
467 | |
468 This is used for guessing the type of variables not declared with | |
469 customize." | |
470 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type"))) | |
471 :group 'customize) | |
472 | |
473 (defcustom custom-guess-doc-alist | |
474 '(("\\`\\*?Non-nil " boolean)) | |
475 "Alist of (MATCH TYPE). | |
476 | |
477 MATCH should be a regexp matching a documentation string, and TYPE | |
478 should be a widget suitable for editing the value of a variable with | |
479 that documentation string. The TYPE of the first entry where MATCH | |
480 matches the name of the symbol will be used. | |
481 | |
482 This is used for guessing the type of variables not declared with | |
483 customize." | |
484 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type"))) | |
485 :group 'customize) | |
486 | |
487 (defun custom-guess-type (symbol) | |
488 "Guess a widget suitable for editing the value of SYMBOL. | |
489 This is done by matching SYMBOL with `custom-guess-name-alist' and | |
490 if that fails, the doc string with `custom-guess-doc-alist'." | |
491 (let ((name (symbol-name symbol)) | |
492 (names custom-guess-name-alist) | |
493 current found) | |
494 (while names | |
495 (setq current (car names) | |
496 names (cdr names)) | |
497 (when (string-match (nth 0 current) name) | |
498 (setq found (nth 1 current) | |
499 names nil))) | |
500 (unless found | |
501 (let ((doc (documentation-property symbol 'variable-documentation)) | |
502 (docs custom-guess-doc-alist)) | |
503 (when doc | |
504 (while docs | |
505 (setq current (car docs) | |
506 docs (cdr docs)) | |
507 (when (string-match (nth 0 current) doc) | |
508 (setq found (nth 1 current) | |
509 docs nil)))))) | |
510 found)) | |
511 | |
512 ;;; Custom Mode Commands. | |
17334 | 513 |
514 (defvar custom-options nil | |
515 "Customization widgets in the current buffer.") | |
516 | |
517 (defun custom-set () | |
518 "Set changes in all modified options." | |
519 (interactive) | |
520 (let ((children custom-options)) | |
521 (mapcar (lambda (child) | |
522 (when (eq (widget-get child :custom-state) 'modified) | |
523 (widget-apply child :custom-set))) | |
524 children))) | |
525 | |
526 (defun custom-save () | |
527 "Set all modified group members and save them." | |
528 (interactive) | |
529 (let ((children custom-options)) | |
530 (mapcar (lambda (child) | |
531 (when (memq (widget-get child :custom-state) '(modified set)) | |
532 (widget-apply child :custom-save))) | |
533 children)) | |
534 (custom-save-all)) | |
535 | |
536 (defvar custom-reset-menu | |
537 '(("Current" . custom-reset-current) | |
538 ("Saved" . custom-reset-saved) | |
539 ("Factory Settings" . custom-reset-factory)) | |
540 "Alist of actions for the `Reset' button. | |
541 The key is a string containing the name of the action, the value is a | |
542 lisp function taking the widget as an element which will be called | |
543 when the action is chosen.") | |
544 | |
545 (defun custom-reset (event) | |
546 "Select item from reset menu." | |
547 (let* ((completion-ignore-case t) | |
548 (answer (widget-choose "Reset to" | |
549 custom-reset-menu | |
550 event))) | |
551 (if answer | |
552 (funcall answer)))) | |
553 | |
554 (defun custom-reset-current () | |
555 "Reset all modified group members to their current value." | |
556 (interactive) | |
557 (let ((children custom-options)) | |
558 (mapcar (lambda (child) | |
559 (when (eq (widget-get child :custom-state) 'modified) | |
560 (widget-apply child :custom-reset-current))) | |
561 children))) | |
562 | |
563 (defun custom-reset-saved () | |
564 "Reset all modified or set group members to their saved value." | |
565 (interactive) | |
566 (let ((children custom-options)) | |
567 (mapcar (lambda (child) | |
568 (when (eq (widget-get child :custom-state) 'modified) | |
569 (widget-apply child :custom-reset-current))) | |
570 children))) | |
571 | |
572 (defun custom-reset-factory () | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
573 "Reset all modified, set, or saved group members to their standard settings." |
17334 | 574 (interactive) |
575 (let ((children custom-options)) | |
576 (mapcar (lambda (child) | |
577 (when (eq (widget-get child :custom-state) 'modified) | |
578 (widget-apply child :custom-reset-current))) | |
579 children))) | |
580 | |
581 ;;; The Customize Commands | |
582 | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
583 (defun custom-prompt-variable (prompt-var prompt-val) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
584 "Prompt for a variable and a value and return them as a list. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
585 PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
586 prompt for the value. The %s escape in PROMPT-VAL is replaced with |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
587 the name of the variable. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
588 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
589 If the variable has a `variable-interactive' property, that is used as if |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
590 it were the arg to `interactive' (which see) to interactively read the value. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
591 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
592 If the variable has a `custom-type' property, it must be a widget and the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
593 `:prompt-value' property of that widget will be used for reading the value." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
594 (let* ((var (read-variable prompt-var)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
595 (minibuffer-help-form '(describe-variable var))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
596 (list var |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
597 (let ((prop (get var 'variable-interactive)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
598 (type (get var 'custom-type)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
599 (prompt (format prompt-val var))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
600 (unless (listp type) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
601 (setq type (list type))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
602 (cond (prop |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
603 ;; Use VAR's `variable-interactive' property |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
604 ;; as an interactive spec for prompting. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
605 (call-interactively (list 'lambda '(arg) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
606 (list 'interactive prop) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
607 'arg))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
608 (type |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
609 (widget-prompt-value type |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
610 prompt |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
611 (if (boundp var) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
612 (symbol-value var)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
613 (not (boundp var)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
614 (t |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
615 (eval-minibuffer prompt))))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
616 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
617 ;;;###autoload |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
618 (defun custom-set-value (var val) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
619 "Set VARIABLE to VALUE. VALUE is a Lisp object. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
620 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
621 If VARIABLE has a `variable-interactive' property, that is used as if |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
622 it were the arg to `interactive' (which see) to interactively read the value. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
623 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
624 If VARIABLE has a `custom-type' property, it must be a widget and the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
625 `:prompt-value' property of that widget will be used for reading the value." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
626 (interactive (custom-prompt-variable "Set variable: " |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
627 "Set %s to value: ")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
628 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
629 (set var val)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
630 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
631 ;;;###autoload |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
632 (defun custom-set-variable (var val) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
633 "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
634 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
635 If VARIABLE has a `custom-set' property, that is used for setting |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
636 VARIABLE, otherwise `set-default' is used. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
637 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
638 The `customized-value' property of the VARIABLE will be set to a list |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
639 with a quoted VALUE as its sole list member. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
640 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
641 If VARIABLE has a `variable-interactive' property, that is used as if |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
642 it were the arg to `interactive' (which see) to interactively read the value. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
643 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
644 If VARIABLE has a `custom-type' property, it must be a widget and the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
645 `:prompt-value' property of that widget will be used for reading the value. " |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
646 (interactive (custom-prompt-variable "Set variable: " |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
647 "Set customized value for %s to: ")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
648 (funcall (or (get var 'custom-set) 'set-default) var val) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
649 (put var 'customized-value (list (custom-quote val)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
650 |
17334 | 651 ;;;###autoload |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
652 (defun customize () |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
653 "Select a customization buffer which you can use to set user options. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
654 User options are structured into \"groups\". |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
655 Initially the top-level group `Emacs' and its immediate subgroups |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
656 are shown; the contents of those subgroups are initially hidden." |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
657 (interactive) |
17703 | 658 (customize-group 'emacs)) |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
659 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
660 ;;;###autoload |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
661 (defun customize-group (group) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
662 "Customize GROUP, which must be a customization group." |
17334 | 663 (interactive (list (completing-read "Customize group: (default emacs) " |
664 obarray | |
665 (lambda (symbol) | |
666 (get symbol 'custom-group)) | |
667 t))) | |
668 | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
669 (when (stringp group) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
670 (if (string-equal "" group) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
671 (setq group 'emacs) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
672 (setq group (intern group)))) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
673 (custom-buffer-create (list (list group 'custom-group)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
674 (format "*Customize Group: %s*" |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
675 (custom-unlispify-tag-name group)))) |
17334 | 676 |
677 ;;;###autoload | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
678 (defun customize-other-window (symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
679 "Customize SYMBOL, which must be a customization group." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
680 (interactive (list (completing-read "Customize group: (default emacs) " |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
681 obarray |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
682 (lambda (symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
683 (get symbol 'custom-group)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
684 t))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
685 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
686 (when (stringp symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
687 (if (string-equal "" symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
688 (setq symbol 'emacs) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
689 (setq symbol (intern symbol)))) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
690 (custom-buffer-create-other-window |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
691 (list (list symbol 'custom-group)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
692 (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol)))) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
693 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
694 ;;;###autoload |
17334 | 695 (defun customize-variable (symbol) |
696 "Customize SYMBOL, which must be a variable." | |
17415 | 697 (interactive (custom-variable-prompt)) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
698 (custom-buffer-create (list (list symbol 'custom-variable)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
699 (format "*Customize Variable: %s*" |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
700 (custom-unlispify-tag-name symbol)))) |
17334 | 701 |
702 ;;;###autoload | |
17415 | 703 (defun customize-variable-other-window (symbol) |
704 "Customize SYMBOL, which must be a variable. | |
705 Show the buffer in another window, but don't select it." | |
706 (interactive (custom-variable-prompt)) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
707 (custom-buffer-create-other-window |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
708 (list (list symbol 'custom-variable)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
709 (format "*Customize Variable: %s*" (custom-unlispify-tag-name symbol)))) |
17415 | 710 |
711 ;;;###autoload | |
17334 | 712 (defun customize-face (&optional symbol) |
713 "Customize SYMBOL, which should be a face name or nil. | |
714 If SYMBOL is nil, customize all faces." | |
715 (interactive (list (completing-read "Customize face: (default all) " | |
716 obarray 'custom-facep))) | |
717 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) | |
718 (let ((found nil)) | |
719 (message "Looking for faces...") | |
720 (mapcar (lambda (symbol) | |
721 (setq found (cons (list symbol 'custom-face) found))) | |
17415 | 722 (nreverse (mapcar 'intern |
723 (sort (mapcar 'symbol-name (face-list)) | |
724 'string<)))) | |
725 | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
726 (custom-buffer-create found "*Customize Faces*")) |
17334 | 727 (if (stringp symbol) |
728 (setq symbol (intern symbol))) | |
729 (unless (symbolp symbol) | |
730 (error "Should be a symbol %S" symbol)) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
731 (custom-buffer-create (list (list symbol 'custom-face)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
732 (format "*Customize Face: %s*" |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
733 (custom-unlispify-tag-name symbol))))) |
17334 | 734 |
735 ;;;###autoload | |
17415 | 736 (defun customize-face-other-window (&optional symbol) |
737 "Show customization buffer for FACE in other window." | |
738 (interactive (list (completing-read "Customize face: " | |
739 obarray 'custom-facep))) | |
740 (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) | |
741 () | |
742 (if (stringp symbol) | |
743 (setq symbol (intern symbol))) | |
744 (unless (symbolp symbol) | |
745 (error "Should be a symbol %S" symbol)) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
746 (custom-buffer-create-other-window |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
747 (list (list symbol 'custom-face)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
748 (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol))))) |
17415 | 749 |
750 ;;;###autoload | |
17334 | 751 (defun customize-customized () |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
752 "Customize all user options set since the last save in this session." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
753 (interactive) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
754 (let ((found nil)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
755 (mapatoms (lambda (symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
756 (and (get symbol 'customized-face) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
757 (custom-facep symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
758 (setq found (cons (list symbol 'custom-face) found))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
759 (and (get symbol 'customized-value) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
760 (boundp symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
761 (setq found |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
762 (cons (list symbol 'custom-variable) found))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
763 (if found |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
764 (custom-buffer-create found "*Customize Customized*") |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
765 (error "No customized user options")))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
766 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
767 ;;;###autoload |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
768 (defun customize-saved () |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
769 "Customize all already saved user options." |
17334 | 770 (interactive) |
771 (let ((found nil)) | |
772 (mapatoms (lambda (symbol) | |
773 (and (get symbol 'saved-face) | |
774 (custom-facep symbol) | |
775 (setq found (cons (list symbol 'custom-face) found))) | |
776 (and (get symbol 'saved-value) | |
777 (boundp symbol) | |
778 (setq found | |
779 (cons (list symbol 'custom-variable) found))))) | |
780 (if found | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
781 (custom-buffer-create found "*Customize Saved*") |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
782 (error "No saved user options")))) |
17334 | 783 |
784 ;;;###autoload | |
785 (defun customize-apropos (regexp &optional all) | |
786 "Customize all user options matching REGEXP. | |
787 If ALL (e.g., started with a prefix key), include options which are not | |
788 user-settable." | |
789 (interactive "sCustomize regexp: \nP") | |
790 (let ((found nil)) | |
791 (mapatoms (lambda (symbol) | |
792 (when (string-match regexp (symbol-name symbol)) | |
793 (when (get symbol 'custom-group) | |
794 (setq found (cons (list symbol 'custom-group) found))) | |
795 (when (custom-facep symbol) | |
796 (setq found (cons (list symbol 'custom-face) found))) | |
797 (when (and (boundp symbol) | |
798 (or (get symbol 'saved-value) | |
799 (get symbol 'factory-value) | |
800 (if all | |
801 (get symbol 'variable-documentation) | |
802 (user-variable-p symbol)))) | |
803 (setq found | |
804 (cons (list symbol 'custom-variable) found)))))) | |
805 (if found | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
806 (custom-buffer-create found "*Customize Apropos*") |
17334 | 807 (error "No matches")))) |
808 | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
809 ;;; Buffer. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
810 |
17334 | 811 ;;;###autoload |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
812 (defun custom-buffer-create (options &optional name) |
17334 | 813 "Create a buffer containing OPTIONS. |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
814 Optional NAME is the name of the buffer. |
17334 | 815 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where |
816 SYMBOL is a customization option, and WIDGET is a widget for editing | |
817 that option." | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
818 (unless name (setq name "*Customization*")) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
819 (kill-buffer (get-buffer-create name)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
820 (switch-to-buffer (get-buffer-create name)) |
17415 | 821 (custom-buffer-create-internal options)) |
822 | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
823 ;;;###autoload |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
824 (defun custom-buffer-create-other-window (options &optional name) |
17415 | 825 "Create a buffer containing OPTIONS. |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
826 Optional NAME is the name of the buffer. |
17415 | 827 OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where |
828 SYMBOL is a customization option, and WIDGET is a widget for editing | |
829 that option." | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
830 (unless name (setq name "*Customization*")) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
831 (kill-buffer (get-buffer-create name)) |
17415 | 832 (let ((window (selected-window))) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
833 (switch-to-buffer-other-window (get-buffer-create name)) |
17415 | 834 (custom-buffer-create-internal options) |
835 (select-window window))) | |
836 | |
837 | |
838 (defun custom-buffer-create-internal (options) | |
839 (message "Creating customization buffer...") | |
17334 | 840 (custom-mode) |
841 (widget-insert "This is a customization buffer. | |
842 Push RET or click mouse-2 on the word ") | |
843 ;; (put-text-property 1 2 'start-open nil) | |
844 (widget-create 'info-link | |
845 :tag "help" | |
846 :help-echo "Read the online help." | |
18032
fd3f0a7e79b9
(custom-face-display-set): Define if not defined.
Richard M. Stallman <rms@gnu.org>
parents:
17800
diff
changeset
|
847 "(emacs)Easy Customization") |
17334 | 848 (widget-insert " for more information.\n\n") |
849 (setq custom-options | |
850 (if (= (length options) 1) | |
851 (mapcar (lambda (entry) | |
852 (widget-create (nth 1 entry) | |
853 :custom-state 'unknown | |
854 :tag (custom-unlispify-tag-name | |
855 (nth 0 entry)) | |
856 :value (nth 0 entry))) | |
857 options) | |
858 (let ((count 0) | |
859 (length (length options))) | |
860 (mapcar (lambda (entry) | |
861 (prog2 | |
862 (message "Creating customization items %2d%%..." | |
863 (/ (* 100.0 count) length)) | |
864 (widget-create (nth 1 entry) | |
865 :tag (custom-unlispify-tag-name | |
866 (nth 0 entry)) | |
867 :value (nth 0 entry)) | |
868 (setq count (1+ count)) | |
869 (unless (eq (preceding-char) ?\n) | |
870 (widget-insert "\n")) | |
871 (widget-insert "\n"))) | |
872 options)))) | |
873 (unless (eq (preceding-char) ?\n) | |
874 (widget-insert "\n")) | |
875 (widget-insert "\n") | |
876 (message "Creating customization magic...") | |
877 (mapcar 'custom-magic-reset custom-options) | |
878 (message "Creating customization buttons...") | |
879 (widget-create 'push-button | |
880 :tag "Set" | |
881 :help-echo "Set all modifications for this session." | |
882 :action (lambda (widget &optional event) | |
883 (custom-set))) | |
884 (widget-insert " ") | |
885 (widget-create 'push-button | |
886 :tag "Save" | |
887 :help-echo "\ | |
888 Make the modifications default for future sessions." | |
889 :action (lambda (widget &optional event) | |
890 (custom-save))) | |
891 (widget-insert " ") | |
892 (widget-create 'push-button | |
893 :tag "Reset" | |
894 :help-echo "Undo all modifications." | |
895 :action (lambda (widget &optional event) | |
896 (custom-reset event))) | |
897 (widget-insert " ") | |
898 (widget-create 'push-button | |
899 :tag "Done" | |
900 :help-echo "Bury the buffer." | |
901 :action (lambda (widget &optional event) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
902 (bury-buffer))) |
17334 | 903 (widget-insert "\n") |
904 (message "Creating customization setup...") | |
905 (widget-setup) | |
906 (goto-char (point-min)) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
907 (when (fboundp 'map-extents) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
908 ;; This horrible kludge should make bob and eob read-only in XEmacs. |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
909 (map-extents (lambda (extent &rest junk) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
910 (set-extent-property extent 'start-closed t)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
911 nil (point-min) (1+ (point-min))) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
912 (map-extents (lambda (extent &rest junk) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
913 (set-extent-property extent 'end-closed t)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
914 nil (1- (point-max)) (point-max))) |
17334 | 915 (message "Creating customization buffer...done")) |
916 | |
917 ;;; Modification of Basic Widgets. | |
918 ;; | |
919 ;; We add extra properties to the basic widgets needed here. This is | |
920 ;; fine, as long as we are careful to stay within out own namespace. | |
921 ;; | |
922 ;; We want simple widgets to be displayed by default, but complex | |
923 ;; widgets to be hidden. | |
924 | |
925 (widget-put (get 'item 'widget-type) :custom-show t) | |
926 (widget-put (get 'editable-field 'widget-type) | |
927 :custom-show (lambda (widget value) | |
928 (let ((pp (pp-to-string value))) | |
929 (cond ((string-match "\n" pp) | |
930 nil) | |
931 ((> (length pp) 40) | |
932 nil) | |
933 (t t))))) | |
934 (widget-put (get 'menu-choice 'widget-type) :custom-show t) | |
935 | |
936 ;;; The `custom-manual' Widget. | |
937 | |
938 (define-widget 'custom-manual 'info-link | |
939 "Link to the manual entry for this customization option." | |
940 :help-echo "Read the manual entry for this option." | |
941 :tag "Manual") | |
942 | |
943 ;;; The `custom-magic' Widget. | |
944 | |
945 (defface custom-invalid-face '((((class color)) | |
946 (:foreground "yellow" :background "red")) | |
947 (t | |
948 (:bold t :italic t :underline t))) | |
949 "Face used when the customize item is invalid.") | |
950 | |
951 (defface custom-rogue-face '((((class color)) | |
952 (:foreground "pink" :background "black")) | |
953 (t | |
954 (:underline t))) | |
955 "Face used when the customize item is not defined for customization.") | |
956 | |
957 (defface custom-modified-face '((((class color)) | |
958 (:foreground "white" :background "blue")) | |
959 (t | |
960 (:italic t :bold))) | |
961 "Face used when the customize item has been modified.") | |
962 | |
963 (defface custom-set-face '((((class color)) | |
964 (:foreground "blue" :background "white")) | |
965 (t | |
966 (:italic t))) | |
967 "Face used when the customize item has been set.") | |
968 | |
969 (defface custom-changed-face '((((class color)) | |
970 (:foreground "white" :background "blue")) | |
971 (t | |
972 (:italic t))) | |
973 "Face used when the customize item has been changed.") | |
974 | |
975 (defface custom-saved-face '((t (:underline t))) | |
976 "Face used when the customize item has been saved.") | |
977 | |
978 (defcustom custom-magic-alist '((nil "#" underline "\ | |
979 uninitialized, you should not see this.") | |
980 (unknown "?" italic "\ | |
981 unknown, you should not see this.") | |
982 (hidden "-" default "\ | |
983 hidden, press the state button to show.") | |
984 (invalid "x" custom-invalid-face "\ | |
985 the value displayed for this item is invalid and cannot be set.") | |
986 (modified "*" custom-modified-face "\ | |
987 you have edited the item, and can now set it.") | |
988 (set "+" custom-set-face "\ | |
989 you have set this item, but not saved it.") | |
990 (changed ":" custom-changed-face "\ | |
991 this item has been changed outside customize.") | |
992 (saved "!" custom-saved-face "\ | |
993 this item has been saved.") | |
994 (rogue "@" custom-rogue-face "\ | |
995 this item is not prepared for customization.") | |
996 (factory " " nil "\ | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
997 this item is unchanged from its standard setting.")) |
17334 | 998 "Alist of customize option states. |
999 Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where | |
1000 | |
1001 STATE is one of the following symbols: | |
1002 | |
1003 `nil' | |
1004 For internal use, should never occur. | |
1005 `unknown' | |
1006 For internal use, should never occur. | |
1007 `hidden' | |
1008 This item is not being displayed. | |
1009 `invalid' | |
1010 This item is modified, but has an invalid form. | |
1011 `modified' | |
1012 This item is modified, and has a valid form. | |
1013 `set' | |
1014 This item has been set but not saved. | |
1015 `changed' | |
1016 The current value of this item has been changed temporarily. | |
1017 `saved' | |
1018 This item is marked for saving. | |
1019 `rogue' | |
1020 This item has no customization information. | |
1021 `factory' | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1022 This item is unchanged from the standard setting. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1023 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1024 MAGIC is a string used to present that state. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1025 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1026 FACE is a face used to present the state. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1027 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1028 DESCRIPTION is a string describing the state. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1029 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1030 The list should be sorted most significant first." |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1031 :type '(list (checklist :inline t |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1032 (group (const nil) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1033 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1034 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1035 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1036 (group (const unknown) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1037 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1038 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1039 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1040 (group (const hidden) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1041 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1042 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1043 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1044 (group (const invalid) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1045 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1046 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1047 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1048 (group (const modified) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1049 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1050 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1051 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1052 (group (const set) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1053 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1054 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1055 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1056 (group (const changed) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1057 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1058 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1059 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1060 (group (const saved) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1061 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1062 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1063 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1064 (group (const rogue) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1065 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1066 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1067 (string :tag "Description")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1068 (group (const factory) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1069 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1070 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1071 (string :tag "Description"))) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1072 (editable-list :inline t |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1073 (group symbol |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1074 (string :tag "Magic") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1075 face |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1076 (string :tag "Description")))) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1077 :group 'customize |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1078 :group 'custom-faces) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1079 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1080 (defcustom custom-group-magic-alist '((nil "#" underline "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1081 uninitialized, you should not see this.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1082 (unknown "?" italic "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1083 unknown, you should not see this.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1084 (hidden "-" default "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1085 group now hidden; click on the asterisks above to show contents.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1086 (invalid "x" custom-invalid-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1087 the value displayed for this item is invalid and cannot be set.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1088 (modified "*" custom-modified-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1089 you have edited something in this group, and can now set it.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1090 (set "+" custom-set-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1091 something in this group has been set, but not yet saved.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1092 (changed ":" custom-changed-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1093 this item has been changed outside customize.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1094 (saved "!" custom-saved-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1095 something in this group has been set and saved.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1096 (rogue "@" custom-rogue-face "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1097 this item is not prepared for customization.") |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1098 (factory " " nil "\ |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1099 nothing in this group has been changed.")) |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1100 "Alist of customize option states. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1101 Each entry is of the form (STATE MAGIC FACE DESCRIPTION), where |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1102 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1103 STATE is one of the following symbols: |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1104 |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1105 `nil' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1106 For internal use, should never occur. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1107 `unknown' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1108 For internal use, should never occur. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1109 `hidden' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1110 This item is not being displayed. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1111 `invalid' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1112 This item is modified, but has an invalid form. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1113 `modified' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1114 This item is modified, and has a valid form. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1115 `set' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1116 This item has been set but not saved. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1117 `changed' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1118 The current value of this item has been changed temporarily. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1119 `saved' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1120 This item is marked for saving. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1121 `rogue' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1122 This item has no customization information. |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1123 `factory' |
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1124 This item is unchanged from the standard setting. |
17334 | 1125 |
1126 MAGIC is a string used to present that state. | |
1127 | |
1128 FACE is a face used to present the state. | |
1129 | |
1130 DESCRIPTION is a string describing the state. | |
1131 | |
1132 The list should be sorted most significant first." | |
1133 :type '(list (checklist :inline t | |
1134 (group (const nil) | |
1135 (string :tag "Magic") | |
1136 face | |
1137 (string :tag "Description")) | |
1138 (group (const unknown) | |
1139 (string :tag "Magic") | |
1140 face | |
1141 (string :tag "Description")) | |
1142 (group (const hidden) | |
1143 (string :tag "Magic") | |
1144 face | |
1145 (string :tag "Description")) | |
1146 (group (const invalid) | |
1147 (string :tag "Magic") | |
1148 face | |
1149 (string :tag "Description")) | |
1150 (group (const modified) | |
1151 (string :tag "Magic") | |
1152 face | |
1153 (string :tag "Description")) | |
1154 (group (const set) | |
1155 (string :tag "Magic") | |
1156 face | |
1157 (string :tag "Description")) | |
1158 (group (const changed) | |
1159 (string :tag "Magic") | |
1160 face | |
1161 (string :tag "Description")) | |
1162 (group (const saved) | |
1163 (string :tag "Magic") | |
1164 face | |
1165 (string :tag "Description")) | |
1166 (group (const rogue) | |
1167 (string :tag "Magic") | |
1168 face | |
1169 (string :tag "Description")) | |
1170 (group (const factory) | |
1171 (string :tag "Magic") | |
1172 face | |
1173 (string :tag "Description"))) | |
1174 (editable-list :inline t | |
1175 (group symbol | |
1176 (string :tag "Magic") | |
1177 face | |
1178 (string :tag "Description")))) | |
17415 | 1179 :group 'customize |
1180 :group 'custom-faces) | |
17334 | 1181 |
1182 (defcustom custom-magic-show 'long | |
1183 "Show long description of the state of each customization option." | |
1184 :type '(choice (const :tag "no" nil) | |
1185 (const short) | |
1186 (const long)) | |
1187 :group 'customize) | |
1188 | |
1189 (defcustom custom-magic-show-button t | |
1190 "Show a magic button indicating the state of each customization option." | |
1191 :type 'boolean | |
1192 :group 'customize) | |
1193 | |
1194 (define-widget 'custom-magic 'default | |
1195 "Show and manipulate state for a customization option." | |
1196 :format "%v" | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1197 :action 'widget-parent-action |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1198 :notify 'ignore |
17334 | 1199 :value-get 'ignore |
1200 :value-create 'custom-magic-value-create | |
1201 :value-delete 'widget-children-value-delete) | |
1202 | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1203 (defun widget-magic-mouse-down-action (widget &optional event) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1204 ;; Non-nil unless hidden. |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1205 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1206 :custom-state) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1207 'hidden))) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1208 |
17334 | 1209 (defun custom-magic-value-create (widget) |
1210 ;; Create compact status report for WIDGET. | |
1211 (let* ((parent (widget-get widget :parent)) | |
1212 (state (widget-get parent :custom-state)) | |
17800
ebc3066cd381
Restored code lost in merge.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17798
diff
changeset
|
1213 (entry (assq state (if (eq (car parent) 'custom-group) |
ebc3066cd381
Restored code lost in merge.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17798
diff
changeset
|
1214 custom-group-magic-alist |
ebc3066cd381
Restored code lost in merge.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17798
diff
changeset
|
1215 custom-magic-alist))) |
17334 | 1216 (magic (nth 1 entry)) |
1217 (face (nth 2 entry)) | |
1218 (text (nth 3 entry)) | |
1219 (lisp (eq (widget-get parent :custom-form) 'lisp)) | |
1220 children) | |
1221 (when custom-magic-show | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1222 (push (widget-create-child-and-convert |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1223 widget 'choice-item |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1224 :help-echo "\ |
17334 | 1225 Change the state of this item." |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1226 :format "%[%t%]" |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1227 :mouse-down-action 'widget-magic-mouse-down-action |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1228 :tag "State") |
17334 | 1229 children) |
1230 (insert ": ") | |
1231 (if (eq custom-magic-show 'long) | |
1232 (insert text) | |
1233 (insert (symbol-name state))) | |
1234 (when lisp | |
1235 (insert " (lisp)")) | |
1236 (insert "\n")) | |
1237 (when custom-magic-show-button | |
1238 (when custom-magic-show | |
1239 (let ((indent (widget-get parent :indent))) | |
1240 (when indent | |
1241 (insert-char ? indent)))) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1242 (push (widget-create-child-and-convert |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1243 widget 'choice-item |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1244 :mouse-down-action 'widget-magic-mouse-down-action |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1245 :button-face face |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1246 :help-echo "Change the state." |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1247 :format "%[%t%]" |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1248 :tag (if lisp |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1249 (concat "(" magic ")") |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1250 (concat "[" magic "]"))) |
17334 | 1251 children) |
1252 (insert " ")) | |
1253 (widget-put widget :children children))) | |
1254 | |
1255 (defun custom-magic-reset (widget) | |
1256 "Redraw the :custom-magic property of WIDGET." | |
1257 (let ((magic (widget-get widget :custom-magic))) | |
1258 (widget-value-set magic (widget-value magic)))) | |
1259 | |
1260 ;;; The `custom-level' Widget. | |
1261 | |
1262 (define-widget 'custom-level 'item | |
1263 "The custom level buttons." | |
1264 :format "%[%t%]" | |
1265 :help-echo "Expand or collapse this item." | |
1266 :action 'custom-level-action) | |
1267 | |
1268 (defun custom-level-action (widget &optional event) | |
1269 "Toggle visibility for parent to WIDGET." | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1270 (custom-toggle-hide (widget-get widget :parent))) |
17334 | 1271 |
1272 ;;; The `custom' Widget. | |
1273 | |
1274 (define-widget 'custom 'default | |
1275 "Customize a user option." | |
1276 :convert-widget 'custom-convert-widget | |
1277 :format "%l%[%t%]: %v%m%h%a" | |
1278 :format-handler 'custom-format-handler | |
1279 :notify 'custom-notify | |
1280 :custom-level 1 | |
1281 :custom-state 'hidden | |
1282 :documentation-property 'widget-subclass-responsibility | |
1283 :value-create 'widget-subclass-responsibility | |
1284 :value-delete 'widget-children-value-delete | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1285 :value-get 'widget-value-value-get |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1286 :validate 'widget-children-validate |
17334 | 1287 :match (lambda (widget value) (symbolp value))) |
1288 | |
1289 (defun custom-convert-widget (widget) | |
1290 ;; Initialize :value and :tag from :args in WIDGET. | |
1291 (let ((args (widget-get widget :args))) | |
1292 (when args | |
1293 (widget-put widget :value (widget-apply widget | |
1294 :value-to-internal (car args))) | |
1295 (widget-put widget :tag (custom-unlispify-tag-name (car args))) | |
1296 (widget-put widget :args nil))) | |
1297 widget) | |
1298 | |
1299 (defun custom-format-handler (widget escape) | |
1300 ;; We recognize extra escape sequences. | |
1301 (let* ((buttons (widget-get widget :buttons)) | |
1302 (state (widget-get widget :custom-state)) | |
1303 (level (widget-get widget :custom-level))) | |
1304 (cond ((eq escape ?l) | |
1305 (when level | |
1306 (push (widget-create-child-and-convert | |
1307 widget 'custom-level (make-string level ?*)) | |
1308 buttons) | |
1309 (widget-insert " ") | |
1310 (widget-put widget :buttons buttons))) | |
1311 ((eq escape ?L) | |
1312 (when (eq state 'hidden) | |
1313 (widget-insert " ..."))) | |
1314 ((eq escape ?m) | |
1315 (and (eq (preceding-char) ?\n) | |
1316 (widget-get widget :indent) | |
1317 (insert-char ? (widget-get widget :indent))) | |
1318 (let ((magic (widget-create-child-and-convert | |
1319 widget 'custom-magic nil))) | |
1320 (widget-put widget :custom-magic magic) | |
1321 (push magic buttons) | |
1322 (widget-put widget :buttons buttons))) | |
1323 ((eq escape ?a) | |
1324 (let* ((symbol (widget-get widget :value)) | |
1325 (links (get symbol 'custom-links)) | |
1326 (many (> (length links) 2))) | |
1327 (when links | |
1328 (and (eq (preceding-char) ?\n) | |
1329 (widget-get widget :indent) | |
1330 (insert-char ? (widget-get widget :indent))) | |
1331 (insert "See also ") | |
1332 (while links | |
1333 (push (widget-create-child-and-convert widget (car links)) | |
1334 buttons) | |
1335 (setq links (cdr links)) | |
1336 (cond ((null links) | |
1337 (insert ".\n")) | |
1338 ((null (cdr links)) | |
1339 (if many | |
1340 (insert ", and ") | |
1341 (insert " and "))) | |
1342 (t | |
1343 (insert ", ")))) | |
1344 (widget-put widget :buttons buttons)))) | |
1345 (t | |
1346 (widget-default-format-handler widget escape))))) | |
1347 | |
1348 (defun custom-notify (widget &rest args) | |
1349 "Keep track of changes." | |
1350 (unless (memq (widget-get widget :custom-state) '(nil unknown hidden)) | |
1351 (widget-put widget :custom-state 'modified)) | |
1352 (let ((buffer-undo-list t)) | |
1353 (custom-magic-reset widget)) | |
1354 (apply 'widget-default-notify widget args)) | |
1355 | |
1356 (defun custom-redraw (widget) | |
1357 "Redraw WIDGET with current settings." | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1358 (let ((line (count-lines (point-min) (point))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1359 (column (current-column)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1360 (pos (point)) |
17334 | 1361 (from (marker-position (widget-get widget :from))) |
1362 (to (marker-position (widget-get widget :to)))) | |
1363 (save-excursion | |
1364 (widget-value-set widget (widget-value widget)) | |
1365 (custom-redraw-magic widget)) | |
1366 (when (and (>= pos from) (<= pos to)) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1367 (condition-case nil |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1368 (progn |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1369 (if (> column 0) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1370 (goto-line line) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1371 (goto-line (1+ line))) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1372 (move-to-column column)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1373 (error nil))))) |
17334 | 1374 |
1375 (defun custom-redraw-magic (widget) | |
1376 "Redraw WIDGET state with current settings." | |
1377 (while widget | |
1378 (let ((magic (widget-get widget :custom-magic))) | |
1379 (unless magic | |
1380 (debug)) | |
1381 (widget-value-set magic (widget-value magic)) | |
1382 (when (setq widget (widget-get widget :group)) | |
1383 (custom-group-state-update widget)))) | |
1384 (widget-setup)) | |
1385 | |
1386 (defun custom-show (widget value) | |
1387 "Non-nil if WIDGET should be shown with VALUE by default." | |
1388 (let ((show (widget-get widget :custom-show))) | |
1389 (cond ((null show) | |
1390 nil) | |
1391 ((eq t show) | |
1392 t) | |
1393 (t | |
1394 (funcall show widget value))))) | |
1395 | |
17415 | 1396 (defvar custom-load-recursion nil |
1397 "Hack to avoid recursive dependencies.") | |
1398 | |
17334 | 1399 (defun custom-load-symbol (symbol) |
1400 "Load all dependencies for SYMBOL." | |
17415 | 1401 (unless custom-load-recursion |
1402 (let ((custom-load-recursion t) | |
1403 (loads (get symbol 'custom-loads)) | |
1404 load) | |
1405 (while loads | |
1406 (setq load (car loads) | |
1407 loads (cdr loads)) | |
1408 (cond ((symbolp load) | |
1409 (condition-case nil | |
1410 (require load) | |
1411 (error nil))) | |
1412 ((assoc load load-history)) | |
1413 (t | |
1414 (condition-case nil | |
1415 (load-library load) | |
1416 (error nil)))))))) | |
17334 | 1417 |
1418 (defun custom-load-widget (widget) | |
1419 "Load all dependencies for WIDGET." | |
1420 (custom-load-symbol (widget-value widget))) | |
1421 | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1422 (defun custom-toggle-hide (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1423 "Toggle visibility of WIDGET." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1424 (let ((state (widget-get widget :custom-state))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1425 (cond ((memq state '(invalid modified)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1426 (error "There are unset changes")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1427 ((eq state 'hidden) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1428 (widget-put widget :custom-state 'unknown)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1429 (t |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1430 (widget-put widget :custom-state 'hidden))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1431 (custom-redraw widget))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1432 |
17334 | 1433 ;;; The `custom-variable' Widget. |
1434 | |
1435 (defface custom-variable-sample-face '((t (:underline t))) | |
1436 "Face used for unpushable variable tags." | |
17415 | 1437 :group 'custom-faces) |
17334 | 1438 |
1439 (defface custom-variable-button-face '((t (:underline t :bold t))) | |
1440 "Face used for pushable variable tags." | |
17415 | 1441 :group 'custom-faces) |
17334 | 1442 |
1443 (define-widget 'custom-variable 'custom | |
1444 "Customize variable." | |
1445 :format "%l%v%m%h%a" | |
1446 :help-echo "Set or reset this variable." | |
1447 :documentation-property 'variable-documentation | |
1448 :custom-state nil | |
1449 :custom-menu 'custom-variable-menu-create | |
1450 :custom-form 'edit | |
1451 :value-create 'custom-variable-value-create | |
1452 :action 'custom-variable-action | |
1453 :custom-set 'custom-variable-set | |
1454 :custom-save 'custom-variable-save | |
1455 :custom-reset-current 'custom-redraw | |
1456 :custom-reset-saved 'custom-variable-reset-saved | |
1457 :custom-reset-factory 'custom-variable-reset-factory) | |
1458 | |
17415 | 1459 (defun custom-variable-type (symbol) |
1460 "Return a widget suitable for editing the value of SYMBOL. | |
1461 If SYMBOL has a `custom-type' property, use that. | |
1462 Otherwise, look up symbol in `custom-guess-type-alist'." | |
1463 (let* ((type (or (get symbol 'custom-type) | |
1464 (and (not (get symbol 'factory-value)) | |
1465 (custom-guess-type symbol)) | |
1466 'sexp)) | |
1467 (options (get symbol 'custom-options)) | |
1468 (tmp (if (listp type) | |
17534
a5cf59eee84b
(custom-variable-type): Use copy-sequence, not copy-list.
Richard M. Stallman <rms@gnu.org>
parents:
17521
diff
changeset
|
1469 (copy-sequence type) |
17415 | 1470 (list type)))) |
1471 (when options | |
1472 (widget-put tmp :options options)) | |
1473 tmp)) | |
1474 | |
17334 | 1475 (defun custom-variable-value-create (widget) |
1476 "Here is where you edit the variables value." | |
1477 (custom-load-widget widget) | |
1478 (let* ((buttons (widget-get widget :buttons)) | |
1479 (children (widget-get widget :children)) | |
1480 (form (widget-get widget :custom-form)) | |
1481 (state (widget-get widget :custom-state)) | |
1482 (symbol (widget-get widget :value)) | |
1483 (tag (widget-get widget :tag)) | |
17415 | 1484 (type (custom-variable-type symbol)) |
17334 | 1485 (conv (widget-convert type)) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1486 (get (or (get symbol 'custom-get) 'default-value)) |
17334 | 1487 (value (if (default-boundp symbol) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1488 (funcall get symbol) |
17334 | 1489 (widget-get conv :value)))) |
1490 ;; If the widget is new, the child determine whether it is hidden. | |
1491 (cond (state) | |
1492 ((custom-show type value) | |
1493 (setq state 'unknown)) | |
1494 (t | |
1495 (setq state 'hidden))) | |
1496 ;; If we don't know the state, see if we need to edit it in lisp form. | |
1497 (when (eq state 'unknown) | |
1498 (unless (widget-apply conv :match value) | |
1499 ;; (widget-apply (widget-convert type) :match value) | |
1500 (setq form 'lisp))) | |
1501 ;; Now we can create the child widget. | |
1502 (cond ((eq state 'hidden) | |
1503 ;; Indicate hidden value. | |
1504 (push (widget-create-child-and-convert | |
1505 widget 'item | |
1506 :format "%{%t%}: ..." | |
1507 :sample-face 'custom-variable-sample-face | |
1508 :tag tag | |
1509 :parent widget) | |
1510 children)) | |
1511 ((eq form 'lisp) | |
1512 ;; In lisp mode edit the saved value when possible. | |
1513 (let* ((value (cond ((get symbol 'saved-value) | |
1514 (car (get symbol 'saved-value))) | |
1515 ((get symbol 'factory-value) | |
1516 (car (get symbol 'factory-value))) | |
1517 ((default-boundp symbol) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1518 (custom-quote (funcall get symbol))) |
17334 | 1519 (t |
1520 (custom-quote (widget-get conv :value)))))) | |
1521 (push (widget-create-child-and-convert | |
1522 widget 'sexp | |
1523 :button-face 'custom-variable-button-face | |
1524 :tag (symbol-name symbol) | |
1525 :parent widget | |
1526 :value value) | |
1527 children))) | |
1528 (t | |
1529 ;; Edit mode. | |
1530 (push (widget-create-child-and-convert | |
1531 widget type | |
1532 :tag tag | |
1533 :button-face 'custom-variable-button-face | |
1534 :sample-face 'custom-variable-sample-face | |
1535 :value value) | |
1536 children))) | |
1537 ;; Now update the state. | |
1538 (unless (eq (preceding-char) ?\n) | |
1539 (widget-insert "\n")) | |
1540 (if (eq state 'hidden) | |
1541 (widget-put widget :custom-state state) | |
1542 (custom-variable-state-set widget)) | |
1543 (widget-put widget :custom-form form) | |
1544 (widget-put widget :buttons buttons) | |
1545 (widget-put widget :children children))) | |
1546 | |
1547 (defun custom-variable-state-set (widget) | |
1548 "Set the state of WIDGET." | |
1549 (let* ((symbol (widget-value widget)) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1550 (get (or (get symbol 'custom-get) 'default-value)) |
17334 | 1551 (value (if (default-boundp symbol) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1552 (funcall get symbol) |
17334 | 1553 (widget-get widget :value))) |
1554 tmp | |
1555 (state (cond ((setq tmp (get symbol 'customized-value)) | |
1556 (if (condition-case nil | |
1557 (equal value (eval (car tmp))) | |
1558 (error nil)) | |
1559 'set | |
1560 'changed)) | |
1561 ((setq tmp (get symbol 'saved-value)) | |
1562 (if (condition-case nil | |
1563 (equal value (eval (car tmp))) | |
1564 (error nil)) | |
1565 'saved | |
1566 'changed)) | |
1567 ((setq tmp (get symbol 'factory-value)) | |
1568 (if (condition-case nil | |
1569 (equal value (eval (car tmp))) | |
1570 (error nil)) | |
1571 'factory | |
1572 'changed)) | |
1573 (t 'rogue)))) | |
1574 (widget-put widget :custom-state state))) | |
1575 | |
1576 (defvar custom-variable-menu | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1577 '(("Hide" custom-toggle-hide |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1578 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1579 (not (memq (widget-get widget :custom-state) '(modified invalid))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1580 ("Edit" custom-variable-edit |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1581 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1582 (not (eq (widget-get widget :custom-form) 'edit)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1583 ("Edit Lisp" custom-variable-edit-lisp |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1584 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1585 (not (eq (widget-get widget :custom-form) 'lisp)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1586 ("Set" custom-variable-set |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1587 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1588 (eq (widget-get widget :custom-state) 'modified))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1589 ("Save" custom-variable-save |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1590 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1591 (memq (widget-get widget :custom-state) '(modified set changed rogue)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1592 ("Reset to Current" custom-redraw |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1593 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1594 (and (default-boundp (widget-value widget)) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1595 (memq (widget-get widget :custom-state) '(modified changed))))) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1596 ("Reset to Saved" custom-variable-reset-saved |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1597 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1598 (and (get (widget-value widget) 'saved-value) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1599 (memq (widget-get widget :custom-state) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1600 '(modified set changed rogue))))) |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1601 ("Reset to Standard Settings" custom-variable-reset-factory |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1602 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1603 (and (get (widget-value widget) 'factory-value) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1604 (memq (widget-get widget :custom-state) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1605 '(modified set changed saved rogue)))))) |
17334 | 1606 "Alist of actions for the `custom-variable' widget. |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1607 Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1608 the menu entry, ACTION is the function to call on the widget when the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1609 menu is selected, and FILTER is a predicate which takes a `custom-variable' |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1610 widget as an argument, and returns non-nil if ACTION is valid on that |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1611 widget. If FILTER is nil, ACTION is always valid.") |
17334 | 1612 |
1613 (defun custom-variable-action (widget &optional event) | |
1614 "Show the menu for `custom-variable' WIDGET. | |
1615 Optional EVENT is the location for the menu." | |
1616 (if (eq (widget-get widget :custom-state) 'hidden) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1617 (custom-toggle-hide widget) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1618 (unless (eq (widget-get widget :custom-state) 'modified) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1619 (custom-variable-state-set widget)) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1620 (custom-redraw-magic widget) |
17334 | 1621 (let* ((completion-ignore-case t) |
1622 (answer (widget-choose (custom-unlispify-tag-name | |
1623 (widget-get widget :value)) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1624 (custom-menu-filter custom-variable-menu |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1625 widget) |
17334 | 1626 event))) |
1627 (if answer | |
1628 (funcall answer widget))))) | |
1629 | |
1630 (defun custom-variable-edit (widget) | |
1631 "Edit value of WIDGET." | |
1632 (widget-put widget :custom-state 'unknown) | |
1633 (widget-put widget :custom-form 'edit) | |
1634 (custom-redraw widget)) | |
1635 | |
1636 (defun custom-variable-edit-lisp (widget) | |
1637 "Edit the lisp representation of the value of WIDGET." | |
1638 (widget-put widget :custom-state 'unknown) | |
1639 (widget-put widget :custom-form 'lisp) | |
1640 (custom-redraw widget)) | |
1641 | |
1642 (defun custom-variable-set (widget) | |
1643 "Set the current value for the variable being edited by WIDGET." | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1644 (let* ((form (widget-get widget :custom-form)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1645 (state (widget-get widget :custom-state)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1646 (child (car (widget-get widget :children))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1647 (symbol (widget-value widget)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1648 (set (or (get symbol 'custom-set) 'set-default)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1649 val) |
17334 | 1650 (cond ((eq state 'hidden) |
1651 (error "Cannot set hidden variable.")) | |
1652 ((setq val (widget-apply child :validate)) | |
1653 (goto-char (widget-get val :from)) | |
1654 (error "%s" (widget-get val :error))) | |
1655 ((eq form 'lisp) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1656 (funcall set symbol (eval (setq val (widget-value child)))) |
17334 | 1657 (put symbol 'customized-value (list val))) |
1658 (t | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1659 (funcall set symbol (setq val (widget-value child))) |
17334 | 1660 (put symbol 'customized-value (list (custom-quote val))))) |
1661 (custom-variable-state-set widget) | |
1662 (custom-redraw-magic widget))) | |
1663 | |
1664 (defun custom-variable-save (widget) | |
1665 "Set the default value for the variable being edited by WIDGET." | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1666 (let* ((form (widget-get widget :custom-form)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1667 (state (widget-get widget :custom-state)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1668 (child (car (widget-get widget :children))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1669 (symbol (widget-value widget)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1670 (set (or (get symbol 'custom-set) 'set-default)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1671 val) |
17334 | 1672 (cond ((eq state 'hidden) |
1673 (error "Cannot set hidden variable.")) | |
1674 ((setq val (widget-apply child :validate)) | |
1675 (goto-char (widget-get val :from)) | |
1676 (error "%s" (widget-get val :error))) | |
1677 ((eq form 'lisp) | |
1678 (put symbol 'saved-value (list (widget-value child))) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1679 (funcall set symbol (eval (widget-value child)))) |
17334 | 1680 (t |
1681 (put symbol | |
1682 'saved-value (list (custom-quote (widget-value | |
1683 child)))) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1684 (funcall set symbol (widget-value child)))) |
17334 | 1685 (put symbol 'customized-value nil) |
1686 (custom-save-all) | |
1687 (custom-variable-state-set widget) | |
1688 (custom-redraw-magic widget))) | |
1689 | |
1690 (defun custom-variable-reset-saved (widget) | |
1691 "Restore the saved value for the variable being edited by WIDGET." | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1692 (let* ((symbol (widget-value widget)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1693 (set (or (get symbol 'custom-set) 'set-default))) |
17334 | 1694 (if (get symbol 'saved-value) |
1695 (condition-case nil | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1696 (funcall set symbol (eval (car (get symbol 'saved-value)))) |
17334 | 1697 (error nil)) |
1698 (error "No saved value for %s" symbol)) | |
1699 (put symbol 'customized-value nil) | |
1700 (widget-put widget :custom-state 'unknown) | |
1701 (custom-redraw widget))) | |
1702 | |
1703 (defun custom-variable-reset-factory (widget) | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1704 "Restore the standard setting for the variable being edited by WIDGET." |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1705 (let* ((symbol (widget-value widget)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1706 (set (or (get symbol 'custom-set) 'set-default))) |
17334 | 1707 (if (get symbol 'factory-value) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1708 (funcall set symbol (eval (car (get symbol 'factory-value)))) |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1709 (error "No standard setting known for %S" symbol)) |
17334 | 1710 (put symbol 'customized-value nil) |
1711 (when (get symbol 'saved-value) | |
1712 (put symbol 'saved-value nil) | |
1713 (custom-save-all)) | |
1714 (widget-put widget :custom-state 'unknown) | |
1715 (custom-redraw widget))) | |
1716 | |
1717 ;;; The `custom-face-edit' Widget. | |
1718 | |
1719 (define-widget 'custom-face-edit 'checklist | |
1720 "Edit face attributes." | |
1721 :format "%t: %v" | |
1722 :tag "Attributes" | |
1723 :extra-offset 12 | |
1724 :button-args '(:help-echo "Control whether this attribute have any effect.") | |
1725 :args (mapcar (lambda (att) | |
1726 (list 'group | |
1727 :inline t | |
1728 :sibling-args (widget-get (nth 1 att) :sibling-args) | |
1729 (list 'const :format "" :value (nth 0 att)) | |
1730 (nth 1 att))) | |
1731 custom-face-attributes)) | |
1732 | |
1733 ;;; The `custom-display' Widget. | |
1734 | |
1735 (define-widget 'custom-display 'menu-choice | |
1736 "Select a display type." | |
1737 :tag "Display" | |
1738 :value t | |
1739 :help-echo "Specify frames where the face attributes should be used." | |
1740 :args '((const :tag "all" t) | |
1741 (checklist | |
1742 :offset 0 | |
1743 :extra-offset 9 | |
1744 :args ((group :sibling-args (:help-echo "\ | |
1745 Only match the specified window systems.") | |
1746 (const :format "Type: " | |
1747 type) | |
1748 (checklist :inline t | |
1749 :offset 0 | |
1750 (const :format "X " | |
1751 :sibling-args (:help-echo "\ | |
1752 The X11 Window System.") | |
1753 x) | |
1754 (const :format "PM " | |
1755 :sibling-args (:help-echo "\ | |
1756 OS/2 Presentation Manager.") | |
1757 pm) | |
1758 (const :format "Win32 " | |
1759 :sibling-args (:help-echo "\ | |
1760 Windows NT/95/97.") | |
1761 win32) | |
1762 (const :format "DOS " | |
1763 :sibling-args (:help-echo "\ | |
1764 Plain MS-DOS.") | |
1765 pc) | |
1766 (const :format "TTY%n" | |
1767 :sibling-args (:help-echo "\ | |
1768 Plain text terminals.") | |
1769 tty))) | |
1770 (group :sibling-args (:help-echo "\ | |
1771 Only match the frames with the specified color support.") | |
1772 (const :format "Class: " | |
1773 class) | |
1774 (checklist :inline t | |
1775 :offset 0 | |
1776 (const :format "Color " | |
1777 :sibling-args (:help-echo "\ | |
1778 Match color frames.") | |
1779 color) | |
1780 (const :format "Grayscale " | |
1781 :sibling-args (:help-echo "\ | |
1782 Match grayscale frames.") | |
1783 grayscale) | |
1784 (const :format "Monochrome%n" | |
1785 :sibling-args (:help-echo "\ | |
1786 Match frames with no color support.") | |
1787 mono))) | |
1788 (group :sibling-args (:help-echo "\ | |
1789 Only match frames with the specified intensity.") | |
1790 (const :format "\ | |
1791 Background brightness: " | |
1792 background) | |
1793 (checklist :inline t | |
1794 :offset 0 | |
1795 (const :format "Light " | |
1796 :sibling-args (:help-echo "\ | |
1797 Match frames with light backgrounds.") | |
1798 light) | |
1799 (const :format "Dark\n" | |
1800 :sibling-args (:help-echo "\ | |
1801 Match frames with dark backgrounds.") | |
1802 dark))))))) | |
1803 | |
1804 ;;; The `custom-face' Widget. | |
1805 | |
1806 (defface custom-face-tag-face '((t (:underline t))) | |
1807 "Face used for face tags." | |
17415 | 1808 :group 'custom-faces) |
17334 | 1809 |
1810 (define-widget 'custom-face 'custom | |
1811 "Customize face." | |
1812 :format "%l%{%t%}: %s%m%h%a%v" | |
1813 :format-handler 'custom-face-format-handler | |
1814 :sample-face 'custom-face-tag-face | |
1815 :help-echo "Set or reset this face." | |
1816 :documentation-property '(lambda (face) | |
1817 (face-doc-string face)) | |
1818 :value-create 'custom-face-value-create | |
1819 :action 'custom-face-action | |
1820 :custom-form 'selected | |
1821 :custom-set 'custom-face-set | |
1822 :custom-save 'custom-face-save | |
1823 :custom-reset-current 'custom-redraw | |
1824 :custom-reset-saved 'custom-face-reset-saved | |
1825 :custom-reset-factory 'custom-face-reset-factory | |
1826 :custom-menu 'custom-face-menu-create) | |
1827 | |
1828 (defun custom-face-format-handler (widget escape) | |
1829 ;; We recognize extra escape sequences. | |
1830 (let (child | |
1831 (symbol (widget-get widget :value))) | |
1832 (cond ((eq escape ?s) | |
1833 (and (string-match "XEmacs" emacs-version) | |
1834 ;; XEmacs cannot display initialized faces. | |
1835 (not (custom-facep symbol)) | |
1836 (copy-face 'custom-face-empty symbol)) | |
1837 (setq child (widget-create-child-and-convert | |
1838 widget 'item | |
1839 :format "(%{%t%})\n" | |
1840 :sample-face symbol | |
1841 :tag "sample"))) | |
1842 (t | |
1843 (custom-format-handler widget escape))) | |
1844 (when child | |
1845 (widget-put widget | |
1846 :buttons (cons child (widget-get widget :buttons)))))) | |
1847 | |
1848 (define-widget 'custom-face-all 'editable-list | |
1849 "An editable list of display specifications and attributes." | |
1850 :entry-format "%i %d %v" | |
1851 :insert-button-args '(:help-echo "Insert new display specification here.") | |
1852 :append-button-args '(:help-echo "Append new display specification here.") | |
1853 :delete-button-args '(:help-echo "Delete this display specification.") | |
1854 :args '((group :format "%v" custom-display custom-face-edit))) | |
1855 | |
1856 (defconst custom-face-all (widget-convert 'custom-face-all) | |
1857 "Converted version of the `custom-face-all' widget.") | |
1858 | |
1859 (define-widget 'custom-display-unselected 'item | |
1860 "A display specification that doesn't match the selected display." | |
1861 :match 'custom-display-unselected-match) | |
1862 | |
1863 (defun custom-display-unselected-match (widget value) | |
1864 "Non-nil if VALUE is an unselected display specification." | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1865 (not (face-spec-set-match-display value (selected-frame)))) |
17334 | 1866 |
1867 (define-widget 'custom-face-selected 'group | |
1868 "Edit the attributes of the selected display in a face specification." | |
1869 :args '((repeat :format "" | |
1870 :inline t | |
1871 (group custom-display-unselected sexp)) | |
1872 (group (sexp :format "") custom-face-edit) | |
1873 (repeat :format "" | |
1874 :inline t | |
1875 sexp))) | |
1876 | |
1877 (defconst custom-face-selected (widget-convert 'custom-face-selected) | |
1878 "Converted version of the `custom-face-selected' widget.") | |
1879 | |
1880 (defun custom-face-value-create (widget) | |
1881 ;; Create a list of the display specifications. | |
1882 (unless (eq (preceding-char) ?\n) | |
1883 (insert "\n")) | |
1884 (when (not (eq (widget-get widget :custom-state) 'hidden)) | |
1885 (message "Creating face editor...") | |
1886 (custom-load-widget widget) | |
1887 (let* ((symbol (widget-value widget)) | |
1888 (spec (or (get symbol 'saved-face) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1889 (get symbol 'face-defface-spec) |
17334 | 1890 ;; Attempt to construct it. |
1891 (list (list t (custom-face-attributes-get | |
1892 symbol (selected-frame)))))) | |
1893 (form (widget-get widget :custom-form)) | |
1894 (indent (widget-get widget :indent)) | |
1895 (edit (widget-create-child-and-convert | |
1896 widget | |
1897 (cond ((and (eq form 'selected) | |
1898 (widget-apply custom-face-selected :match spec)) | |
1899 (when indent (insert-char ?\ indent)) | |
1900 'custom-face-selected) | |
1901 ((and (not (eq form 'lisp)) | |
1902 (widget-apply custom-face-all :match spec)) | |
1903 'custom-face-all) | |
1904 (t | |
1905 (when indent (insert-char ?\ indent)) | |
1906 'sexp)) | |
1907 :value spec))) | |
1908 (custom-face-state-set widget) | |
1909 (widget-put widget :children (list edit))) | |
1910 (message "Creating face editor...done"))) | |
1911 | |
1912 (defvar custom-face-menu | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1913 '(("Hide" custom-toggle-hide |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1914 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1915 (not (memq (widget-get widget :custom-state) '(modified invalid))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1916 ("Edit Selected" custom-face-edit-selected |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1917 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1918 (not (eq (widget-get widget :custom-form) 'selected)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1919 ("Edit All" custom-face-edit-all |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1920 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1921 (not (eq (widget-get widget :custom-form) 'all)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1922 ("Edit Lisp" custom-face-edit-lisp |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1923 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1924 (not (eq (widget-get widget :custom-form) 'lisp)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1925 ("Set" custom-face-set) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1926 ("Save" custom-face-save) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1927 ("Reset to Saved" custom-face-reset-saved |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1928 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1929 (get (widget-value widget) 'saved-face))) |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
1930 ("Reset to Standard Setting" custom-face-reset-factory |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1931 (lambda (widget) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1932 (get (widget-value widget) 'face-defface-spec)))) |
17334 | 1933 "Alist of actions for the `custom-face' widget. |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1934 Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1935 the menu entry, ACTION is the function to call on the widget when the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1936 menu is selected, and FILTER is a predicate which takes a `custom-face' |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1937 widget as an argument, and returns non-nil if ACTION is valid on that |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1938 widget. If FILTER is nil, ACTION is always valid.") |
17334 | 1939 |
1940 (defun custom-face-edit-selected (widget) | |
1941 "Edit selected attributes of the value of WIDGET." | |
1942 (widget-put widget :custom-state 'unknown) | |
1943 (widget-put widget :custom-form 'selected) | |
1944 (custom-redraw widget)) | |
1945 | |
1946 (defun custom-face-edit-all (widget) | |
1947 "Edit all attributes of the value of WIDGET." | |
1948 (widget-put widget :custom-state 'unknown) | |
1949 (widget-put widget :custom-form 'all) | |
1950 (custom-redraw widget)) | |
1951 | |
1952 (defun custom-face-edit-lisp (widget) | |
1953 "Edit the lisp representation of the value of WIDGET." | |
1954 (widget-put widget :custom-state 'unknown) | |
1955 (widget-put widget :custom-form 'lisp) | |
1956 (custom-redraw widget)) | |
1957 | |
1958 (defun custom-face-state-set (widget) | |
1959 "Set the state of WIDGET." | |
1960 (let ((symbol (widget-value widget))) | |
1961 (widget-put widget :custom-state (cond ((get symbol 'customized-face) | |
1962 'set) | |
1963 ((get symbol 'saved-face) | |
1964 'saved) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
1965 ((get symbol 'face-defface-spec) |
17334 | 1966 'factory) |
1967 (t | |
1968 'rogue))))) | |
1969 | |
1970 (defun custom-face-action (widget &optional event) | |
1971 "Show the menu for `custom-face' WIDGET. | |
1972 Optional EVENT is the location for the menu." | |
1973 (if (eq (widget-get widget :custom-state) 'hidden) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1974 (custom-toggle-hide widget) |
17334 | 1975 (let* ((completion-ignore-case t) |
1976 (symbol (widget-get widget :value)) | |
1977 (answer (widget-choose (custom-unlispify-tag-name symbol) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1978 (custom-menu-filter custom-face-menu |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1979 widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
1980 event))) |
17334 | 1981 (if answer |
1982 (funcall answer widget))))) | |
1983 | |
1984 (defun custom-face-set (widget) | |
1985 "Make the face attributes in WIDGET take effect." | |
1986 (let* ((symbol (widget-value widget)) | |
1987 (child (car (widget-get widget :children))) | |
1988 (value (widget-value child))) | |
1989 (put symbol 'customized-face value) | |
1990 (custom-face-display-set symbol value) | |
1991 (custom-face-state-set widget) | |
1992 (custom-redraw-magic widget))) | |
1993 | |
1994 (defun custom-face-save (widget) | |
1995 "Make the face attributes in WIDGET default." | |
1996 (let* ((symbol (widget-value widget)) | |
1997 (child (car (widget-get widget :children))) | |
1998 (value (widget-value child))) | |
1999 (custom-face-display-set symbol value) | |
2000 (put symbol 'saved-face value) | |
2001 (put symbol 'customized-face nil) | |
2002 (custom-face-state-set widget) | |
2003 (custom-redraw-magic widget))) | |
2004 | |
2005 (defun custom-face-reset-saved (widget) | |
2006 "Restore WIDGET to the face's default attributes." | |
2007 (let* ((symbol (widget-value widget)) | |
2008 (child (car (widget-get widget :children))) | |
2009 (value (get symbol 'saved-face))) | |
2010 (unless value | |
2011 (error "No saved value for this face")) | |
2012 (put symbol 'customized-face nil) | |
2013 (custom-face-display-set symbol value) | |
2014 (widget-value-set child value) | |
2015 (custom-face-state-set widget) | |
2016 (custom-redraw-magic widget))) | |
2017 | |
2018 (defun custom-face-reset-factory (widget) | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
2019 "Restore WIDGET to the face's standard settings." |
17334 | 2020 (let* ((symbol (widget-value widget)) |
2021 (child (car (widget-get widget :children))) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2022 (value (get symbol 'face-defface-spec))) |
17334 | 2023 (unless value |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
2024 (error "No standard setting for this face")) |
17334 | 2025 (put symbol 'customized-face nil) |
2026 (when (get symbol 'saved-face) | |
2027 (put symbol 'saved-face nil) | |
2028 (custom-save-all)) | |
2029 (custom-face-display-set symbol value) | |
2030 (widget-value-set child value) | |
2031 (custom-face-state-set widget) | |
2032 (custom-redraw-magic widget))) | |
2033 | |
2034 ;;; The `face' Widget. | |
2035 | |
2036 (define-widget 'face 'default | |
2037 "Select and customize a face." | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2038 :convert-widget 'widget-value-convert-widget |
17334 | 2039 :format "%[%t%]: %v" |
2040 :tag "Face" | |
2041 :value 'default | |
2042 :value-create 'widget-face-value-create | |
2043 :value-delete 'widget-face-value-delete | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2044 :value-get 'widget-value-value-get |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2045 :validate 'widget-children-validate |
17334 | 2046 :action 'widget-face-action |
2047 :match '(lambda (widget value) (symbolp value))) | |
2048 | |
2049 (defun widget-face-value-create (widget) | |
2050 ;; Create a `custom-face' child. | |
2051 (let* ((symbol (widget-value widget)) | |
2052 (child (widget-create-child-and-convert | |
2053 widget 'custom-face | |
2054 :format "%t %s%m%h%v" | |
2055 :custom-level nil | |
2056 :value symbol))) | |
2057 (custom-magic-reset child) | |
2058 (setq custom-options (cons child custom-options)) | |
2059 (widget-put widget :children (list child)))) | |
2060 | |
2061 (defun widget-face-value-delete (widget) | |
2062 ;; Remove the child from the options. | |
2063 (let ((child (car (widget-get widget :children)))) | |
2064 (setq custom-options (delq child custom-options)) | |
2065 (widget-children-value-delete widget))) | |
2066 | |
2067 (defvar face-history nil | |
2068 "History of entered face names.") | |
2069 | |
2070 (defun widget-face-action (widget &optional event) | |
2071 "Prompt for a face." | |
2072 (let ((answer (completing-read "Face: " | |
2073 (mapcar (lambda (face) | |
2074 (list (symbol-name face))) | |
2075 (face-list)) | |
2076 nil nil nil | |
2077 'face-history))) | |
2078 (unless (zerop (length answer)) | |
2079 (widget-value-set widget (intern answer)) | |
2080 (widget-apply widget :notify widget event) | |
2081 (widget-setup)))) | |
2082 | |
2083 ;;; The `hook' Widget. | |
2084 | |
2085 (define-widget 'hook 'list | |
2086 "A emacs lisp hook" | |
2087 :convert-widget 'custom-hook-convert-widget | |
2088 :tag "Hook") | |
2089 | |
2090 (defun custom-hook-convert-widget (widget) | |
2091 ;; Handle `:custom-options'. | |
2092 (let* ((options (widget-get widget :options)) | |
2093 (other `(editable-list :inline t | |
2094 :entry-format "%i %d%v" | |
2095 (function :format " %v"))) | |
2096 (args (if options | |
2097 (list `(checklist :inline t | |
2098 ,@(mapcar (lambda (entry) | |
2099 `(function-item ,entry)) | |
2100 options)) | |
2101 other) | |
2102 (list other)))) | |
2103 (widget-put widget :args args) | |
2104 widget)) | |
2105 | |
2106 ;;; The `custom-group' Widget. | |
2107 | |
2108 (defcustom custom-group-tag-faces '(custom-group-tag-face-1) | |
2109 ;; In XEmacs, this ought to play games with font size. | |
2110 "Face used for group tags. | |
2111 The first member is used for level 1 groups, the second for level 2, | |
2112 and so forth. The remaining group tags are shown with | |
2113 `custom-group-tag-face'." | |
2114 :type '(repeat face) | |
17415 | 2115 :group 'custom-faces) |
17334 | 2116 |
2117 (defface custom-group-tag-face-1 '((((class color) | |
2118 (background dark)) | |
2119 (:foreground "pink" :underline t)) | |
2120 (((class color) | |
2121 (background light)) | |
2122 (:foreground "red" :underline t)) | |
2123 (t (:underline t))) | |
2124 "Face used for group tags.") | |
2125 | |
2126 (defface custom-group-tag-face '((((class color) | |
2127 (background dark)) | |
2128 (:foreground "light blue" :underline t)) | |
2129 (((class color) | |
2130 (background light)) | |
2131 (:foreground "blue" :underline t)) | |
2132 (t (:underline t))) | |
2133 "Face used for low level group tags." | |
17415 | 2134 :group 'custom-faces) |
17334 | 2135 |
2136 (define-widget 'custom-group 'custom | |
2137 "Customize group." | |
2138 :format "%l%{%t%}:%L\n%m%h%a%v" | |
2139 :sample-face-get 'custom-group-sample-face-get | |
2140 :documentation-property 'group-documentation | |
2141 :help-echo "Set or reset all members of this group." | |
2142 :value-create 'custom-group-value-create | |
2143 :action 'custom-group-action | |
2144 :custom-set 'custom-group-set | |
2145 :custom-save 'custom-group-save | |
2146 :custom-reset-current 'custom-group-reset-current | |
2147 :custom-reset-saved 'custom-group-reset-saved | |
2148 :custom-reset-factory 'custom-group-reset-factory | |
2149 :custom-menu 'custom-group-menu-create) | |
2150 | |
2151 (defun custom-group-sample-face-get (widget) | |
2152 ;; Use :sample-face. | |
2153 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) | |
2154 'custom-group-tag-face)) | |
2155 | |
2156 (defun custom-group-value-create (widget) | |
2157 (let ((state (widget-get widget :custom-state))) | |
2158 (unless (eq state 'hidden) | |
2159 (message "Creating group...") | |
2160 (custom-load-widget widget) | |
2161 (let* ((level (widget-get widget :custom-level)) | |
2162 (symbol (widget-value widget)) | |
2163 (members (get symbol 'custom-group)) | |
2164 (prefixes (widget-get widget :custom-prefixes)) | |
2165 (custom-prefix-list (custom-prefix-add symbol prefixes)) | |
2166 (length (length members)) | |
2167 (count 0) | |
2168 (children (mapcar (lambda (entry) | |
2169 (widget-insert "\n") | |
2170 (message "Creating group members... %2d%%" | |
2171 (/ (* 100.0 count) length)) | |
2172 (setq count (1+ count)) | |
2173 (prog1 | |
2174 (widget-create-child-and-convert | |
2175 widget (nth 1 entry) | |
2176 :group widget | |
2177 :tag (custom-unlispify-tag-name | |
2178 (nth 0 entry)) | |
2179 :custom-prefixes custom-prefix-list | |
2180 :custom-level (1+ level) | |
2181 :value (nth 0 entry)) | |
2182 (unless (eq (preceding-char) ?\n) | |
2183 (widget-insert "\n")))) | |
2184 members))) | |
2185 (message "Creating group magic...") | |
2186 (mapcar 'custom-magic-reset children) | |
2187 (message "Creating group state...") | |
2188 (widget-put widget :children children) | |
2189 (custom-group-state-update widget) | |
2190 (message "Creating group... done"))))) | |
2191 | |
2192 (defvar custom-group-menu | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2193 '(("Hide" custom-toggle-hide |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2194 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2195 (not (memq (widget-get widget :custom-state) '(modified invalid))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2196 ("Set" custom-group-set |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2197 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2198 (eq (widget-get widget :custom-state) 'modified))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2199 ("Save" custom-group-save |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2200 (lambda (widget) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2201 (memq (widget-get widget :custom-state) '(modified set)))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2202 ("Reset to Current" custom-group-reset-current |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2203 (lambda (widget) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2204 (memq (widget-get widget :custom-state) '(modified)))) |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2205 ("Reset to Saved" custom-group-reset-saved |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2206 (lambda (widget) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2207 (memq (widget-get widget :custom-state) '(modified set)))) |
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2208 ("Reset to standard setting" custom-group-reset-factory |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2209 (lambda (widget) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2210 (memq (widget-get widget :custom-state) '(modified set saved))))) |
17334 | 2211 "Alist of actions for the `custom-group' widget. |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2212 Each entry has the form (NAME ACTION FILTER) where NAME is the name of |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2213 the menu entry, ACTION is the function to call on the widget when the |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2214 menu is selected, and FILTER is a predicate which takes a `custom-group' |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2215 widget as an argument, and returns non-nil if ACTION is valid on that |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2216 widget. If FILTER is nil, ACTION is always valid.") |
17334 | 2217 |
2218 (defun custom-group-action (widget &optional event) | |
2219 "Show the menu for `custom-group' WIDGET. | |
2220 Optional EVENT is the location for the menu." | |
2221 (if (eq (widget-get widget :custom-state) 'hidden) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2222 (custom-toggle-hide widget) |
17334 | 2223 (let* ((completion-ignore-case t) |
2224 (answer (widget-choose (custom-unlispify-tag-name | |
2225 (widget-get widget :value)) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2226 (custom-menu-filter custom-group-menu |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2227 widget) |
17334 | 2228 event))) |
2229 (if answer | |
2230 (funcall answer widget))))) | |
2231 | |
2232 (defun custom-group-set (widget) | |
2233 "Set changes in all modified group members." | |
2234 (let ((children (widget-get widget :children))) | |
2235 (mapcar (lambda (child) | |
2236 (when (eq (widget-get child :custom-state) 'modified) | |
2237 (widget-apply child :custom-set))) | |
2238 children ))) | |
2239 | |
2240 (defun custom-group-save (widget) | |
2241 "Save all modified group members." | |
2242 (let ((children (widget-get widget :children))) | |
2243 (mapcar (lambda (child) | |
2244 (when (memq (widget-get child :custom-state) '(modified set)) | |
2245 (widget-apply child :custom-save))) | |
2246 children ))) | |
2247 | |
2248 (defun custom-group-reset-current (widget) | |
2249 "Reset all modified group members." | |
2250 (let ((children (widget-get widget :children))) | |
2251 (mapcar (lambda (child) | |
2252 (when (eq (widget-get child :custom-state) 'modified) | |
2253 (widget-apply child :custom-reset-current))) | |
2254 children ))) | |
2255 | |
2256 (defun custom-group-reset-saved (widget) | |
2257 "Reset all modified or set group members." | |
2258 (let ((children (widget-get widget :children))) | |
2259 (mapcar (lambda (child) | |
2260 (when (memq (widget-get child :custom-state) '(modified set)) | |
2261 (widget-apply child :custom-reset-saved))) | |
2262 children ))) | |
2263 | |
2264 (defun custom-group-reset-factory (widget) | |
2265 "Reset all modified, set, or saved group members." | |
2266 (let ((children (widget-get widget :children))) | |
2267 (mapcar (lambda (child) | |
2268 (when (memq (widget-get child :custom-state) | |
2269 '(modified set saved)) | |
2270 (widget-apply child :custom-reset-factory))) | |
2271 children ))) | |
2272 | |
2273 (defun custom-group-state-update (widget) | |
2274 "Update magic." | |
2275 (unless (eq (widget-get widget :custom-state) 'hidden) | |
2276 (let* ((children (widget-get widget :children)) | |
2277 (states (mapcar (lambda (child) | |
2278 (widget-get child :custom-state)) | |
2279 children)) | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
2280 (magics custom-group-magic-alist) |
17334 | 2281 (found 'factory)) |
2282 (while magics | |
2283 (let ((magic (car (car magics)))) | |
2284 (if (and (not (eq magic 'hidden)) | |
2285 (memq magic states)) | |
2286 (setq found magic | |
2287 magics nil) | |
2288 (setq magics (cdr magics))))) | |
2289 (widget-put widget :custom-state found))) | |
2290 (custom-magic-reset widget)) | |
2291 | |
2292 ;;; The `custom-save-all' Function. | |
2293 | |
2294 (defcustom custom-file "~/.emacs" | |
2295 "File used for storing customization information. | |
2296 If you change this from the default \"~/.emacs\" you need to | |
2297 explicitly load that file for the settings to take effect." | |
2298 :type 'file | |
2299 :group 'customize) | |
2300 | |
2301 (defun custom-save-delete (symbol) | |
2302 "Delete the call to SYMBOL form `custom-file'. | |
2303 Leave point at the location of the call, or after the last expression." | |
2304 (set-buffer (find-file-noselect custom-file)) | |
2305 (goto-char (point-min)) | |
2306 (catch 'found | |
2307 (while t | |
2308 (let ((sexp (condition-case nil | |
2309 (read (current-buffer)) | |
2310 (end-of-file (throw 'found nil))))) | |
2311 (when (and (listp sexp) | |
2312 (eq (car sexp) symbol)) | |
2313 (delete-region (save-excursion | |
2314 (backward-sexp) | |
2315 (point)) | |
2316 (point)) | |
2317 (throw 'found nil)))))) | |
2318 | |
2319 (defun custom-save-variables () | |
2320 "Save all customized variables in `custom-file'." | |
2321 (save-excursion | |
2322 (custom-save-delete 'custom-set-variables) | |
2323 (let ((standard-output (current-buffer))) | |
2324 (unless (bolp) | |
2325 (princ "\n")) | |
2326 (princ "(custom-set-variables") | |
2327 (mapatoms (lambda (symbol) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2328 (let ((value (get symbol 'saved-value)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2329 (requests (get symbol 'custom-requests)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2330 (now (not (or (get symbol 'factory-value) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2331 (and (not (boundp symbol)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2332 (not (get symbol 'force-value))))))) |
17334 | 2333 (when value |
2334 (princ "\n '(") | |
2335 (princ symbol) | |
2336 (princ " ") | |
2337 (prin1 (car value)) | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2338 (cond (requests |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2339 (if now |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2340 (princ " t ") |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2341 (princ " nil ")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2342 (prin1 requests) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2343 (princ ")")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2344 (now |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2345 (princ " t)")) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2346 (t |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2347 (princ ")"))))))) |
17334 | 2348 (princ ")") |
2349 (unless (looking-at "\n") | |
2350 (princ "\n"))))) | |
2351 | |
2352 (defun custom-save-faces () | |
2353 "Save all customized faces in `custom-file'." | |
2354 (save-excursion | |
2355 (custom-save-delete 'custom-set-faces) | |
2356 (let ((standard-output (current-buffer))) | |
2357 (unless (bolp) | |
2358 (princ "\n")) | |
2359 (princ "(custom-set-faces") | |
17415 | 2360 (let ((value (get 'default 'saved-face))) |
2361 ;; The default face must be first, since it affects the others. | |
2362 (when value | |
2363 (princ "\n '(default ") | |
2364 (prin1 value) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2365 (if (or (get 'default 'face-defface-spec) |
17415 | 2366 (and (not (custom-facep 'default)) |
2367 (not (get 'default 'force-face)))) | |
2368 (princ ")") | |
2369 (princ " t)")))) | |
17334 | 2370 (mapatoms (lambda (symbol) |
2371 (let ((value (get symbol 'saved-face))) | |
17415 | 2372 (when (and (not (eq symbol 'default)) |
2373 ;; Don't print default face here. | |
2374 value) | |
17334 | 2375 (princ "\n '(") |
2376 (princ symbol) | |
2377 (princ " ") | |
2378 (prin1 value) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2379 (if (or (get symbol 'face-defface-spec) |
17334 | 2380 (and (not (custom-facep symbol)) |
2381 (not (get symbol 'force-face)))) | |
2382 (princ ")") | |
2383 (princ " t)")))))) | |
2384 (princ ")") | |
2385 (unless (looking-at "\n") | |
2386 (princ "\n"))))) | |
2387 | |
2388 ;;;###autoload | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2389 (defun custom-save-customized () |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2390 "Save all user options which have been set in this session." |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2391 (interactive) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2392 (mapatoms (lambda (symbol) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2393 (let ((face (get symbol 'customized-face)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2394 (value (get symbol 'customized-value))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2395 (when face |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2396 (put symbol 'saved-face face) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2397 (put symbol 'customized-face nil)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2398 (when value |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2399 (put symbol 'saved-value value) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2400 (put symbol 'customized-value nil))))) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2401 ;; We really should update all custom buffers here. |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2402 (custom-save-all)) |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2403 |
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2404 ;;;###autoload |
17334 | 2405 (defun custom-save-all () |
2406 "Save all customizations in `custom-file'." | |
2407 (custom-save-variables) | |
2408 (custom-save-faces) | |
2409 (save-excursion | |
2410 (set-buffer (find-file-noselect custom-file)) | |
2411 (save-buffer))) | |
2412 | |
2413 ;;; The Customize Menu. | |
2414 | |
17415 | 2415 ;;; Menu support |
2416 | |
2417 (unless (string-match "XEmacs" emacs-version) | |
2418 (defconst custom-help-menu '("Customize" | |
2419 ["Update menu..." custom-menu-update t] | |
2420 ["Group..." customize t] | |
2421 ["Variable..." customize-variable t] | |
2422 ["Face..." customize-face t] | |
2423 ["Saved..." customize-customized t] | |
2424 ["Apropos..." customize-apropos t]) | |
2425 ;; This menu should be identical to the one defined in `menu-bar.el'. | |
2426 "Customize menu") | |
2427 | |
2428 (defun custom-menu-reset () | |
2429 "Reset customize menu." | |
2430 (remove-hook 'custom-define-hook 'custom-menu-reset) | |
2431 (define-key global-map [menu-bar help-menu customize-menu] | |
2432 (cons (car custom-help-menu) | |
2433 (easy-menu-create-keymaps (car custom-help-menu) | |
2434 (cdr custom-help-menu))))) | |
2435 | |
2436 (defun custom-menu-update (event) | |
2437 "Update customize menu." | |
2438 (interactive "e") | |
2439 (add-hook 'custom-define-hook 'custom-menu-reset) | |
2440 (let* ((emacs (widget-apply '(custom-group) :custom-menu 'emacs)) | |
2441 (menu `(,(car custom-help-menu) | |
2442 ,emacs | |
2443 ,@(cdr (cdr custom-help-menu))))) | |
2444 (let ((map (easy-menu-create-keymaps (car menu) (cdr menu)))) | |
2445 (define-key global-map [menu-bar help-menu customize-menu] | |
2446 (cons (car menu) map))))) | |
2447 | |
2448 (defcustom custom-menu-nesting 2 | |
2449 "Maximum nesting in custom menus." | |
2450 :type 'integer | |
2451 :group 'customize)) | |
17334 | 2452 |
2453 (defun custom-face-menu-create (widget symbol) | |
2454 "Ignoring WIDGET, create a menu entry for customization face SYMBOL." | |
2455 (vector (custom-unlispify-menu-entry symbol) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2456 `(customize-face ',symbol) |
17334 | 2457 t)) |
2458 | |
2459 (defun custom-variable-menu-create (widget symbol) | |
2460 "Ignoring WIDGET, create a menu entry for customization variable SYMBOL." | |
2461 (let ((type (get symbol 'custom-type))) | |
2462 (unless (listp type) | |
2463 (setq type (list type))) | |
2464 (if (and type (widget-get type :custom-menu)) | |
2465 (widget-apply type :custom-menu symbol) | |
2466 (vector (custom-unlispify-menu-entry symbol) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2467 `(customize-variable ',symbol) |
17334 | 2468 t)))) |
2469 | |
17415 | 2470 ;; Add checkboxes to boolean variable entries. |
17334 | 2471 (widget-put (get 'boolean 'widget-type) |
2472 :custom-menu (lambda (widget symbol) | |
2473 (vector (custom-unlispify-menu-entry symbol) | |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2474 `(customize-variable ',symbol) |
17334 | 2475 ':style 'toggle |
2476 ':selected symbol))) | |
2477 | |
2478 (if (string-match "XEmacs" emacs-version) | |
2479 ;; XEmacs can create menus dynamically. | |
2480 (defun custom-group-menu-create (widget symbol) | |
2481 "Ignoring WIDGET, create a menu entry for customization group SYMBOL." | |
2482 `( ,(custom-unlispify-menu-entry symbol t) | |
2483 :filter (lambda (&rest junk) | |
2484 (cdr (custom-menu-create ',symbol))))) | |
2485 ;; But emacs can't. | |
2486 (defun custom-group-menu-create (widget symbol) | |
2487 "Ignoring WIDGET, create a menu entry for customization group SYMBOL." | |
2488 ;; Limit the nesting. | |
2489 (let ((custom-menu-nesting (1- custom-menu-nesting))) | |
2490 (custom-menu-create symbol)))) | |
2491 | |
17415 | 2492 ;;;###autoload |
2493 (defun custom-menu-create (symbol) | |
17334 | 2494 "Create menu for customization group SYMBOL. |
2495 The menu is in a format applicable to `easy-menu-define'." | |
17415 | 2496 (let* ((item (vector (custom-unlispify-menu-entry symbol) |
17798
f59c9a63514b
Synched with version 1.97.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17703
diff
changeset
|
2497 `(customize-group ',symbol) |
17415 | 2498 t))) |
2499 (if (and (or (not (boundp 'custom-menu-nesting)) | |
2500 (>= custom-menu-nesting 0)) | |
17334 | 2501 (< (length (get symbol 'custom-group)) widget-menu-max-size)) |
2502 (let ((custom-prefix-list (custom-prefix-add symbol | |
2503 custom-prefix-list))) | |
2504 (custom-load-symbol symbol) | |
2505 `(,(custom-unlispify-menu-entry symbol t) | |
2506 ,item | |
2507 "--" | |
2508 ,@(mapcar (lambda (entry) | |
2509 (widget-apply (if (listp (nth 1 entry)) | |
2510 (nth 1 entry) | |
2511 (list (nth 1 entry))) | |
2512 :custom-menu (nth 0 entry))) | |
2513 (get symbol 'custom-group)))) | |
2514 item))) | |
2515 | |
2516 ;;;###autoload | |
17415 | 2517 (defun customize-menu-create (symbol &optional name) |
2518 "Return a customize menu for customization group SYMBOL. | |
2519 If optional NAME is given, use that as the name of the menu. | |
2520 Otherwise the menu will be named `Customize'. | |
2521 The format is suitable for use with `easy-menu-define'." | |
2522 (unless name | |
2523 (setq name "Customize")) | |
2524 (if (string-match "XEmacs" emacs-version) | |
2525 ;; We can delay it under XEmacs. | |
2526 `(,name | |
2527 :filter (lambda (&rest junk) | |
2528 (cdr (custom-menu-create ',symbol)))) | |
2529 ;; But we must create it now under Emacs. | |
2530 (cons name (cdr (custom-menu-create symbol))))) | |
17334 | 2531 |
17415 | 2532 ;;; The Custom Mode. |
2533 | |
2534 (defvar custom-mode-map nil | |
2535 "Keymap for `custom-mode'.") | |
2536 | |
2537 (unless custom-mode-map | |
2538 (setq custom-mode-map (make-sparse-keymap)) | |
2539 (set-keymap-parent custom-mode-map widget-keymap) | |
2540 (define-key custom-mode-map "q" 'bury-buffer)) | |
2541 | |
2542 (easy-menu-define custom-mode-customize-menu | |
2543 custom-mode-map | |
17550
d6545cfb6c5a
Synched with custom 1.90.
Per Abrahamsen <abraham@dina.kvl.dk>
parents:
17534
diff
changeset
|
2544 "Menu used to customize customization buffers." |
17415 | 2545 (customize-menu-create 'customize)) |
17334 | 2546 |
17415 | 2547 (easy-menu-define custom-mode-menu |
2548 custom-mode-map | |
2549 "Menu used in customization buffers." | |
2550 `("Custom" | |
2551 ["Set" custom-set t] | |
2552 ["Save" custom-save t] | |
2553 ["Reset to Current" custom-reset-current t] | |
2554 ["Reset to Saved" custom-reset-saved t] | |
17641
4650d25e48f6
Say "standard settings" instead of "factory settings".
Richard M. Stallman <rms@gnu.org>
parents:
17550
diff
changeset
|
2555 ["Reset to Standard Settings" custom-reset-factory t] |
17415 | 2556 ["Info" (Info-goto-node "(custom)The Customization Buffer") t])) |
2557 | |
2558 (defcustom custom-mode-hook nil | |
2559 "Hook called when entering custom-mode." | |
2560 :type 'hook | |
2561 :group 'customize) | |
2562 | |
2563 (defun custom-mode () | |
2564 "Major mode for editing customization buffers. | |
2565 | |
2566 The following commands are available: | |
2567 | |
2568 Move to next button or editable field. \\[widget-forward] | |
2569 Move to previous button or editable field. \\[widget-backward] | |
2570 Activate button under the mouse pointer. \\[widget-button-click] | |
2571 Activate button under point. \\[widget-button-press] | |
2572 Set all modifications. \\[custom-set] | |
2573 Make all modifications default. \\[custom-save] | |
2574 Reset all modified options. \\[custom-reset-current] | |
2575 Reset all modified or set options. \\[custom-reset-saved] | |
2576 Reset all options. \\[custom-reset-factory] | |
2577 | |
2578 Entry to this mode calls the value of `custom-mode-hook' | |
2579 if that value is non-nil." | |
2580 (kill-all-local-variables) | |
2581 (setq major-mode 'custom-mode | |
2582 mode-name "Custom") | |
2583 (use-local-map custom-mode-map) | |
2584 (easy-menu-add custom-mode-customize-menu) | |
2585 (easy-menu-add custom-mode-menu) | |
2586 (make-local-variable 'custom-options) | |
2587 (run-hooks 'custom-mode-hook)) | |
17334 | 2588 |
2589 ;;; The End. | |
2590 | |
2591 (provide 'cus-edit) | |
2592 | |
2593 ;; cus-edit.el ends here |