(vc-svn-registered): Catch all errors.
[bpt/emacs.git] / lisp / cus-edit.el
CommitLineData
e8af40ee 1;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
d543e20b 2;;
0d30b337
TTN
3;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
4;; 2005 Free Software Foundation, Inc.
d543e20b
PA
5;;
6;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
c942535f 7;; Maintainer: FSF
d543e20b 8;; Keywords: help, faces
d543e20b 9
f2b98a56
RS
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
f2b98a56 26
d543e20b
PA
27;;; Commentary:
28;;
6d528fc5 29;; This file implements the code to create and edit customize buffers.
c942535f 30;;
d543e20b
PA
31;; See `custom.el'.
32
ab678382
RS
33;; No commands should have names starting with `custom-' because
34;; that interferes with completion. Use `customize-' for commands
35;; that the user will run with M-x, and `Custom-' for interactive commands.
36
9f5d3236 37;; The identity of a customize option is represented by a Lisp symbol.
62bf2fd1 38;; The following values are associated with an option.
9f5d3236
RS
39
40;; 0. The current value.
41
42;; This is the value of the option as seen by "the rest of Emacs".
43
44;; Usually extracted by 'default-value', but can be extracted with
45;; different means if the option symbol has the 'custom-get'
46;; property. Similarly, set-default (or the 'custom-set' property)
47;; can set it.
48
49;; 1. The widget value.
50
62bf2fd1 51;; This is the value shown in the widget in a customize buffer.
9f5d3236
RS
52
53;; 2. The customized value.
54
55;; This is the last value given to the option through customize.
56
57;; It is stored in the 'customized-value' property of the option, in a
62bf2fd1 58;; cons-cell whose car evaluates to the customized value.
9f5d3236
RS
59
60;; 3. The saved value.
61
62;; This is last value saved from customize.
63
64;; It is stored in the 'saved-value' property of the option, in a
62bf2fd1 65;; cons-cell whose car evaluates to the saved value.
9f5d3236
RS
66
67;; 4. The standard value.
68
69;; This is the value given in the 'defcustom' declaration.
70
71;; It is stored in the 'standard-value' property of the option, in a
62bf2fd1 72;; cons-cell whose car evaluates to the standard value.
9f5d3236
RS
73
74;; 5. The "think" value.
62bf2fd1
LT
75
76;; This is what customize thinks the current value should be.
77
78;; This is the customized value, if any such value exists, otherwise
9f5d3236 79;; the saved value, if that exists, and as a last resort the standard
62bf2fd1 80;; value.
9f5d3236
RS
81
82;; The reason for storing values unevaluated: This is so you can have
83;; values that depend on the environment. For example, you can have a
62bf2fd1 84;; variable that has one value when Emacs is running under a window
9f5d3236 85;; system, and another value on a tty. Since the evaluation is only done
62bf2fd1 86;; when the variable is first initialized, this is only relevant for the
9f5d3236
RS
87;; saved (and standard) values, but affect others values for
88;; compatibility.
89
90;; You can see (and modify and save) this unevaluated value by selecting
91;; "Show initial Lisp expression" from the Lisp interface. This will
92;; give you the unevaluated saved value, if any, otherwise the
93;; unevaluated standard value.
94
95;; The possible states for a customize widget are:
96
97;; 0. unknown
98
99;; The state has not been determined yet.
100
101;; 1. modified
102
103;; The widget value is different from the current value.
104
105;; 2. changed
62bf2fd1
LT
106
107;; The current value is different from the "think" value.
9f5d3236
RS
108
109;; 3. set
110
111;; The "think" value is the customized value.
112
113;; 4. saved
114
115;; The "think" value is the saved value.
116
117;; 5. standard
118
119;; The "think" value is the standard value.
120
121;; 6. rogue
122
62bf2fd1 123;; There is no standard value. This means that the variable was
f32a1cb5
LT
124;; not defined with defcustom, nor handled in cus-start.el. You
125;; can not create a Custom buffer for such variables using the
126;; normal interactive Custom commands. However, such Custom
127;; buffers can be created in other ways, for instance, by calling
128;; `customize-option' non-interactively.
9f5d3236
RS
129
130;; 7. hidden
131
132;; There is no widget value.
133
134;; 8. mismatch
135
136;; The widget value is not valid member of the :type specified for the
62bf2fd1 137;; option.
9f5d3236 138
d543e20b
PA
139;;; Code:
140
141(require 'cus-face)
142(require 'wid-edit)
164cfaeb 143(eval-when-compile
5cabd50e
EZ
144 (defvar custom-versions-load-alist) ; from cus-load
145 (defvar recentf-exclude)) ; from recentf.el
6d528fc5
PA
146
147(condition-case nil
148 (require 'cus-load)
149 (error nil))
d543e20b 150
9097aeb7
PA
151(condition-case nil
152 (require 'cus-start)
153 (error nil))
154
bd042c03 155(put 'custom-define-hook 'custom-type 'hook)
25ac13b5 156(put 'custom-define-hook 'standard-value '(nil))
bd042c03
PA
157(custom-add-to-group 'customize 'custom-define-hook 'custom-variable)
158
d543e20b
PA
159;;; Customization Groups.
160
161(defgroup emacs nil
162 "Customization of the One True Editor."
163 :link '(custom-manual "(emacs)Top"))
164
165;; Most of these groups are stolen from `finder.el',
166(defgroup editing nil
167 "Basic text editing facilities."
168 :group 'emacs)
169
170(defgroup abbrev nil
171 "Abbreviation handling, typing shortcuts, macros."
172 :tag "Abbreviations"
173 :group 'editing)
174
175(defgroup matching nil
176 "Various sorts of searching and matching."
177 :group 'editing)
178
179(defgroup emulations nil
180 "Emulations of other editors."
6ea2832e 181 :link '(custom-manual "(emacs)Emulation")
d543e20b
PA
182 :group 'editing)
183
184(defgroup mouse nil
185 "Mouse support."
186 :group 'editing)
187
188(defgroup outlines nil
189 "Support for hierarchical outlining."
190 :group 'editing)
191
192(defgroup external nil
193 "Interfacing to external utilities."
194 :group 'emacs)
195
d543e20b
PA
196(defgroup processes nil
197 "Process, subshell, compilation, and job control support."
198 :group 'external
199 :group 'development)
200
4599e8cd
RS
201(defgroup convenience nil
202 "Convenience features for faster editing."
203 :group 'emacs)
204
d543e20b
PA
205(defgroup programming nil
206 "Support for programming in other languages."
207 :group 'emacs)
208
209(defgroup languages nil
210 "Specialized modes for editing programming languages."
211 :group 'programming)
212
213(defgroup lisp nil
214 "Lisp support, including Emacs Lisp."
215 :group 'languages
216 :group 'development)
217
218(defgroup c nil
219 "Support for the C language and related languages."
6ea2832e 220 :link '(custom-manual "(ccmode)")
d543e20b
PA
221 :group 'languages)
222
223(defgroup tools nil
224 "Programming tools."
225 :group 'programming)
226
227(defgroup oop nil
228 "Support for object-oriented programming."
229 :group 'programming)
230
231(defgroup applications nil
232 "Applications written in Emacs."
233 :group 'emacs)
234
235(defgroup calendar nil
236 "Calendar and time management support."
237 :group 'applications)
238
239(defgroup mail nil
240 "Modes for electronic-mail handling."
241 :group 'applications)
242
243(defgroup news nil
244 "Support for netnews reading and posting."
6ea2832e 245 :link '(custom-manual "(gnus)")
d543e20b
PA
246 :group 'applications)
247
248(defgroup games nil
249 "Games, jokes and amusements."
250 :group 'applications)
251
252(defgroup development nil
253 "Support for further development of Emacs."
254 :group 'emacs)
255
256(defgroup docs nil
257 "Support for Emacs documentation."
258 :group 'development)
259
260(defgroup extensions nil
261 "Emacs Lisp language extensions."
262 :group 'development)
263
264(defgroup internal nil
265 "Code for Emacs internals, build process, defaults."
266 :group 'development)
267
268(defgroup maint nil
269 "Maintenance aids for the Emacs development group."
270 :tag "Maintenance"
271 :group 'development)
272
273(defgroup environment nil
274 "Fitting Emacs with its environment."
275 :group 'emacs)
276
277(defgroup comm nil
278 "Communications, networking, remote access to files."
279 :tag "Communication"
280 :group 'environment)
281
282(defgroup hardware nil
283 "Support for interfacing with exotic hardware."
284 :group 'environment)
285
286(defgroup terminals nil
287 "Support for terminal types."
288 :group 'environment)
289
290(defgroup unix nil
291 "Front-ends/assistants for, or emulators of, UNIX features."
292 :group 'environment)
293
294(defgroup vms nil
295 "Support code for vms."
296 :group 'environment)
297
298(defgroup i18n nil
299 "Internationalization and alternate character-set support."
6ea2832e 300 :link '(custom-manual "(emacs)International")
d543e20b
PA
301 :group 'environment
302 :group 'editing)
303
86bd10bc
PA
304(defgroup x nil
305 "The X Window system."
306 :group 'environment)
307
d543e20b
PA
308(defgroup frames nil
309 "Support for Emacs frames and window systems."
310 :group 'environment)
311
312(defgroup data nil
313 "Support editing files of data."
314 :group 'emacs)
315
482e54f3
RS
316(defgroup files nil
317 "Support editing files."
318 :group 'emacs)
319
d543e20b
PA
320(defgroup wp nil
321 "Word processing."
322 :group 'emacs)
323
324(defgroup tex nil
325 "Code related to the TeX formatter."
326 :group 'wp)
327
328(defgroup faces nil
329 "Support for multiple fonts."
330 :group 'emacs)
331
332(defgroup hypermedia nil
333 "Support for links between text or other media types."
334 :group 'emacs)
335
336(defgroup help nil
337 "Support for on-line help systems."
338 :group 'emacs)
339
d3d4df42
DL
340(defgroup multimedia nil
341 "Non-textual support, specifically images and sound."
342 :group 'emacs)
343
d543e20b
PA
344(defgroup local nil
345 "Code local to your site."
346 :group 'emacs)
347
348(defgroup customize '((widgets custom-group))
349 "Customization of the Customization support."
d543e20b 350 :prefix "custom-"
bd042c03
PA
351 :group 'help)
352
353(defgroup custom-faces nil
354 "Faces used by customize."
355 :group 'customize
d543e20b
PA
356 :group 'faces)
357
da5ec617
PA
358(defgroup custom-browse nil
359 "Control customize browser."
360 :prefix "custom-"
361 :group 'customize)
362
6aaedd12 363(defgroup custom-buffer nil
da5ec617 364 "Control customize buffers."
6aaedd12
PA
365 :prefix "custom-"
366 :group 'customize)
367
368(defgroup custom-menu nil
da5ec617 369 "Control customize menus."
6aaedd12
PA
370 :prefix "custom-"
371 :group 'customize)
372
bd042c03
PA
373(defgroup abbrev-mode nil
374 "Word abbreviations mode."
6ea2832e 375 :link '(custom-manual "(emacs)Abbrevs")
bd042c03
PA
376 :group 'abbrev)
377
378(defgroup alloc nil
379 "Storage allocation and gc for GNU Emacs Lisp interpreter."
380 :tag "Storage Allocation"
381 :group 'internal)
382
383(defgroup undo nil
384 "Undoing changes in buffers."
6ea2832e 385 :link '(custom-manual "(emacs)Undo")
bd042c03
PA
386 :group 'editing)
387
388(defgroup modeline nil
389 "Content of the modeline."
390 :group 'environment)
391
bd042c03
PA
392(defgroup editing-basics nil
393 "Most basic editing facilities."
394 :group 'editing)
395
396(defgroup display nil
397 "How characters are displayed in buffers."
398 :group 'environment)
399
400(defgroup execute nil
401 "Executing external commands."
402 :group 'processes)
403
404(defgroup installation nil
405 "The Emacs installation."
406 :group 'environment)
407
408(defgroup dired nil
409 "Directory editing."
410 :group 'environment)
411
412(defgroup limits nil
413 "Internal Emacs limits."
414 :group 'internal)
415
416(defgroup debug nil
417 "Debugging Emacs itself."
418 :group 'development)
419
420(defgroup minibuffer nil
29a82d4c 421 "Controling the behavior of the minibuffer."
6ea2832e 422 :link '(custom-manual "(emacs)Minibuffer")
bd042c03
PA
423 :group 'environment)
424
425(defgroup keyboard nil
426 "Input from the keyboard."
427 :group 'environment)
428
429(defgroup mouse nil
430 "Input from the mouse."
431 :group 'environment)
432
433(defgroup menu nil
434 "Input from the menus."
435 :group 'environment)
436
153bd017
JD
437(defgroup dnd nil
438 "Handling data from drag and drop."
439 :group 'environment)
440
bd042c03
PA
441(defgroup auto-save nil
442 "Preventing accidential loss of data."
482e54f3 443 :group 'files)
bd042c03
PA
444
445(defgroup processes-basics nil
446 "Basic stuff dealing with processes."
447 :group 'processes)
448
25ac13b5
PA
449(defgroup mule nil
450 "MULE Emacs internationalization."
70bc91bc 451 :group 'i18n)
25ac13b5 452
bd042c03
PA
453(defgroup windows nil
454 "Windows within a frame."
6ea2832e 455 :link '(custom-manual "(emacs)Windows")
86bd10bc 456 :group 'environment)
bd042c03 457
d543e20b
PA
458;;; Utilities.
459
460(defun custom-quote (sexp)
461 "Quote SEXP iff it is not self quoting."
462 (if (or (memq sexp '(t nil))
2365594b 463 (keywordp sexp)
d543e20b
PA
464 (and (listp sexp)
465 (memq (car sexp) '(lambda)))
466 (stringp sexp)
467 (numberp sexp)
d3d4df42
DL
468 (vectorp sexp)
469;;; (and (fboundp 'characterp)
470;;; (characterp sexp))
471 )
d543e20b
PA
472 sexp
473 (list 'quote sexp)))
474
475(defun custom-split-regexp-maybe (regexp)
476 "If REGEXP is a string, split it to a list at `\\|'.
d3d4df42 477You can get the original back with from the result with:
d543e20b
PA
478 (mapconcat 'identity result \"\\|\")
479
480IF REGEXP is not a string, return it unchanged."
481 (if (stringp regexp)
482 (let ((start 0)
483 all)
484 (while (string-match "\\\\|" regexp start)
485 (setq all (cons (substring regexp start (match-beginning 0)) all)
486 start (match-end 0)))
487 (nreverse (cons (substring regexp start) all)))
488 regexp))
489
bd042c03 490(defun custom-variable-prompt ()
3a495e15 491 "Prompt for a custom variable, defaulting to the variable at point.
bd042c03
PA
492Return a list suitable for use in `interactive'."
493 (let ((v (variable-at-point))
494 (enable-recursive-minibuffers t)
495 val)
d3d4df42 496 (setq val (completing-read
3a495e15 497 (if (and (symbolp v) (custom-variable-p v))
5b76833f 498 (format "Customize option (default %s): " v)
3a495e15
MR
499 "Customize option: ")
500 obarray 'custom-variable-p t))
bd042c03 501 (list (if (equal val "")
5b5cdd97
RS
502 (if (symbolp v) v nil)
503 (intern val)))))
bd042c03 504
6d528fc5
PA
505(defun custom-menu-filter (menu widget)
506 "Convert MENU to the form used by `widget-choose'.
507MENU should be in the same format as `custom-variable-menu'.
508WIDGET is the widget to apply the filter entries of MENU on."
509 (let ((result nil)
510 current name action filter)
d3d4df42 511 (while menu
6d528fc5
PA
512 (setq current (car menu)
513 name (nth 0 current)
514 action (nth 1 current)
515 filter (nth 2 current)
516 menu (cdr menu))
517 (if (or (null filter) (funcall filter widget))
518 (push (cons name action) result)
519 (push name result)))
520 (nreverse result)))
521
bd042c03
PA
522;;; Unlispify.
523
d543e20b 524(defvar custom-prefix-list nil
2365594b 525 "List of prefixes that should be ignored by `custom-unlispify'.")
d543e20b
PA
526
527(defcustom custom-unlispify-menu-entries t
528 "Display menu entries as words instead of symbols if non nil."
6aaedd12 529 :group 'custom-menu
d543e20b
PA
530 :type 'boolean)
531
cda987f4
RS
532(defcustom custom-unlispify-remove-prefixes nil
533 "Non-nil means remove group prefixes from option names in buffer."
534 :group 'custom-menu
42b4edc5 535 :group 'custom-buffer
cda987f4
RS
536 :type 'boolean)
537
d543e20b 538(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
2365594b 539 "Convert SYMBOL into a menu entry."
d543e20b
PA
540 (cond ((not custom-unlispify-menu-entries)
541 (symbol-name symbol))
542 ((get symbol 'custom-tag)
543 (if no-suffix
544 (get symbol 'custom-tag)
545 (concat (get symbol 'custom-tag) "...")))
546 (t
d9f67134 547 (with-current-buffer (get-buffer-create " *Custom-Work*")
d543e20b
PA
548 (erase-buffer)
549 (princ symbol (current-buffer))
550 (goto-char (point-min))
3b2f3d30
SM
551 ;; FIXME: Boolean variables are not predicates, so they shouldn't
552 ;; end with `-p'. -stef
553 ;; (when (and (eq (get symbol 'custom-type) 'boolean)
554 ;; (re-search-forward "-p\\'" nil t))
555 ;; (replace-match "" t t)
556 ;; (goto-char (point-min)))
cda987f4
RS
557 (if custom-unlispify-remove-prefixes
558 (let ((prefixes custom-prefix-list)
559 prefix)
560 (while prefixes
561 (setq prefix (car prefixes))
562 (if (search-forward prefix (+ (point) (length prefix)) t)
d3d4df42 563 (progn
cda987f4
RS
564 (setq prefixes nil)
565 (delete-region (point-min) (point)))
566 (setq prefixes (cdr prefixes))))))
d543e20b
PA
567 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
568 (capitalize-region (point-min) (point-max))
d3d4df42 569 (unless no-suffix
d543e20b
PA
570 (goto-char (point-max))
571 (insert "..."))
572 (buffer-string)))))
573
574(defcustom custom-unlispify-tag-names t
575 "Display tag names as words instead of symbols if non nil."
6aaedd12 576 :group 'custom-buffer
d543e20b
PA
577 :type 'boolean)
578
579(defun custom-unlispify-tag-name (symbol)
2365594b 580 "Convert SYMBOL into a menu entry."
d543e20b
PA
581 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
582 (custom-unlispify-menu-entry symbol t)))
583
584(defun custom-prefix-add (symbol prefixes)
2365594b 585 "Add SYMBOL to list of ignored PREFIXES."
d543e20b
PA
586 (cons (or (get symbol 'custom-prefix)
587 (concat (symbol-name symbol) "-"))
588 prefixes))
589
bd042c03
PA
590;;; Guess.
591
592(defcustom custom-guess-name-alist
593 '(("-p\\'" boolean)
594 ("-hook\\'" hook)
595 ("-face\\'" face)
596 ("-file\\'" file)
597 ("-function\\'" function)
598 ("-functions\\'" (repeat function))
599 ("-list\\'" (repeat sexp))
600 ("-alist\\'" (repeat (cons sexp sexp))))
601 "Alist of (MATCH TYPE).
602
d3d4df42 603MATCH should be a regexp matching the name of a symbol, and TYPE should
bd042c03
PA
604be a widget suitable for editing the value of that symbol. The TYPE
605of the first entry where MATCH matches the name of the symbol will be
d3d4df42 606used.
bd042c03
PA
607
608This is used for guessing the type of variables not declared with
609customize."
610 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
d543e20b
PA
611 :group 'customize)
612
bd042c03
PA
613(defcustom custom-guess-doc-alist
614 '(("\\`\\*?Non-nil " boolean))
615 "Alist of (MATCH TYPE).
d543e20b 616
bd042c03
PA
617MATCH should be a regexp matching a documentation string, and TYPE
618should be a widget suitable for editing the value of a variable with
619that documentation string. The TYPE of the first entry where MATCH
620matches the name of the symbol will be used.
d543e20b 621
bd042c03
PA
622This is used for guessing the type of variables not declared with
623customize."
624 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
625 :group 'customize)
d543e20b 626
bd042c03
PA
627(defun custom-guess-type (symbol)
628 "Guess a widget suitable for editing the value of SYMBOL.
d3d4df42 629This is done by matching SYMBOL with `custom-guess-name-alist' and
bd042c03
PA
630if that fails, the doc string with `custom-guess-doc-alist'."
631 (let ((name (symbol-name symbol))
632 (names custom-guess-name-alist)
633 current found)
634 (while names
635 (setq current (car names)
636 names (cdr names))
637 (when (string-match (nth 0 current) name)
638 (setq found (nth 1 current)
639 names nil)))
640 (unless found
641 (let ((doc (documentation-property symbol 'variable-documentation))
642 (docs custom-guess-doc-alist))
d3d4df42 643 (when doc
bd042c03
PA
644 (while docs
645 (setq current (car docs)
646 docs (cdr docs))
647 (when (string-match (nth 0 current) doc)
648 (setq found (nth 1 current)
649 docs nil))))))
650 found))
d543e20b 651
25ac13b5
PA
652;;; Sorting.
653
da5ec617
PA
654(defcustom custom-browse-sort-alphabetically nil
655 "If non-nil, sort members of each customization group alphabetically."
656 :type 'boolean
657 :group 'custom-browse)
658
659(defcustom custom-browse-order-groups nil
660 "If non-nil, order group members within each customization group.
661If `first', order groups before non-groups.
662If `last', order groups after non-groups."
663 :type '(choice (const first)
664 (const last)
665 (const :tag "none" nil))
666 :group 'custom-browse)
667
c953515e
PA
668(defcustom custom-browse-only-groups nil
669 "If non-nil, show group members only within each customization group."
670 :type 'boolean
671 :group 'custom-browse)
672
477ca0e8 673(defcustom custom-buffer-sort-alphabetically nil
da5ec617 674 "If non-nil, sort members of each customization group alphabetically."
944c91b6 675 :type 'boolean
6aaedd12 676 :group 'custom-buffer)
25ac13b5 677
da5ec617
PA
678(defcustom custom-buffer-order-groups 'last
679 "If non-nil, order group members within each customization group.
680If `first', order groups before non-groups.
681If `last', order groups after non-groups."
682 :type '(choice (const first)
683 (const last)
684 (const :tag "none" nil))
6aaedd12 685 :group 'custom-buffer)
25ac13b5 686
944c91b6 687(defcustom custom-menu-sort-alphabetically nil
da5ec617 688 "If non-nil, sort members of each customization group alphabetically."
944c91b6 689 :type 'boolean
6aaedd12 690 :group 'custom-menu)
25ac13b5 691
da5ec617
PA
692(defcustom custom-menu-order-groups 'first
693 "If non-nil, order group members within each customization group.
694If `first', order groups before non-groups.
695If `last', order groups after non-groups."
696 :type '(choice (const first)
697 (const last)
698 (const :tag "none" nil))
6aaedd12
PA
699 :group 'custom-menu)
700
b4854a23
KH
701;;;###autoload (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
702
da5ec617
PA
703(defun custom-sort-items (items sort-alphabetically order-groups)
704 "Return a sorted copy of ITEMS.
705ITEMS should be a `custom-group' property.
706If SORT-ALPHABETICALLY non-nil, sort alphabetically.
707If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
708groups after non-groups, if nil do not order groups at all."
709 (sort (copy-sequence items)
710 (lambda (a b)
711 (let ((typea (nth 1 a)) (typeb (nth 1 b))
359476e0 712 (namea (nth 0 a)) (nameb (nth 0 b)))
da5ec617
PA
713 (cond ((not order-groups)
714 ;; Since we don't care about A and B order, maybe sort.
715 (when sort-alphabetically
716 (string-lessp namea nameb)))
717 ((eq typea 'custom-group)
718 ;; If B is also a group, maybe sort. Otherwise, order A and B.
719 (if (eq typeb 'custom-group)
720 (when sort-alphabetically
721 (string-lessp namea nameb))
722 (eq order-groups 'first)))
723 ((eq typeb 'custom-group)
724 ;; Since A cannot be a group, order A and B.
725 (eq order-groups 'last))
726 (sort-alphabetically
727 ;; Since A and B cannot be groups, sort.
728 (string-lessp namea nameb)))))))
25ac13b5 729
d543e20b
PA
730;;; Custom Mode Commands.
731
bd042c03
PA
732(defvar custom-options nil
733 "Customization widgets in the current buffer.")
734
ab678382 735(defun Custom-set ()
d543e20b
PA
736 "Set changes in all modified options."
737 (interactive)
738 (let ((children custom-options))
fadbdfea
DL
739 (mapc (lambda (child)
740 (when (eq (widget-get child :custom-state) 'modified)
741 (widget-apply child :custom-set)))
d543e20b
PA
742 children)))
743
ab678382 744(defun Custom-save ()
d543e20b
PA
745 "Set all modified group members and save them."
746 (interactive)
747 (let ((children custom-options))
fadbdfea
DL
748 (mapc (lambda (child)
749 (when (memq (widget-get child :custom-state)
750 '(modified set changed rogue))
751 (widget-apply child :custom-save)))
d543e20b
PA
752 children))
753 (custom-save-all))
754
d3d4df42 755(defvar custom-reset-menu
ab678382
RS
756 '(("Current" . Custom-reset-current)
757 ("Saved" . Custom-reset-saved)
19d63704 758 ("Erase Customization (use standard settings)" . Custom-reset-standard))
d543e20b
PA
759 "Alist of actions for the `Reset' button.
760The key is a string containing the name of the action, the value is a
2365594b 761Lisp function taking the widget as an element which will be called
d543e20b
PA
762when the action is chosen.")
763
764(defun custom-reset (event)
765 "Select item from reset menu."
766 (let* ((completion-ignore-case t)
767 (answer (widget-choose "Reset to"
768 custom-reset-menu
769 event)))
770 (if answer
771 (funcall answer))))
772
ab678382 773(defun Custom-reset-current (&rest ignore)
d543e20b
PA
774 "Reset all modified group members to their current value."
775 (interactive)
776 (let ((children custom-options))
fadbdfea 777 (mapc (lambda (widget)
1d58631a
MR
778 (if (memq (widget-get widget :custom-state)
779 '(modified changed))
780 (widget-apply widget :custom-reset-current)))
781 children)))
d543e20b 782
ab678382 783(defun Custom-reset-saved (&rest ignore)
d543e20b
PA
784 "Reset all modified or set group members to their saved value."
785 (interactive)
786 (let ((children custom-options))
fadbdfea 787 (mapc (lambda (widget)
1d58631a
MR
788 (if (memq (widget-get widget :custom-state)
789 '(modified set changed rogue))
790 (widget-apply widget :custom-reset-saved)))
791 children)))
d543e20b 792
ab678382 793(defun Custom-reset-standard (&rest ignore)
19d63704
RS
794 "Erase all customization (either current or saved) for the group members.
795The immediate result is to restore them to their standard settings.
796This operation eliminates any saved settings for the group members,
797making them as if they had never been customized at all."
d543e20b
PA
798 (interactive)
799 (let ((children custom-options))
fadbdfea 800 (mapc (lambda (widget)
4f985043 801 (and (widget-apply widget :custom-standard-value)
fadbdfea
DL
802 (if (memq (widget-get widget :custom-state)
803 '(modified set changed saved rogue))
804 (widget-apply widget :custom-reset-standard))))
d543e20b
PA
805 children)))
806
807;;; The Customize Commands
808
d3d4df42 809(defun custom-prompt-variable (prompt-var prompt-val &optional comment)
6d528fc5
PA
810 "Prompt for a variable and a value and return them as a list.
811PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
812prompt for the value. The %s escape in PROMPT-VAL is replaced with
813the name of the variable.
814
815If the variable has a `variable-interactive' property, that is used as if
816it were the arg to `interactive' (which see) to interactively read the value.
817
818If the variable has a `custom-type' property, it must be a widget and the
d3d4df42
DL
819`:prompt-value' property of that widget will be used for reading the value.
820
821If optional COMMENT argument is non nil, also prompt for a comment and return
822it as the third element in the list."
6d528fc5 823 (let* ((var (read-variable prompt-var))
d3d4df42
DL
824 (minibuffer-help-form '(describe-variable var))
825 (val
6d528fc5
PA
826 (let ((prop (get var 'variable-interactive))
827 (type (get var 'custom-type))
828 (prompt (format prompt-val var)))
829 (unless (listp type)
830 (setq type (list type)))
831 (cond (prop
832 ;; Use VAR's `variable-interactive' property
833 ;; as an interactive spec for prompting.
834 (call-interactively (list 'lambda '(arg)
835 (list 'interactive prop)
836 'arg)))
837 (type
838 (widget-prompt-value type
839 prompt
840 (if (boundp var)
841 (symbol-value var))
842 (not (boundp var))))
843 (t
d3d4df42
DL
844 (eval-minibuffer prompt))))))
845 (if comment
846 (list var val
847 (read-string "Comment: " (get var 'variable-comment)))
848 (list var val))))
6d528fc5
PA
849
850;;;###autoload
7ec8d2c6 851(defun customize-set-value (variable value &optional comment)
4f9b9060 852 "Set VARIABLE to VALUE, and return VALUE. VALUE is a Lisp object.
6d528fc5
PA
853
854If VARIABLE has a `variable-interactive' property, that is used as if
855it were the arg to `interactive' (which see) to interactively read the value.
856
857If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
858`:prompt-value' property of that widget will be used for reading the value.
859
860If given a prefix (or a COMMENT argument), also prompt for a comment."
6d528fc5 861 (interactive (custom-prompt-variable "Set variable: "
d3d4df42
DL
862 "Set %s to value: "
863 current-prefix-arg))
ee1f522d 864
d3d4df42 865 (cond ((string= comment "")
7ec8d2c6 866 (put variable 'variable-comment nil))
d3d4df42 867 (comment
7ec8d2c6
PJ
868 (put variable 'variable-comment comment)))
869 (set variable value))
6d528fc5
PA
870
871;;;###autoload
2365594b 872(defun customize-set-variable (variable value &optional comment)
4f9b9060
PA
873 "Set the default for VARIABLE to VALUE, and return VALUE.
874VALUE is a Lisp object.
6d528fc5
PA
875
876If VARIABLE has a `custom-set' property, that is used for setting
877VARIABLE, otherwise `set-default' is used.
878
879The `customized-value' property of the VARIABLE will be set to a list
880with a quoted VALUE as its sole list member.
881
882If VARIABLE has a `variable-interactive' property, that is used as if
883it were the arg to `interactive' (which see) to interactively read the value.
884
885If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
886`:prompt-value' property of that widget will be used for reading the value.
887
888If given a prefix (or a COMMENT argument), also prompt for a comment."
6d528fc5 889 (interactive (custom-prompt-variable "Set variable: "
d3d4df42
DL
890 "Set customized value for %s to: "
891 current-prefix-arg))
4f9b9060 892 (custom-load-symbol variable)
2365594b
DL
893 (funcall (or (get variable 'custom-set) 'set-default) variable value)
894 (put variable 'customized-value (list (custom-quote value)))
d3d4df42 895 (cond ((string= comment "")
2365594b
DL
896 (put variable 'variable-comment nil)
897 (put variable 'customized-variable-comment nil))
d3d4df42 898 (comment
2365594b 899 (put variable 'variable-comment comment)
4f9b9060
PA
900 (put variable 'customized-variable-comment comment)))
901 value)
6d528fc5 902
4ee1cf9f 903;;;###autoload
7ec8d2c6 904(defun customize-save-variable (variable value &optional comment)
4ee1cf9f 905 "Set the default for VARIABLE to VALUE, and save it for future sessions.
4f9b9060
PA
906Return VALUE.
907
4ee1cf9f
PA
908If VARIABLE has a `custom-set' property, that is used for setting
909VARIABLE, otherwise `set-default' is used.
910
911The `customized-value' property of the VARIABLE will be set to a list
912with a quoted VALUE as its sole list member.
913
914If VARIABLE has a `variable-interactive' property, that is used as if
915it were the arg to `interactive' (which see) to interactively read the value.
916
917If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
918`:prompt-value' property of that widget will be used for reading the value.
919
920If given a prefix (or a COMMENT argument), also prompt for a comment."
901cd78b 921 (interactive (custom-prompt-variable "Set and save variable: "
d3d4df42
DL
922 "Set and save value for %s as: "
923 current-prefix-arg))
7ec8d2c6
PJ
924 (funcall (or (get variable 'custom-set) 'set-default) variable value)
925 (put variable 'saved-value (list (custom-quote value)))
c942535f 926 (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
d3d4df42 927 (cond ((string= comment "")
7ec8d2c6
PJ
928 (put variable 'variable-comment nil)
929 (put variable 'saved-variable-comment nil))
d3d4df42 930 (comment
7ec8d2c6
PJ
931 (put variable 'variable-comment comment)
932 (put variable 'saved-variable-comment comment)))
4f9b9060
PA
933 (custom-save-all)
934 value)
4ee1cf9f 935
d543e20b 936;;;###autoload
5dd0cad0
RS
937(defun customize ()
938 "Select a customization buffer which you can use to set user options.
939User options are structured into \"groups\".
940Initially the top-level group `Emacs' and its immediate subgroups
941are shown; the contents of those subgroups are initially hidden."
942 (interactive)
dc2e979f 943 (customize-group 'emacs))
5dd0cad0 944
87434e7a
SM
945;;;###autoload
946(defun customize-mode (mode)
947 "Customize options related to the current major mode.
948If a prefix \\[universal-argument] was given (or if the current major mode has no known group),
949then prompt for the MODE to customize."
950 (interactive
951 (list
952 (let ((completion-regexp-list '("-mode\\'"))
953 (group (custom-group-of-mode major-mode)))
954 (if (and group (not current-prefix-arg))
955 major-mode
956 (intern
957 (completing-read (if group
958 (format "Major mode (default %s): " major-mode)
959 "Major mode: ")
960 obarray
961 'custom-group-of-mode
962 t nil nil (if group (symbol-name major-mode))))))))
963 (customize-group (custom-group-of-mode mode)))
964
965
5dd0cad0
RS
966;;;###autoload
967(defun customize-group (group)
968 "Customize GROUP, which must be a customization group."
07e694f8 969 (interactive (list (let ((completion-ignore-case t))
5b76833f 970 (completing-read "Customize group (default emacs): "
d3d4df42 971 obarray
07e694f8 972 (lambda (symbol)
5aa3f181
RS
973 (or (get symbol 'custom-loads)
974 (get symbol 'custom-group)))
07e694f8 975 t))))
5dd0cad0
RS
976 (when (stringp group)
977 (if (string-equal "" group)
978 (setq group 'emacs)
979 (setq group (intern group))))
241d3080
RS
980 (let ((name (format "*Customize Group: %s*"
981 (custom-unlispify-tag-name group))))
982 (if (get-buffer name)
b4854a23 983 (pop-to-buffer name)
241d3080 984 (custom-buffer-create (list (list group 'custom-group))
3aec85bf
RS
985 name
986 (concat " for group "
987 (custom-unlispify-tag-name group))))))
d543e20b 988
6d528fc5 989;;;###autoload
fd88fe73
RS
990(defun customize-group-other-window (group)
991 "Customize GROUP, which must be a customization group."
992 (interactive (list (let ((completion-ignore-case t))
5b76833f 993 (completing-read "Customize group (default emacs): "
d3d4df42 994 obarray
fd88fe73
RS
995 (lambda (symbol)
996 (or (get symbol 'custom-loads)
997 (get symbol 'custom-group)))
998 t))))
999 (when (stringp group)
1000 (if (string-equal "" group)
1001 (setq group 'emacs)
1002 (setq group (intern group))))
fd88fe73
RS
1003 (let ((name (format "*Customize Group: %s*"
1004 (custom-unlispify-tag-name group))))
1005 (if (get-buffer name)
5f97a49d 1006 (let (
ffec8c5a
MR
1007 ;; Copied from `custom-buffer-create-other-window'.
1008 (pop-up-windows t)
ffec8c5a
MR
1009 (same-window-buffer-names nil)
1010 (same-window-regexps nil))
5f97a49d 1011 (pop-to-buffer name))
fd88fe73
RS
1012 (custom-buffer-create-other-window
1013 (list (list group 'custom-group))
1014 name
1015 (concat " for group "
1016 (custom-unlispify-tag-name group))))))
6d528fc5 1017
9097aeb7
PA
1018;;;###autoload
1019(defalias 'customize-variable 'customize-option)
38d58078 1020
d543e20b 1021;;;###autoload
38d58078
RS
1022(defun customize-option (symbol)
1023 "Customize SYMBOL, which must be a user option variable."
bd042c03 1024 (interactive (custom-variable-prompt))
dcb380c0
LT
1025 (let ((basevar (indirect-variable symbol)))
1026 (custom-buffer-create (list (list basevar 'custom-variable))
1027 (format "*Customize Option: %s*"
1028 (custom-unlispify-tag-name basevar)))
1029 (unless (eq symbol basevar)
1030 (message "`%s' is an alias for `%s'" symbol basevar))))
d543e20b 1031
ffec8c5a
MR
1032;;;###autoload
1033(defalias 'customize-variable-other-window 'customize-option-other-window)
1034
1035;;;###autoload
1036(defun customize-option-other-window (symbol)
1037 "Customize SYMBOL, which must be a user option variable.
1038Show the buffer in another window, but don't select it."
1039 (interactive (custom-variable-prompt))
dcb380c0
LT
1040 (let ((basevar (indirect-variable symbol)))
1041 (custom-buffer-create-other-window
1042 (list (list basevar 'custom-variable))
1043 (format "*Customize Option: %s*" (custom-unlispify-tag-name basevar)))
1044 (unless (eq symbol basevar)
1045 (message "`%s' is an alias for `%s'" symbol basevar))))
ffec8c5a 1046
e418be26
KH
1047(defvar customize-changed-options-previous-release "20.2"
1048 "Version for `customize-changed-options' to refer back to by default.")
1049
c32de15e 1050;;;###autoload
f50dc5d2 1051(defun customize-changed-options (since-version)
e418be26
KH
1052 "Customize all user option variables changed in Emacs itself.
1053This includes new user option variables and faces, and new
1054customization groups, as well as older options and faces whose default
1055values have changed since the previous major Emacs release.
1056
1057With argument SINCE-VERSION (a string), customize all user option
1058variables that were added (or their meanings were changed) since that
2ee398c4 1059version."
e418be26 1060
f50dc5d2
KH
1061 (interactive "sCustomize options changed, since version (default all versions): ")
1062 (if (equal since-version "")
26c67de8
DL
1063 (setq since-version nil)
1064 (unless (condition-case nil
1065 (numberp (read since-version))
1066 (error nil))
1067 (signal 'wrong-type-argument (list 'numberp since-version))))
e418be26
KH
1068 (unless since-version
1069 (setq since-version customize-changed-options-previous-release))
cba752d0
MR
1070
1071 ;; Load the information for versions since since-version. We use
1072 ;; custom-load-symbol for this.
1073 (put 'custom-versions-load-alist 'custom-loads nil)
1074 (dolist (elt custom-versions-load-alist)
2ee398c4
MR
1075 (if (customize-version-lessp since-version (car elt))
1076 (dolist (load (cdr elt))
1077 (custom-add-load 'custom-versions-load-alist load))))
cba752d0
MR
1078 (custom-load-symbol 'custom-versions-load-alist)
1079 (put 'custom-versions-load-alist 'custom-loads nil)
1080
1081 (let (found)
1082 (mapatoms
1083 (lambda (symbol)
1084 (let ((version (get symbol 'custom-version)))
1085 (if version
1086 (when (customize-version-lessp since-version version)
1087 (if (or (get symbol 'custom-group)
1088 (get symbol 'group-documentation))
1089 (push (list symbol 'custom-group) found))
1090 (if (custom-variable-p symbol)
1091 (push (list symbol 'custom-variable) found))
1092 (if (custom-facep symbol)
1093 (push (list symbol 'custom-face) found)))))))
1094 (if found
1095 (custom-buffer-create (custom-sort-items found t 'first)
1096 "*Customize Changed Options*")
1097 (error "No user option defaults have been changed since Emacs %s"
1098 since-version))))
f50dc5d2
KH
1099
1100(defun customize-version-lessp (version1 version2)
26c67de8
DL
1101 ;; Why are the versions strings, and given that they are, why aren't
1102 ;; they converted to numbers and compared as such here? -- fx
1103
e418be26
KH
1104 ;; In case someone made a mistake and left out the quotes
1105 ;; in the :version value.
1106 (if (numberp version2)
1107 (setq version2 (prin1-to-string version2)))
f50dc5d2 1108 (let (major1 major2 minor1 minor2)
26c67de8
DL
1109 (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version1)
1110 (setq major1 (read (or (match-string 1 version1)
1111 "0")))
1112 (setq minor1 (read (or (match-string 3 version1)
1113 "0")))
1114 (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version2)
1115 (setq major2 (read (or (match-string 1 version2)
1116 "0")))
1117 (setq minor2 (read (or (match-string 3 version2)
1118 "0")))
f50dc5d2
KH
1119 (or (< major1 major2)
1120 (and (= major1 major2)
1121 (< minor1 minor2)))))
c942535f 1122
d543e20b 1123;;;###autoload
cdd50dea 1124(defun customize-face (&optional face)
3127aa13 1125 "Customize FACE, which should be a face name or nil.
c40f3193
GM
1126If FACE is nil, customize all faces. If FACE is actually a
1127face-alias, customize the face it is aliased to.
d29a536a
GM
1128
1129Interactively, when point is on text which has a face specified,
3127aa13 1130suggest to customize that face, if it's customizable."
d29a536a 1131 (interactive
cdd50dea
RS
1132 (list (read-face-name "Customize face" "all faces" t)))
1133 (if (member face '(nil ""))
1134 (setq face (face-list)))
1135 (if (and (listp face) (null (cdr face)))
1136 (setq face (car face)))
1137 (if (listp face)
da5ec617 1138 (custom-buffer-create (custom-sort-items
cdd50dea
RS
1139 (mapcar (lambda (s)
1140 (list s 'custom-face))
1141 face)
da5ec617
PA
1142 t nil)
1143 "*Customize Faces*")
c40f3193
GM
1144 ;; If FACE is actually an alias, customize the face it is aliased to.
1145 (if (get face 'face-alias)
1146 (setq face (get face 'face-alias)))
cdd50dea 1147 (unless (facep face)
b59b77f1 1148 (error "Invalid face %S" face))
cdd50dea 1149 (custom-buffer-create (list (list face 'custom-face))
86bd10bc 1150 (format "*Customize Face: %s*"
cdd50dea 1151 (custom-unlispify-tag-name face)))))
d543e20b 1152
bd042c03 1153;;;###autoload
701f49d2 1154(defun customize-face-other-window (&optional face)
3127aa13 1155 "Show customization buffer for face FACE in other window.
c40f3193 1156If FACE is actually a face-alias, customize the face it is aliased to.
d29a536a
GM
1157
1158Interactively, when point is on text which has a face specified,
3127aa13 1159suggest to customize that face, if it's customizable."
d29a536a 1160 (interactive
501d8923
RS
1161 (list (read-face-name "Customize face" "all faces" t)))
1162 (if (member face '(nil ""))
1163 (setq face (face-list)))
1164 (if (and (listp face) (null (cdr face)))
1165 (setq face (car face)))
1166 (if (listp face)
1167 (custom-buffer-create-other-window
1168 (custom-sort-items
1169 (mapcar (lambda (s)
1170 (list s 'custom-face))
1171 face)
1172 t nil)
1173 "*Customize Faces*")
c40f3193
GM
1174 (if (get face 'face-alias)
1175 (setq face (get face 'face-alias)))
501d8923 1176 (unless (facep face)
b59b77f1 1177 (error "Invalid face %S" face))
d3d4df42 1178 (custom-buffer-create-other-window
501d8923
RS
1179 (list (list face 'custom-face))
1180 (format "*Customize Face: %s*"
1181 (custom-unlispify-tag-name face)))))
bd042c03 1182
d543e20b
PA
1183;;;###autoload
1184(defun customize-customized ()
6d528fc5
PA
1185 "Customize all user options set since the last save in this session."
1186 (interactive)
1187 (let ((found nil))
1188 (mapatoms (lambda (symbol)
d3d4df42
DL
1189 (and (or (get symbol 'customized-face)
1190 (get symbol 'customized-face-comment))
6d528fc5 1191 (custom-facep symbol)
a1a4fa22 1192 (push (list symbol 'custom-face) found))
d3d4df42
DL
1193 (and (or (get symbol 'customized-value)
1194 (get symbol 'customized-variable-comment))
6d528fc5 1195 (boundp symbol)
a1a4fa22 1196 (push (list symbol 'custom-variable) found))))
da5ec617
PA
1197 (if (not found)
1198 (error "No customized user options")
1199 (custom-buffer-create (custom-sort-items found t nil)
1200 "*Customize Customized*"))))
6d528fc5
PA
1201
1202;;;###autoload
963c2e09
PA
1203(defun customize-rogue ()
1204 "Customize all user variable modified outside customize."
1205 (interactive)
1206 (let ((found nil))
1207 (mapatoms (lambda (symbol)
1208 (let ((cval (or (get symbol 'customized-value)
1209 (get symbol 'saved-value)
1210 (get symbol 'standard-value))))
1211 (when (and cval ;Declared with defcustom.
1212 (default-boundp symbol) ;Has a value.
3127aa13 1213 (not (equal (eval (car cval))
963c2e09
PA
1214 ;; Which does not match customize.
1215 (default-value symbol))))
1216 (push (list symbol 'custom-variable) found)))))
1217 (if (not found)
1218 (error "No rogue user options")
1219 (custom-buffer-create (custom-sort-items found t nil)
1220 "*Customize Rogue*"))))
1221;;;###autoload
6d528fc5
PA
1222(defun customize-saved ()
1223 "Customize all already saved user options."
d543e20b
PA
1224 (interactive)
1225 (let ((found nil))
1226 (mapatoms (lambda (symbol)
d3d4df42
DL
1227 (and (or (get symbol 'saved-face)
1228 (get symbol 'saved-face-comment))
d543e20b 1229 (custom-facep symbol)
a1a4fa22 1230 (push (list symbol 'custom-face) found))
d3d4df42
DL
1231 (and (or (get symbol 'saved-value)
1232 (get symbol 'saved-variable-comment))
d543e20b 1233 (boundp symbol)
a1a4fa22 1234 (push (list symbol 'custom-variable) found))))
da5ec617
PA
1235 (if (not found )
1236 (error "No saved user options")
1237 (custom-buffer-create (custom-sort-items found t nil)
1238 "*Customize Saved*"))))
d543e20b
PA
1239
1240;;;###autoload
1241(defun customize-apropos (regexp &optional all)
1242 "Customize all user options matching REGEXP.
a1a4fa22
PA
1243If ALL is `options', include only options.
1244If ALL is `faces', include only faces.
1245If ALL is `groups', include only groups.
1246If ALL is t (interactively, with prefix arg), include options which are not
1247user-settable, as well as faces and groups."
d543e20b
PA
1248 (interactive "sCustomize regexp: \nP")
1249 (let ((found nil))
1250 (mapatoms (lambda (symbol)
1251 (when (string-match regexp (symbol-name symbol))
a1a4fa22
PA
1252 (when (and (not (memq all '(faces options)))
1253 (get symbol 'custom-group))
1254 (push (list symbol 'custom-group) found))
1255 (when (and (not (memq all '(options groups)))
1256 (custom-facep symbol))
1257 (push (list symbol 'custom-face) found))
1258 (when (and (not (memq all '(groups faces)))
1259 (boundp symbol)
d543e20b 1260 (or (get symbol 'saved-value)
3a495e15 1261 (custom-variable-p symbol)
a1a4fa22
PA
1262 (if (memq all '(nil options))
1263 (user-variable-p symbol)
1264 (get symbol 'variable-documentation))))
1265 (push (list symbol 'custom-variable) found)))))
1266 (if (not found)
1267 (error "No matches")
da5ec617
PA
1268 (custom-buffer-create (custom-sort-items found t
1269 custom-buffer-order-groups)
1270 "*Customize Apropos*"))))
a1a4fa22
PA
1271
1272;;;###autoload
1273(defun customize-apropos-options (regexp &optional arg)
1274 "Customize all user options matching REGEXP.
1275With prefix arg, include options which are not user-settable."
1276 (interactive "sCustomize regexp: \nP")
1277 (customize-apropos regexp (or arg 'options)))
1278
1279;;;###autoload
1280(defun customize-apropos-faces (regexp)
1281 "Customize all user faces matching REGEXP."
1282 (interactive "sCustomize regexp: \n")
1283 (customize-apropos regexp 'faces))
1284
1285;;;###autoload
1286(defun customize-apropos-groups (regexp)
1287 "Customize all user groups matching REGEXP."
1288 (interactive "sCustomize regexp: \n")
1289 (customize-apropos regexp 'groups))
d543e20b 1290
6d528fc5
PA
1291;;; Buffer.
1292
944c91b6
PA
1293(defcustom custom-buffer-style 'links
1294 "Control the presentation style for customization buffers.
1295The value should be a symbol, one of:
1296
1297brackets: groups nest within each other with big horizontal brackets.
1298links: groups have links to subgroups."
1299 :type '(radio (const brackets)
1300 (const links))
1301 :group 'custom-buffer)
1302
97733c3d
RS
1303(defcustom custom-buffer-done-kill nil
1304 "*Non-nil means exiting a Custom buffer should kill it."
1305 :type 'boolean
bf247b6e 1306 :version "22.1"
d3d4df42
DL
1307 :group 'custom-buffer)
1308
944c91b6
PA
1309(defcustom custom-buffer-indent 3
1310 "Number of spaces to indent nested groups."
1311 :type 'integer
1312 :group 'custom-buffer)
1313
40627755
SM
1314(defun custom-get-fresh-buffer (name)
1315 "Get a fresh new buffer with name NAME.
a153acb7
SM
1316If the buffer already exist, clean it up to be like new.
1317Beware: it's not quite like new. Good enough for custom, but maybe
1318not for everybody."
1319 ;; To be more complete, we should also kill all permanent-local variables,
1320 ;; but it's not needed for custom.
40627755 1321 (let ((buf (get-buffer name)))
fd1c38f4 1322 (when (and buf (buffer-local-value 'buffer-file-name buf))
a153acb7
SM
1323 ;; This will check if the file is not saved.
1324 (kill-buffer buf)
1325 (setq buf nil))
40627755
SM
1326 (if (null buf)
1327 (get-buffer-create name)
1328 (with-current-buffer buf
1329 (kill-all-local-variables)
a153acb7 1330 (run-hooks 'kill-buffer-hook)
f5a9b180
SM
1331 ;; Delete overlays before erasing the buffer so the overlay hooks
1332 ;; don't get run spuriously when we erase the buffer.
40627755
SM
1333 (let ((ols (overlay-lists)))
1334 (dolist (ol (nconc (car ols) (cdr ols)))
1335 (delete-overlay ol)))
f5a9b180 1336 (erase-buffer)
40627755
SM
1337 buf))))
1338
d543e20b 1339;;;###autoload
3aec85bf 1340(defun custom-buffer-create (options &optional name description)
d543e20b 1341 "Create a buffer containing OPTIONS.
86bd10bc 1342Optional NAME is the name of the buffer.
d543e20b
PA
1343OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
1344SYMBOL is a customization option, and WIDGET is a widget for editing
1345that option."
40627755 1346 (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*")))
3aec85bf 1347 (custom-buffer-create-internal options description))
bd042c03 1348
6d528fc5 1349;;;###autoload
3aec85bf 1350(defun custom-buffer-create-other-window (options &optional name description)
5f97a49d
RS
1351 "Create a buffer containing OPTIONS, and display it in another window.
1352The result includes selecting that window.
86bd10bc 1353Optional NAME is the name of the buffer.
bd042c03
PA
1354OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
1355SYMBOL is a customization option, and WIDGET is a widget for editing
1356that option."
86bd10bc 1357 (unless name (setq name "*Customization*"))
5f97a49d 1358 (let ((pop-up-windows t)
b4854a23
KH
1359 (same-window-buffer-names nil)
1360 (same-window-regexps nil))
40627755 1361 (pop-to-buffer (custom-get-fresh-buffer name))
5f97a49d 1362 (custom-buffer-create-internal options description)))
9097aeb7
PA
1363
1364(defcustom custom-reset-button-menu nil
1365 "If non-nil, only show a single reset button in customize buffers.
1366This button will have a menu with all three reset operations."
1367 :type 'boolean
6aaedd12 1368 :group 'custom-buffer)
bd042c03 1369
c42c5c7c
KS
1370(defcustom custom-buffer-verbose-help t
1371 "If non-nil, include explanatory text in the customization buffer."
1372 :type 'boolean
1373 :group 'custom-buffer)
1374
d3d4df42 1375(defun Custom-buffer-done (&rest ignore)
97733c3d 1376 "Exit current Custom buffer according to `custom-buffer-done-kill'."
d3d4df42 1377 (interactive)
97733c3d 1378 (quit-window custom-buffer-done-kill))
d3d4df42 1379
87911bdb
CY
1380(defvar custom-button nil
1381 "Face used for buttons in customization buffers.")
1382
1383(defvar custom-button-pressed nil
1384 "Face used for pressed buttons in customization buffers.")
1385
d3d4df42
DL
1386(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
1387 '(("unspecified" . unspecified))))
1388 "If non-nil, indicate active buttons in a `raised-button' style.
1389Otherwise use brackets."
1390 :type 'boolean
1391 :version "21.1"
87911bdb
CY
1392 :group 'custom-buffer
1393 :set (lambda (variable value)
1394 (custom-set-default variable value)
1395 (setq custom-button
1396 (if value 'custom-button 'custom-button-unraised))
1397 (setq custom-button-pressed
1398 (if value
1399 'custom-button-pressed
1400 'custom-button-pressed-unraised))))
d3d4df42 1401
3aec85bf 1402(defun custom-buffer-create-internal (options &optional description)
d543e20b 1403 (custom-mode)
c42c5c7c
KS
1404 (if custom-buffer-verbose-help
1405 (progn
1406 (widget-insert "This is a customization buffer")
1407 (if description
1408 (widget-insert description))
1409 (widget-insert (format ".
d3d4df42 1410%s show active fields; type RET or click mouse-1
3aec85bf 1411on an active field to invoke its action. Editing an option value
167eefc5
LT
1412changes only the text in the buffer. Invoke the State button to set or
1413save the option value. Saving an option normally edits your init file.
1414Invoke "
1415 (if custom-raised-buttons
1416 "`Raised' buttons"
1417 "Square brackets")))
1418 (widget-create 'info-link
1419 :tag "Custom file"
1420 "(emacs)Saving Customizations")
1421 (widget-insert
1422 " for information on how to save in a different file.
1423Invoke ")
c42c5c7c
KS
1424 (widget-create 'info-link
1425 :tag "Help"
1426 :help-echo "Read the online help."
1427 "(emacs)Easy Customization")
167eefc5 1428 (widget-insert " for general information.\n\n")
c42c5c7c
KS
1429 (widget-insert "Operate on everything in this buffer:\n "))
1430 (widget-insert " "))
25ac13b5 1431 (widget-create 'push-button
0f3335c0 1432 :tag "Set for Current Session"
b62c92bb
RS
1433 :help-echo "\
1434Make your editing in this buffer take effect for this session."
25ac13b5 1435 :action (lambda (widget &optional event)
ab678382 1436 (Custom-set)))
25ac13b5
PA
1437 (widget-insert " ")
1438 (widget-create 'push-button
0f3335c0 1439 :tag "Save for Future Sessions"
25ac13b5 1440 :help-echo "\
9f5d3236 1441Make your editing in this buffer take effect for future Emacs sessions.
470cefd3 1442This updates your Emacs initialization file or creates a new one."
25ac13b5 1443 :action (lambda (widget &optional event)
ab678382 1444 (Custom-save)))
9097aeb7 1445 (if custom-reset-button-menu
0f3335c0
RS
1446 (progn
1447 (widget-insert " ")
1448 (widget-create 'push-button
1449 :tag "Reset"
1450 :help-echo "Show a menu with reset operations."
1451 :mouse-down-action (lambda (&rest junk) t)
1452 :action (lambda (widget &optional event)
1453 (custom-reset event))))
1454 (widget-insert "\n ")
9097aeb7
PA
1455 (widget-create 'push-button
1456 :tag "Reset"
c32de15e 1457 :help-echo "\
b62c92bb 1458Reset all edited text in this buffer to reflect current values."
ab678382 1459 :action 'Custom-reset-current)
9097aeb7
PA
1460 (widget-insert " ")
1461 (widget-create 'push-button
1462 :tag "Reset to Saved"
c32de15e 1463 :help-echo "\
b62c92bb 1464Reset all values in this buffer to their saved settings."
ab678382 1465 :action 'Custom-reset-saved)
9097aeb7
PA
1466 (widget-insert " ")
1467 (widget-create 'push-button
19d63704 1468 :tag "Erase Customization"
c32de15e 1469 :help-echo "\
19d63704 1470Un-customize all values in this buffer. They get their standard settings."
ab678382 1471 :action 'Custom-reset-standard))
c42c5c7c
KS
1472 (if (not custom-buffer-verbose-help)
1473 (progn
1474 (widget-insert " ")
1475 (widget-create 'info-link
1476 :tag "Help"
1477 :help-echo "Read the online help."
1478 "(emacs)Easy Customization")))
0eef62d5 1479 (widget-insert " ")
25ac13b5 1480 (widget-create 'push-button
d3d4df42 1481 :tag "Finish"
91a38db1
DL
1482 :help-echo
1483 (lambda (&rest ignore)
97733c3d
RS
1484 (if custom-buffer-done-kill
1485 "Kill this buffer"
1486 "Bury this buffer"))
d3d4df42 1487 :action #'Custom-buffer-done)
25ac13b5
PA
1488 (widget-insert "\n\n")
1489 (message "Creating customization items...")
fadbdfea 1490 (buffer-disable-undo)
d3d4df42 1491 (setq custom-options
d543e20b
PA
1492 (if (= (length options) 1)
1493 (mapcar (lambda (entry)
1494 (widget-create (nth 1 entry)
c32de15e 1495 :documentation-shown t
d543e20b
PA
1496 :custom-state 'unknown
1497 :tag (custom-unlispify-tag-name
1498 (nth 0 entry))
1499 :value (nth 0 entry)))
1500 options)
1501 (let ((count 0)
1502 (length (length options)))
1503 (mapcar (lambda (entry)
6b292312
DL
1504 (prog2
1505 (message "Creating customization items ...%2d%%"
1506 (/ (* 100.0 count) length))
1507 (widget-create (nth 1 entry)
d543e20b
PA
1508 :tag (custom-unlispify-tag-name
1509 (nth 0 entry))
1510 :value (nth 0 entry))
6b292312
DL
1511 (setq count (1+ count))
1512 (unless (eq (preceding-char) ?\n)
1513 (widget-insert "\n"))
1514 (widget-insert "\n")))
1515 options))))
d543e20b
PA
1516 (unless (eq (preceding-char) ?\n)
1517 (widget-insert "\n"))
a9bcbf3f 1518 (message "Creating customization items ...done")
1833b7b3 1519 (message "Resetting customization items...")
944c91b6 1520 (unless (eq custom-buffer-style 'tree)
fadbdfea 1521 (mapc 'custom-magic-reset custom-options))
1833b7b3 1522 (message "Resetting customization items...done")
d543e20b
PA
1523 (message "Creating customization setup...")
1524 (widget-setup)
fadbdfea 1525 (buffer-enable-undo)
d543e20b 1526 (goto-char (point-min))
1833b7b3 1527 (message "Creating customization setup...done"))
d543e20b 1528
944c91b6
PA
1529;;; The Tree Browser.
1530
1531;;;###autoload
4ee1cf9f 1532(defun customize-browse (&optional group)
944c91b6 1533 "Create a tree browser for the customize hierarchy."
cda987f4 1534 (interactive)
4ee1cf9f
PA
1535 (unless group
1536 (setq group 'emacs))
1537 (let ((name "*Customize Browser*"))
40627755 1538 (pop-to-buffer (custom-get-fresh-buffer name)))
4ee1cf9f
PA
1539 (custom-mode)
1540 (widget-insert "\
cda987f4
RS
1541Square brackets show active fields; type RET or click mouse-1
1542on an active field to invoke its action.
df816618 1543Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
4ee1cf9f
PA
1544 (if custom-browse-only-groups
1545 (widget-insert "\
c953515e 1546Invoke the [Group] button below to edit that item in another window.\n\n")
d3d4df42
DL
1547 (widget-insert "Invoke the ")
1548 (widget-create 'item
4ee1cf9f
PA
1549 :format "%t"
1550 :tag "[Group]"
1551 :tag-glyph "folder")
1552 (widget-insert ", ")
d3d4df42 1553 (widget-create 'item
4ee1cf9f
PA
1554 :format "%t"
1555 :tag "[Face]"
1556 :tag-glyph "face")
1557 (widget-insert ", and ")
d3d4df42 1558 (widget-create 'item
4ee1cf9f
PA
1559 :format "%t"
1560 :tag "[Option]"
1561 :tag-glyph "option")
1562 (widget-insert " buttons below to edit that
c953515e 1563item in another window.\n\n"))
4ee1cf9f 1564 (let ((custom-buffer-style 'tree))
d3d4df42 1565 (widget-create 'custom-group
4ee1cf9f
PA
1566 :custom-last t
1567 :custom-state 'unknown
1568 :tag (custom-unlispify-tag-name group)
1569 :value group))
f134b461 1570 (widget-setup)
4ee1cf9f 1571 (goto-char (point-min)))
944c91b6 1572
c953515e 1573(define-widget 'custom-browse-visibility 'item
1edec9cf 1574 "Control visibility of items in the customize tree browser."
da5ec617 1575 :format "%[[%t]%]"
c953515e 1576 :action 'custom-browse-visibility-action)
944c91b6 1577
c953515e 1578(defun custom-browse-visibility-action (widget &rest ignore)
944c91b6
PA
1579 (let ((custom-buffer-style 'tree))
1580 (custom-toggle-parent widget)))
1581
c953515e 1582(define-widget 'custom-browse-group-tag 'push-button
944c91b6 1583 "Show parent in other window when activated."
cd6c0940 1584 :tag "Group"
da5ec617 1585 :tag-glyph "folder"
c953515e 1586 :action 'custom-browse-group-tag-action)
944c91b6 1587
c953515e 1588(defun custom-browse-group-tag-action (widget &rest ignore)
944c91b6
PA
1589 (let ((parent (widget-get widget :parent)))
1590 (customize-group-other-window (widget-value parent))))
1591
c953515e 1592(define-widget 'custom-browse-variable-tag 'push-button
944c91b6 1593 "Show parent in other window when activated."
cd6c0940 1594 :tag "Option"
da5ec617 1595 :tag-glyph "option"
c953515e 1596 :action 'custom-browse-variable-tag-action)
944c91b6 1597
c953515e 1598(defun custom-browse-variable-tag-action (widget &rest ignore)
944c91b6
PA
1599 (let ((parent (widget-get widget :parent)))
1600 (customize-variable-other-window (widget-value parent))))
1601
c953515e 1602(define-widget 'custom-browse-face-tag 'push-button
944c91b6 1603 "Show parent in other window when activated."
cd6c0940 1604 :tag "Face"
da5ec617 1605 :tag-glyph "face"
c953515e 1606 :action 'custom-browse-face-tag-action)
944c91b6 1607
c953515e 1608(defun custom-browse-face-tag-action (widget &rest ignore)
944c91b6
PA
1609 (let ((parent (widget-get widget :parent)))
1610 (customize-face-other-window (widget-value parent))))
1611
c953515e 1612(defconst custom-browse-alist '((" " "space")
da5ec617
PA
1613 (" | " "vertical")
1614 ("-\\ " "top")
1615 (" |-" "middle")
1616 (" `-" "bottom")))
1617
c953515e 1618(defun custom-browse-insert-prefix (prefix)
da5ec617 1619 "Insert PREFIX. On XEmacs convert it to line graphics."
d3d4df42 1620 ;; Fixme: do graphics.
da5ec617 1621 (if nil ; (string-match "XEmacs" emacs-version)
d3d4df42 1622 (progn
da5ec617
PA
1623 (insert "*")
1624 (while (not (string-equal prefix ""))
1625 (let ((entry (substring prefix 0 3)))
1626 (setq prefix (substring prefix 3))
1627 (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
c953515e 1628 (name (nth 1 (assoc entry custom-browse-alist))))
da5ec617
PA
1629 (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
1630 (overlay-put overlay 'start-open t)
1631 (overlay-put overlay 'end-open t)))))
1632 (insert prefix)))
1633
d543e20b
PA
1634;;; Modification of Basic Widgets.
1635;;
1636;; We add extra properties to the basic widgets needed here. This is
1637;; fine, as long as we are careful to stay within out own namespace.
1638;;
1639;; We want simple widgets to be displayed by default, but complex
1640;; widgets to be hidden.
1641
1642(widget-put (get 'item 'widget-type) :custom-show t)
1643(widget-put (get 'editable-field 'widget-type)
1644 :custom-show (lambda (widget value)
1645 (let ((pp (pp-to-string value)))
1646 (cond ((string-match "\n" pp)
1647 nil)
1648 ((> (length pp) 40)
1649 nil)
1650 (t t)))))
1651(widget-put (get 'menu-choice 'widget-type) :custom-show t)
1652
1653;;; The `custom-manual' Widget.
1654
1655(define-widget 'custom-manual 'info-link
1656 "Link to the manual entry for this customization option."
1657 :help-echo "Read the manual entry for this option."
1658 :tag "Manual")
1659
1660;;; The `custom-magic' Widget.
1661
6aaedd12
PA
1662(defgroup custom-magic-faces nil
1663 "Faces used by the magic button."
1664 :group 'custom-faces
1665 :group 'custom-buffer)
1666
d478e69d
MB
1667(defface custom-invalid '((((class color))
1668 (:foreground "yellow1" :background "red1"))
1669 (t
1670 (:weight bold :slant italic :underline t)))
6aaedd12
PA
1671 "Face used when the customize item is invalid."
1672 :group 'custom-magic-faces)
d478e69d
MB
1673;; backward-compatibility alias
1674(put 'custom-invalid-face 'face-alias 'custom-invalid)
d543e20b 1675
d478e69d
MB
1676(defface custom-rogue '((((class color))
1677 (:foreground "pink" :background "black"))
1678 (t
1679 (:underline t)))
6aaedd12
PA
1680 "Face used when the customize item is not defined for customization."
1681 :group 'custom-magic-faces)
d478e69d
MB
1682;; backward-compatibility alias
1683(put 'custom-rogue-face 'face-alias 'custom-rogue)
d543e20b 1684
d478e69d
MB
1685(defface custom-modified '((((min-colors 88) (class color))
1686 (:foreground "white" :background "blue1"))
ea81d57e 1687 (((class color))
d478e69d 1688 (:foreground "white" :background "blue"))
2dfa4c57 1689 (t
d478e69d
MB
1690 (:slant italic :bold)))
1691 "Face used when the customize item has been modified."
1692 :group 'custom-magic-faces)
1693;; backward-compatibility alias
1694(put 'custom-modified-face 'face-alias 'custom-modified)
1695
1696(defface custom-set '((((min-colors 88) (class color))
1697 (:foreground "blue1" :background "white"))
1698 (((class color))
1699 (:foreground "blue" :background "white"))
1700 (t
1701 (:slant italic)))
6aaedd12
PA
1702 "Face used when the customize item has been set."
1703 :group 'custom-magic-faces)
d478e69d
MB
1704;; backward-compatibility alias
1705(put 'custom-set-face 'face-alias 'custom-set)
1706
1707(defface custom-changed '((((min-colors 88) (class color))
1708 (:foreground "white" :background "blue1"))
1709 (((class color))
1710 (:foreground "white" :background "blue"))
1711 (t
1712 (:slant italic)))
6aaedd12
PA
1713 "Face used when the customize item has been changed."
1714 :group 'custom-magic-faces)
d478e69d
MB
1715;; backward-compatibility alias
1716(put 'custom-changed-face 'face-alias 'custom-changed)
d543e20b 1717
d478e69d 1718(defface custom-saved '((t (:underline t)))
6aaedd12
PA
1719 "Face used when the customize item has been saved."
1720 :group 'custom-magic-faces)
d478e69d
MB
1721;; backward-compatibility alias
1722(put 'custom-saved-face 'face-alias 'custom-saved)
d543e20b 1723
2dfa4c57
RS
1724(defconst custom-magic-alist
1725 '((nil "#" underline "\
167eefc5 1726UNINITIALIZED, you should not see this.")
2dfa4c57 1727 (unknown "?" italic "\
167eefc5 1728UNKNOWN, you should not see this.")
2dfa4c57 1729 (hidden "-" default "\
167eefc5 1730HIDDEN, invoke \"Show\" in the previous line to show." "\
cbc7d892 1731group now hidden, invoke \"Show\", above, to show contents.")
d478e69d 1732 (invalid "x" custom-invalid "\
167eefc5 1733INVALID, the displayed value cannot be set.")
d478e69d 1734 (modified "*" custom-modified "\
167eefc5 1735EDITED, shown value does not take effect until you set or save it." "\
1833b7b3 1736something in this group has been edited but not set.")
d478e69d 1737 (set "+" custom-set "\
167eefc5 1738SET for current session only." "\
1833b7b3 1739something in this group has been set but not saved.")
d478e69d 1740 (changed ":" custom-changed "\
167eefc5 1741CHANGED outside Customize; operating on it here may be unreliable." "\
25ac13b5 1742something in this group has been changed outside customize.")
d478e69d 1743 (saved "!" custom-saved "\
167eefc5 1744SAVED and set." "\
5dd0cad0 1745something in this group has been set and saved.")
d478e69d 1746 (rogue "@" custom-rogue "\
167eefc5 1747NO CUSTOMIZATION DATA; you should not see this." "\
25ac13b5 1748something in this group is not prepared for customization.")
2dfa4c57 1749 (standard " " nil "\
167eefc5 1750STANDARD." "\
c32de15e 1751visible group members are all at standard settings."))
d543e20b 1752 "Alist of customize option states.
d3d4df42 1753Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
d543e20b
PA
1754
1755STATE is one of the following symbols:
1756
1757`nil'
1758 For internal use, should never occur.
1759`unknown'
1760 For internal use, should never occur.
1761`hidden'
d3d4df42 1762 This item is not being displayed.
d543e20b
PA
1763`invalid'
1764 This item is modified, but has an invalid form.
1765`modified'
1766 This item is modified, and has a valid form.
1767`set'
1768 This item has been set but not saved.
1769`changed'
167eefc5 1770 The current value of this item has been changed outside Customize.
d543e20b
PA
1771`saved'
1772 This item is marked for saving.
1773`rogue'
1774 This item has no customization information.
25ac13b5 1775`standard'
5dd0cad0 1776 This item is unchanged from the standard setting.
d543e20b
PA
1777
1778MAGIC is a string used to present that state.
1779
1780FACE is a face used to present the state.
1781
25ac13b5
PA
1782ITEM-DESC is a string describing the state for options.
1783
1784GROUP-DESC is a string describing the state for groups. If this is
1785left out, ITEM-DESC will be used.
1786
9097aeb7
PA
1787The string %c in either description will be replaced with the
1788category of the item. These are `group'. `option', and `face'.
1789
25ac13b5 1790The list should be sorted most significant first.")
d543e20b
PA
1791
1792(defcustom custom-magic-show 'long
3acab5ef 1793 "If non-nil, show textual description of the state.
b62c92bb 1794If `long', show a full-line description, not just one word."
d543e20b 1795 :type '(choice (const :tag "no" nil)
c992338c
AS
1796 (const long)
1797 (other :tag "short" short))
6aaedd12 1798 :group 'custom-buffer)
d543e20b 1799
9097aeb7 1800(defcustom custom-magic-show-hidden '(option face)
b62c92bb
RS
1801 "Control whether the State button is shown for hidden items.
1802The value should be a list with the custom categories where the State
9097aeb7
PA
1803button should be visible. Possible categories are `group', `option',
1804and `face'."
1805 :type '(set (const group) (const option) (const face))
6aaedd12 1806 :group 'custom-buffer)
3acab5ef 1807
25ac13b5 1808(defcustom custom-magic-show-button nil
b62c92bb 1809 "Show a \"magic\" button indicating the state of each customization option."
d543e20b 1810 :type 'boolean
6aaedd12 1811 :group 'custom-buffer)
d543e20b
PA
1812
1813(define-widget 'custom-magic 'default
1814 "Show and manipulate state for a customization option."
1815 :format "%v"
86bd10bc 1816 :action 'widget-parent-action
6d528fc5 1817 :notify 'ignore
d543e20b
PA
1818 :value-get 'ignore
1819 :value-create 'custom-magic-value-create
1820 :value-delete 'widget-children-value-delete)
1821
86bd10bc
PA
1822(defun widget-magic-mouse-down-action (widget &optional event)
1823 ;; Non-nil unless hidden.
d3d4df42 1824 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
86bd10bc
PA
1825 :custom-state)
1826 'hidden)))
1827
d543e20b 1828(defun custom-magic-value-create (widget)
2365594b 1829 "Create compact status report for WIDGET."
d543e20b
PA
1830 (let* ((parent (widget-get widget :parent))
1831 (state (widget-get parent :custom-state))
3acab5ef 1832 (hidden (eq state 'hidden))
25ac13b5 1833 (entry (assq state custom-magic-alist))
d543e20b
PA
1834 (magic (nth 1 entry))
1835 (face (nth 2 entry))
9097aeb7
PA
1836 (category (widget-get parent :custom-category))
1837 (text (or (and (eq category 'group)
25ac13b5
PA
1838 (nth 4 entry))
1839 (nth 3 entry)))
f985c5f7 1840 (form (widget-get parent :custom-form))
d543e20b 1841 children)
9097aeb7 1842 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
d3d4df42 1843 (setq text (concat (match-string 1 text)
9097aeb7
PA
1844 (symbol-name category)
1845 (match-string 2 text))))
3acab5ef 1846 (when (and custom-magic-show
9097aeb7
PA
1847 (or (not hidden)
1848 (memq category custom-magic-show-hidden)))
25ac13b5 1849 (insert " ")
26c7b3ef
RS
1850 (when (and (eq category 'group)
1851 (not (and (eq custom-buffer-style 'links)
1852 (> (widget-get parent :custom-level) 1))))
944c91b6
PA
1853 (insert-char ?\ (* custom-buffer-indent
1854 (widget-get parent :custom-level))))
d3d4df42
DL
1855 (push (widget-create-child-and-convert
1856 widget 'choice-item
d5c42d02 1857 :help-echo "Change the state of this item."
3acab5ef 1858 :format (if hidden "%t" "%[%t%]")
25ac13b5
PA
1859 :button-prefix 'widget-push-button-prefix
1860 :button-suffix 'widget-push-button-suffix
86bd10bc
PA
1861 :mouse-down-action 'widget-magic-mouse-down-action
1862 :tag "State")
d543e20b
PA
1863 children)
1864 (insert ": ")
b62c92bb
RS
1865 (let ((start (point)))
1866 (if (eq custom-magic-show 'long)
1867 (insert text)
1868 (insert (symbol-name state)))
f985c5f7
PA
1869 (cond ((eq form 'lisp)
1870 (insert " (lisp)"))
1871 ((eq form 'mismatch)
1872 (insert " (mismatch)")))
d478e69d 1873 (put-text-property start (point) 'face 'custom-state))
d543e20b 1874 (insert "\n"))
26c7b3ef
RS
1875 (when (and (eq category 'group)
1876 (not (and (eq custom-buffer-style 'links)
1877 (> (widget-get parent :custom-level) 1))))
944c91b6
PA
1878 (insert-char ?\ (* custom-buffer-indent
1879 (widget-get parent :custom-level))))
d543e20b
PA
1880 (when custom-magic-show-button
1881 (when custom-magic-show
1882 (let ((indent (widget-get parent :indent)))
1883 (when indent
1884 (insert-char ? indent))))
d3d4df42
DL
1885 (push (widget-create-child-and-convert
1886 widget 'choice-item
86bd10bc
PA
1887 :mouse-down-action 'widget-magic-mouse-down-action
1888 :button-face face
3acab5ef
PA
1889 :button-prefix ""
1890 :button-suffix ""
86bd10bc 1891 :help-echo "Change the state."
3acab5ef 1892 :format (if hidden "%t" "%[%t%]")
f985c5f7 1893 :tag (if (memq form '(lisp mismatch))
86bd10bc
PA
1894 (concat "(" magic ")")
1895 (concat "[" magic "]")))
d543e20b
PA
1896 children)
1897 (insert " "))
1898 (widget-put widget :children children)))
1899
1900(defun custom-magic-reset (widget)
1901 "Redraw the :custom-magic property of WIDGET."
1902 (let ((magic (widget-get widget :custom-magic)))
1903 (widget-value-set magic (widget-value magic))))
1904
d543e20b
PA
1905;;; The `custom' Widget.
1906
d478e69d 1907(defface custom-button
3060662f 1908 '((((type x w32 mac) (class color)) ; Like default modeline
1a578e9b
AC
1909 (:box (:line-width 2 :style released-button)
1910 :background "lightgrey" :foreground "black"))
d3d4df42
DL
1911 (t
1912 nil))
87911bdb 1913 "Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
d3d4df42
DL
1914 :version "21.1"
1915 :group 'custom-faces)
d478e69d
MB
1916;; backward-compatibility alias
1917(put 'custom-button-face 'face-alias 'custom-button)
d3d4df42 1918
87911bdb
CY
1919(defface custom-button-unraised
1920 '((((min-colors 88)
1921 (class color) (background light)) :foreground "blue1" :underline t)
1922 (((class color) (background light)) :foreground "blue" :underline t)
1923 (((min-colors 88)
1924 (class color) (background dark)) :foreground "cyan1" :underline t)
1925 (((class color) (background dark)) :foreground "cyan" :underline t)
1926 (t :underline t))
1927 "Face for custom buffer buttons if `custom-raised-buttons' is nil."
1928 :version "22.1"
1929 :group 'custom-faces)
1930
1931(setq custom-button
1932 (if custom-raised-buttons 'custom-button 'custom-button-unraised))
1933
d478e69d 1934(defface custom-button-pressed
3060662f 1935 '((((type x w32 mac) (class color))
1a578e9b
AC
1936 (:box (:line-width 2 :style pressed-button)
1937 :background "lightgrey" :foreground "black"))
d3d4df42
DL
1938 (t
1939 (:inverse-video t)))
87911bdb 1940 "Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
d3d4df42 1941 :version "21.1"
b62c92bb 1942 :group 'custom-faces)
d478e69d
MB
1943;; backward-compatibility alias
1944(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
b62c92bb 1945
87911bdb
CY
1946(defface custom-button-pressed-unraised
1947 '((default :inherit custom-button-unraised)
1948 (((class color) (background light)) :foreground "magenta4")
1949 (((class color) (background dark)) :foreground "violet"))
1950 "Face for pressed custom buttons if `custom-raised-buttons' is nil."
1951 :version "22.1"
1952 :group 'custom-faces)
1953
1954(setq custom-button-pressed
1955 (if custom-raised-buttons
1956 'custom-button-pressed
1957 'custom-button-pressed-unraised))
1958
d478e69d 1959(defface custom-documentation nil
b62c92bb
RS
1960 "Face used for documentation strings in customization buffers."
1961 :group 'custom-faces)
d478e69d
MB
1962;; backward-compatibility alias
1963(put 'custom-documentation-face 'face-alias 'custom-documentation)
1964
1965(defface custom-state '((((class color)
1966 (background dark))
1967 (:foreground "lime green"))
1968 (((class color)
1969 (background light))
1970 (:foreground "dark green"))
1971 (t nil))
b62c92bb
RS
1972 "Face used for State descriptions in the customize buffer."
1973 :group 'custom-faces)
d478e69d
MB
1974;; backward-compatibility alias
1975(put 'custom-state-face 'face-alias 'custom-state)
b62c92bb 1976
d543e20b
PA
1977(define-widget 'custom 'default
1978 "Customize a user option."
944c91b6 1979 :format "%v"
d543e20b 1980 :convert-widget 'custom-convert-widget
d543e20b 1981 :notify 'custom-notify
944c91b6 1982 :custom-prefix ""
d543e20b
PA
1983 :custom-level 1
1984 :custom-state 'hidden
1985 :documentation-property 'widget-subclass-responsibility
1986 :value-create 'widget-subclass-responsibility
1987 :value-delete 'widget-children-value-delete
86bd10bc
PA
1988 :value-get 'widget-value-value-get
1989 :validate 'widget-children-validate
d543e20b
PA
1990 :match (lambda (widget value) (symbolp value)))
1991
1992(defun custom-convert-widget (widget)
2365594b 1993 "Initialize :value and :tag from :args in WIDGET."
d543e20b 1994 (let ((args (widget-get widget :args)))
d3d4df42 1995 (when args
d543e20b
PA
1996 (widget-put widget :value (widget-apply widget
1997 :value-to-internal (car args)))
1998 (widget-put widget :tag (custom-unlispify-tag-name (car args)))
1999 (widget-put widget :args nil)))
2000 widget)
2001
d543e20b
PA
2002(defun custom-notify (widget &rest args)
2003 "Keep track of changes."
0a3a0b56
PA
2004 (let ((state (widget-get widget :custom-state)))
2005 (unless (eq state 'modified)
2006 (unless (memq state '(nil unknown hidden))
2007 (widget-put widget :custom-state 'modified))
2008 (custom-magic-reset widget)
2009 (apply 'widget-default-notify widget args))))
d543e20b
PA
2010
2011(defun custom-redraw (widget)
2012 "Redraw WIDGET with current settings."
6d528fc5
PA
2013 (let ((line (count-lines (point-min) (point)))
2014 (column (current-column))
2015 (pos (point))
d543e20b
PA
2016 (from (marker-position (widget-get widget :from)))
2017 (to (marker-position (widget-get widget :to))))
2018 (save-excursion
2019 (widget-value-set widget (widget-value widget))
2020 (custom-redraw-magic widget))
2021 (when (and (>= pos from) (<= pos to))
6d528fc5 2022 (condition-case nil
d3d4df42 2023 (progn
86bd10bc
PA
2024 (if (> column 0)
2025 (goto-line line)
2026 (goto-line (1+ line)))
6d528fc5
PA
2027 (move-to-column column))
2028 (error nil)))))
d543e20b
PA
2029
2030(defun custom-redraw-magic (widget)
2031 "Redraw WIDGET state with current settings."
d3d4df42 2032 (while widget
d543e20b 2033 (let ((magic (widget-get widget :custom-magic)))
d3d4df42 2034 (cond (magic
944c91b6
PA
2035 (widget-value-set magic (widget-value magic))
2036 (when (setq widget (widget-get widget :group))
2037 (custom-group-state-update widget)))
2038 (t
2039 (setq widget nil)))))
d543e20b
PA
2040 (widget-setup))
2041
2042(defun custom-show (widget value)
2043 "Non-nil if WIDGET should be shown with VALUE by default."
2044 (let ((show (widget-get widget :custom-show)))
2045 (cond ((null show)
2046 nil)
2047 ((eq t show)
2048 t)
2049 (t
2050 (funcall show widget value)))))
2051
d543e20b
PA
2052(defun custom-load-widget (widget)
2053 "Load all dependencies for WIDGET."
2054 (custom-load-symbol (widget-value widget)))
2055
c953515e 2056(defun custom-unloaded-symbol-p (symbol)
3127aa13 2057 "Return non-nil if the dependencies of SYMBOL have not yet been loaded."
c953515e
PA
2058 (let ((found nil)
2059 (loads (get symbol 'custom-loads))
2060 load)
2061 (while loads
2062 (setq load (car loads)
2063 loads (cdr loads))
2064 (cond ((symbolp load)
2065 (unless (featurep load)
2066 (setq found t)))
2067 ((assoc load load-history))
2068 ((assoc (locate-library load) load-history)
2069 (message nil))
2070 (t
2071 (setq found t))))
2072 found))
2073
2074(defun custom-unloaded-widget-p (widget)
3127aa13 2075 "Return non-nil if the dependencies of WIDGET have not yet been loaded."
c953515e
PA
2076 (custom-unloaded-symbol-p (widget-value widget)))
2077
6d528fc5
PA
2078(defun custom-toggle-hide (widget)
2079 "Toggle visibility of WIDGET."
c953515e 2080 (custom-load-widget widget)
6d528fc5
PA
2081 (let ((state (widget-get widget :custom-state)))
2082 (cond ((memq state '(invalid modified))
2083 (error "There are unset changes"))
2084 ((eq state 'hidden)
2085 (widget-put widget :custom-state 'unknown))
d3d4df42 2086 (t
3acab5ef 2087 (widget-put widget :documentation-shown nil)
6d528fc5 2088 (widget-put widget :custom-state 'hidden)))
8697863a
PA
2089 (custom-redraw widget)
2090 (widget-setup)))
6d528fc5 2091
3acab5ef 2092(defun custom-toggle-parent (widget &rest ignore)
b62c92bb 2093 "Toggle visibility of parent of WIDGET."
3acab5ef
PA
2094 (custom-toggle-hide (widget-get widget :parent)))
2095
944c91b6
PA
2096(defun custom-add-see-also (widget &optional prefix)
2097 "Add `See also ...' to WIDGET if there are any links.
2098Insert PREFIX first if non-nil."
2099 (let* ((symbol (widget-get widget :value))
2100 (links (get symbol 'custom-links))
2101 (many (> (length links) 2))
2102 (buttons (widget-get widget :buttons))
2103 (indent (widget-get widget :indent)))
2104 (when links
2105 (when indent
2106 (insert-char ?\ indent))
2107 (when prefix
2108 (insert prefix))
2109 (insert "See also ")
2110 (while links
2111 (push (widget-create-child-and-convert widget (car links))
2112 buttons)
2113 (setq links (cdr links))
2114 (cond ((null links)
2115 (insert ".\n"))
2116 ((null (cdr links))
2117 (if many
2118 (insert ", and ")
2119 (insert " and ")))
d3d4df42 2120 (t
944c91b6
PA
2121 (insert ", "))))
2122 (widget-put widget :buttons buttons))))
2123
cd6c0940
RS
2124(defun custom-add-parent-links (widget &optional initial-string)
2125 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
2126The value if non-nil if any parents were found.
2127If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
944c91b6
PA
2128 (let ((name (widget-value widget))
2129 (type (widget-type widget))
2130 (buttons (widget-get widget :buttons))
d377bee9 2131 (start (point))
ac00d71c 2132 (parents nil))
cd6c0940 2133 (insert (or initial-string "Parent groups:"))
944c91b6 2134 (mapatoms (lambda (symbol)
da5ec617
PA
2135 (let ((entry (assq name (get symbol 'custom-group))))
2136 (when (eq (nth 1 entry) type)
2137 (insert " ")
d3d4df42
DL
2138 (push (widget-create-child-and-convert
2139 widget 'custom-group-link
da5ec617
PA
2140 :tag (custom-unlispify-tag-name symbol)
2141 symbol)
2142 buttons)
ac00d71c 2143 (setq parents (cons symbol parents))))))
8e4d1662 2144 (and (null (get name 'custom-links)) ;No links of its own.
ac00d71c 2145 (= (length parents) 1) ;A single parent.
cfa921fd
PA
2146 (let* ((links (get (car parents) 'custom-links))
2147 (many (> (length links) 2)))
ac00d71c
PA
2148 (when links
2149 (insert "\nParent documentation: ")
2150 (while links
2151 (push (widget-create-child-and-convert widget (car links))
2152 buttons)
2153 (setq links (cdr links))
2154 (cond ((null links)
2155 (insert ".\n"))
2156 ((null (cdr links))
2157 (if many
2158 (insert ", and ")
2159 (insert " and ")))
2160 (t
2161 (insert ", ")))))))
2162 (if parents
2163 (insert "\n")
d377bee9 2164 (delete-region start (point)))
ac00d71c
PA
2165 (widget-put widget :buttons buttons)
2166 parents))
944c91b6 2167
d3d4df42
DL
2168;;; The `custom-comment' Widget.
2169
2170;; like the editable field
d478e69d
MB
2171(defface custom-comment '((((class grayscale color)
2172 (background light))
2173 (:background "gray85"))
2174 (((class grayscale color)
2175 (background dark))
2176 (:background "dim gray"))
2177 (t
2178 (:slant italic)))
d3d4df42
DL
2179 "Face used for comments on variables or faces"
2180 :version "21.1"
2181 :group 'custom-faces)
d478e69d
MB
2182;; backward-compatibility alias
2183(put 'custom-comment-face 'face-alias 'custom-comment)
d3d4df42
DL
2184
2185;; like font-lock-comment-face
d478e69d 2186(defface custom-comment-tag
d3d4df42
DL
2187 '((((class color) (background dark)) (:foreground "gray80"))
2188 (((class color) (background light)) (:foreground "blue4"))
2189 (((class grayscale) (background light))
b5555381 2190 (:foreground "DimGray" :weight bold :slant italic))
d3d4df42 2191 (((class grayscale) (background dark))
b5555381
RS
2192 (:foreground "LightGray" :weight bold :slant italic))
2193 (t (:weight bold)))
d3d4df42
DL
2194 "Face used for variables or faces comment tags"
2195 :group 'custom-faces)
d478e69d
MB
2196;; backward-compatibility alias
2197(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
d3d4df42
DL
2198
2199(define-widget 'custom-comment 'string
164cfaeb 2200 "User comment."
d3d4df42 2201 :tag "Comment"
164cfaeb 2202 :help-echo "Edit a comment here."
d3d4df42
DL
2203 :sample-face 'custom-comment-tag-face
2204 :value-face 'custom-comment-face
164cfaeb
DL
2205 :shown nil
2206 :create 'custom-comment-create)
d3d4df42
DL
2207
2208(defun custom-comment-create (widget)
164cfaeb 2209 (let* ((null-comment (equal "" (widget-value widget))))
6171a945
DL
2210 (if (or (widget-get (widget-get widget :parent) :comment-shown)
2211 (not null-comment))
2212 (widget-default-create widget)
2213 ;; `widget-default-delete' expects markers in these slots --
2214 ;; maybe it shouldn't.
2215 (widget-put widget :from (point-marker))
2216 (widget-put widget :to (point-marker)))))
164cfaeb
DL
2217
2218(defun custom-comment-hide (widget)
2219 (widget-put (widget-get widget :parent) :comment-shown nil))
d3d4df42
DL
2220
2221;; Those functions are for the menu. WIDGET is NOT the comment widget. It's
2222;; the global custom one
2223(defun custom-comment-show (widget)
164cfaeb
DL
2224 (widget-put widget :comment-shown t)
2225 (custom-redraw widget)
2226 (widget-setup))
d3d4df42
DL
2227
2228(defun custom-comment-invisible-p (widget)
164cfaeb
DL
2229 (let ((val (widget-value (widget-get widget :comment-widget))))
2230 (and (equal "" val)
2231 (not (widget-get widget :comment-shown)))))
d3d4df42 2232
d543e20b
PA
2233;;; The `custom-variable' Widget.
2234
2365594b
DL
2235;; When this was underlined blue, users confused it with a
2236;; Mosaic-style hyperlink...
d478e69d 2237(defface custom-variable-tag
16b20ed9
GM
2238 `((((class color)
2239 (background dark))
b5555381 2240 (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
ea81d57e
DN
2241 (((min-colors 88) (class color)
2242 (background light))
2243 (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
16b20ed9
GM
2244 (((class color)
2245 (background light))
29a82d4c 2246 (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
b5555381 2247 (t (:weight bold)))
d543e20b 2248 "Face used for unpushable variable tags."
bd042c03 2249 :group 'custom-faces)
d478e69d
MB
2250;; backward-compatibility alias
2251(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag)
d543e20b 2252
d478e69d 2253(defface custom-variable-button '((t (:underline t :weight bold)))
d543e20b 2254 "Face used for pushable variable tags."
bd042c03 2255 :group 'custom-faces)
d478e69d
MB
2256;; backward-compatibility alias
2257(put 'custom-variable-button-face 'face-alias 'custom-variable-button)
d543e20b 2258
d64478da
KH
2259(defcustom custom-variable-default-form 'edit
2260 "Default form of displaying variable values."
2261 :type '(choice (const edit)
2262 (const lisp))
cd32a7ba
DN
2263 :group 'custom-buffer
2264 :version "20.3")
d64478da 2265
a075569a
LT
2266(defun custom-variable-documentation (variable)
2267 "Return documentation of VARIABLE for use in Custom buffer.
2268Normally just return the docstring. But if VARIABLE automatically
2269becomes buffer local when set, append a message to that effect."
2270 (if (and (local-variable-if-set-p variable)
2271 (or (not (local-variable-p variable))
2272 (with-temp-buffer
2273 (local-variable-if-set-p variable))))
2274 (concat (documentation-property variable 'variable-documentation)
2275 "\n
2276This variable automatically becomes buffer-local when set outside Custom.
2277However, setting it through Custom sets the default value.")
2278 (documentation-property variable 'variable-documentation)))
2279
d543e20b
PA
2280(define-widget 'custom-variable 'custom
2281 "Customize variable."
944c91b6 2282 :format "%v"
d543e20b 2283 :help-echo "Set or reset this variable."
a075569a 2284 :documentation-property #'custom-variable-documentation
9097aeb7 2285 :custom-category 'option
d543e20b
PA
2286 :custom-state nil
2287 :custom-menu 'custom-variable-menu-create
d64478da 2288 :custom-form nil ; defaults to value of `custom-variable-default-form'
d543e20b
PA
2289 :value-create 'custom-variable-value-create
2290 :action 'custom-variable-action
2291 :custom-set 'custom-variable-set
2292 :custom-save 'custom-variable-save
2293 :custom-reset-current 'custom-redraw
2294 :custom-reset-saved 'custom-variable-reset-saved
4f985043
RS
2295 :custom-reset-standard 'custom-variable-reset-standard
2296 :custom-standard-value 'custom-variable-standard-value)
d543e20b 2297
bd042c03
PA
2298(defun custom-variable-type (symbol)
2299 "Return a widget suitable for editing the value of SYMBOL.
d3d4df42 2300If SYMBOL has a `custom-type' property, use that.
bd042c03
PA
2301Otherwise, look up symbol in `custom-guess-type-alist'."
2302 (let* ((type (or (get symbol 'custom-type)
25ac13b5 2303 (and (not (get symbol 'standard-value))
bd042c03
PA
2304 (custom-guess-type symbol))
2305 'sexp))
2306 (options (get symbol 'custom-options))
2307 (tmp (if (listp type)
46fa5a83 2308 (copy-sequence type)
bd042c03
PA
2309 (list type))))
2310 (when options
2311 (widget-put tmp :options options))
2312 tmp))
2313
d543e20b 2314(defun custom-variable-value-create (widget)
164cfaeb 2315 "Here is where you edit the variable's value."
d543e20b 2316 (custom-load-widget widget)
d64478da
KH
2317 (unless (widget-get widget :custom-form)
2318 (widget-put widget :custom-form custom-variable-default-form))
d543e20b
PA
2319 (let* ((buttons (widget-get widget :buttons))
2320 (children (widget-get widget :children))
2321 (form (widget-get widget :custom-form))
2322 (state (widget-get widget :custom-state))
2323 (symbol (widget-get widget :value))
d543e20b 2324 (tag (widget-get widget :tag))
bd042c03 2325 (type (custom-variable-type symbol))
d543e20b 2326 (conv (widget-convert type))
6d528fc5 2327 (get (or (get symbol 'custom-get) 'default-value))
944c91b6
PA
2328 (prefix (widget-get widget :custom-prefix))
2329 (last (widget-get widget :custom-last))
d543e20b 2330 (value (if (default-boundp symbol)
6d528fc5 2331 (funcall get symbol)
d543e20b 2332 (widget-get conv :value))))
164cfaeb 2333 ;; If the widget is new, the child determines whether it is hidden.
d543e20b
PA
2334 (cond (state)
2335 ((custom-show type value)
2336 (setq state 'unknown))
2337 (t
2338 (setq state 'hidden)))
2339 ;; If we don't know the state, see if we need to edit it in lisp form.
2340 (when (eq state 'unknown)
2341 (unless (widget-apply conv :match value)
2342 ;; (widget-apply (widget-convert type) :match value)
f985c5f7 2343 (setq form 'mismatch)))
d543e20b 2344 ;; Now we can create the child widget.
944c91b6 2345 (cond ((eq custom-buffer-style 'tree)
da5ec617 2346 (insert prefix (if last " `--- " " |--- "))
944c91b6 2347 (push (widget-create-child-and-convert
c953515e 2348 widget 'custom-browse-variable-tag)
944c91b6
PA
2349 buttons)
2350 (insert " " tag "\n")
2351 (widget-put widget :buttons buttons))
2352 ((eq state 'hidden)
d543e20b 2353 ;; Indicate hidden value.
d3d4df42 2354 (push (widget-create-child-and-convert
d543e20b 2355 widget 'item
3acab5ef 2356 :format "%{%t%}: "
b62c92bb 2357 :sample-face 'custom-variable-tag-face
d543e20b
PA
2358 :tag tag
2359 :parent widget)
3acab5ef 2360 buttons)
d3d4df42 2361 (push (widget-create-child-and-convert
3acab5ef 2362 widget 'visibility
8697863a 2363 :help-echo "Show the value of this option."
7f663295 2364 :off "Show Value"
3acab5ef
PA
2365 :action 'custom-toggle-parent
2366 nil)
2367 buttons))
f985c5f7 2368 ((memq form '(lisp mismatch))
d543e20b
PA
2369 ;; In lisp mode edit the saved value when possible.
2370 (let* ((value (cond ((get symbol 'saved-value)
2371 (car (get symbol 'saved-value)))
25ac13b5
PA
2372 ((get symbol 'standard-value)
2373 (car (get symbol 'standard-value)))
d543e20b 2374 ((default-boundp symbol)
6d528fc5 2375 (custom-quote (funcall get symbol)))
d543e20b
PA
2376 (t
2377 (custom-quote (widget-get conv :value))))))
3acab5ef 2378 (insert (symbol-name symbol) ": ")
d3d4df42 2379 (push (widget-create-child-and-convert
944c91b6
PA
2380 widget 'visibility
2381 :help-echo "Hide the value of this option."
7f663295
RS
2382 :on "Hide Value"
2383 :off "Show Value"
944c91b6
PA
2384 :action 'custom-toggle-parent
2385 t)
2386 buttons)
3acab5ef 2387 (insert " ")
d3d4df42
DL
2388 (push (widget-create-child-and-convert
2389 widget 'sexp
d543e20b 2390 :button-face 'custom-variable-button-face
3acab5ef 2391 :format "%v"
d543e20b
PA
2392 :tag (symbol-name symbol)
2393 :parent widget
2394 :value value)
2395 children)))
2396 (t
2397 ;; Edit mode.
3acab5ef
PA
2398 (let* ((format (widget-get type :format))
2399 tag-format value-format)
2400 (unless (string-match ":" format)
896a6a5d 2401 (error "Bad format"))
3acab5ef
PA
2402 (setq tag-format (substring format 0 (match-end 0)))
2403 (setq value-format (substring format (match-end 0)))
2404 (push (widget-create-child-and-convert
d3d4df42 2405 widget 'item
3acab5ef
PA
2406 :format tag-format
2407 :action 'custom-tag-action
8697863a 2408 :help-echo "Change value of this option."
3acab5ef
PA
2409 :mouse-down-action 'custom-tag-mouse-down-action
2410 :button-face 'custom-variable-button-face
b62c92bb 2411 :sample-face 'custom-variable-tag-face
3acab5ef
PA
2412 tag)
2413 buttons)
2414 (insert " ")
d3d4df42 2415 (push (widget-create-child-and-convert
164cfaeb
DL
2416 widget 'visibility
2417 :help-echo "Hide the value of this option."
7f663295
RS
2418 :on "Hide Value"
2419 :off "Show Value"
164cfaeb
DL
2420 :action 'custom-toggle-parent
2421 t)
2422 buttons)
3acab5ef 2423 (push (widget-create-child-and-convert
d3d4df42 2424 widget type
3acab5ef
PA
2425 :format value-format
2426 :value value)
2427 children))))
944c91b6 2428 (unless (eq custom-buffer-style 'tree)
944c91b6
PA
2429 (unless (eq (preceding-char) ?\n)
2430 (widget-insert "\n"))
944c91b6
PA
2431 ;; Create the magic button.
2432 (let ((magic (widget-create-child-and-convert
2433 widget 'custom-magic nil)))
2434 (widget-put widget :custom-magic magic)
2435 (push magic buttons))
164cfaeb 2436 ;; ### NOTE: this is ugly!!!! I need to update the :buttons property
d3d4df42
DL
2437 ;; before the call to `widget-default-format-handler'. Otherwise, I
2438 ;; loose my current `buttons'. This function shouldn't be called like
2439 ;; this anyway. The doc string widget should be added like the others.
2440 ;; --dv
944c91b6 2441 (widget-put widget :buttons buttons)
7f663295 2442 (insert "\n")
944c91b6
PA
2443 ;; Insert documentation.
2444 (widget-default-format-handler widget ?h)
d3d4df42
DL
2445
2446 ;; The comment field
2447 (unless (eq state 'hidden)
2448 (let* ((comment (get symbol 'variable-comment))
2449 (comment-widget
2450 (widget-create-child-and-convert
2451 widget 'custom-comment
2452 :parent widget
2453 :value (or comment ""))))
2454 (widget-put widget :comment-widget comment-widget)
2455 ;; Don't push it !!! Custom assumes that the first child is the
2456 ;; value one.
2457 (setq children (append children (list comment-widget)))))
2458 ;; Update the rest of the properties properties.
2459 (widget-put widget :custom-form form)
2460 (widget-put widget :children children)
2461 ;; Now update the state.
2462 (if (eq state 'hidden)
2463 (widget-put widget :custom-state state)
2464 (custom-variable-state-set widget))
944c91b6
PA
2465 ;; See also.
2466 (unless (eq state 'hidden)
2467 (when (eq (widget-get widget :custom-level) 1)
2468 (custom-add-parent-links widget))
2469 (custom-add-see-also widget)))))
d543e20b 2470
3acab5ef
PA
2471(defun custom-tag-action (widget &rest args)
2472 "Pass :action to first child of WIDGET's parent."
2473 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
2474 :action args))
2475
2476(defun custom-tag-mouse-down-action (widget &rest args)
2477 "Pass :mouse-down-action to first child of WIDGET's parent."
2478 (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
2479 :mouse-down-action args))
2480
d543e20b
PA
2481(defun custom-variable-state-set (widget)
2482 "Set the state of WIDGET."
2483 (let* ((symbol (widget-value widget))
6d528fc5 2484 (get (or (get symbol 'custom-get) 'default-value))
d543e20b 2485 (value (if (default-boundp symbol)
6d528fc5 2486 (funcall get symbol)
d543e20b 2487 (widget-get widget :value)))
d3d4df42 2488 (comment (get symbol 'variable-comment))
d543e20b 2489 tmp
d3d4df42
DL
2490 temp
2491 (state (cond ((progn (setq tmp (get symbol 'customized-value))
2492 (setq temp
2493 (get symbol 'customized-variable-comment))
2494 (or tmp temp))
d543e20b 2495 (if (condition-case nil
d3d4df42
DL
2496 (and (equal value (eval (car tmp)))
2497 (equal comment temp))
d543e20b
PA
2498 (error nil))
2499 'set
2500 'changed))
d3d4df42
DL
2501 ((progn (setq tmp (get symbol 'saved-value))
2502 (setq temp (get symbol 'saved-variable-comment))
2503 (or tmp temp))
d543e20b 2504 (if (condition-case nil
d3d4df42
DL
2505 (and (equal value (eval (car tmp)))
2506 (equal comment temp))
d543e20b
PA
2507 (error nil))
2508 'saved
2509 'changed))
25ac13b5 2510 ((setq tmp (get symbol 'standard-value))
d543e20b 2511 (if (condition-case nil
d3d4df42
DL
2512 (and (equal value (eval (car tmp)))
2513 (equal comment nil))
d543e20b 2514 (error nil))
25ac13b5 2515 'standard
d543e20b
PA
2516 'changed))
2517 (t 'rogue))))
2518 (widget-put widget :custom-state state)))
2519
4f985043
RS
2520(defun custom-variable-standard-value (widget)
2521 (get (widget-value widget) 'standard-value))
2522
d3d4df42 2523(defvar custom-variable-menu
0f3335c0 2524 '(("Set for Current Session" custom-variable-set
6d528fc5
PA
2525 (lambda (widget)
2526 (eq (widget-get widget :custom-state) 'modified)))
0f3335c0 2527 ("Save for Future Sessions" custom-variable-save
6d528fc5
PA
2528 (lambda (widget)
2529 (memq (widget-get widget :custom-state) '(modified set changed rogue))))
2530 ("Reset to Current" custom-redraw
2531 (lambda (widget)
2532 (and (default-boundp (widget-value widget))
86bd10bc 2533 (memq (widget-get widget :custom-state) '(modified changed)))))
6d528fc5
PA
2534 ("Reset to Saved" custom-variable-reset-saved
2535 (lambda (widget)
d3d4df42
DL
2536 (and (or (get (widget-value widget) 'saved-value)
2537 (get (widget-value widget) 'saved-variable-comment))
6d528fc5
PA
2538 (memq (widget-get widget :custom-state)
2539 '(modified set changed rogue)))))
19d63704 2540 ("Erase Customization" custom-variable-reset-standard
6d528fc5 2541 (lambda (widget)
25ac13b5 2542 (and (get (widget-value widget) 'standard-value)
6d528fc5 2543 (memq (widget-get widget :custom-state)
8697863a 2544 '(modified set changed saved rogue)))))
bde4f354
RS
2545 ("Use Backup Value" custom-variable-reset-backup
2546 (lambda (widget)
2547 (get (widget-value widget) 'backup-value)))
8697863a 2548 ("---" ignore ignore)
d3d4df42
DL
2549 ("Add Comment" custom-comment-show custom-comment-invisible-p)
2550 ("---" ignore ignore)
2551 ("Don't show as Lisp expression" custom-variable-edit
8697863a 2552 (lambda (widget)
f985c5f7 2553 (eq (widget-get widget :custom-form) 'lisp)))
0db1ff23 2554 ("Show initial Lisp expression" custom-variable-edit-lisp
8697863a 2555 (lambda (widget)
f985c5f7 2556 (eq (widget-get widget :custom-form) 'edit))))
d543e20b 2557 "Alist of actions for the `custom-variable' widget.
6d528fc5
PA
2558Each entry has the form (NAME ACTION FILTER) where NAME is the name of
2559the menu entry, ACTION is the function to call on the widget when the
2560menu is selected, and FILTER is a predicate which takes a `custom-variable'
2561widget as an argument, and returns non-nil if ACTION is valid on that
19d63704 2562widget. If FILTER is nil, ACTION is always valid.")
d543e20b
PA
2563
2564(defun custom-variable-action (widget &optional event)
2565 "Show the menu for `custom-variable' WIDGET.
2566Optional EVENT is the location for the menu."
2567 (if (eq (widget-get widget :custom-state) 'hidden)
6d528fc5 2568 (custom-toggle-hide widget)
86bd10bc
PA
2569 (unless (eq (widget-get widget :custom-state) 'modified)
2570 (custom-variable-state-set widget))
2571 (custom-redraw-magic widget)
d543e20b 2572 (let* ((completion-ignore-case t)
25ac13b5
PA
2573 (answer (widget-choose (concat "Operation on "
2574 (custom-unlispify-tag-name
2575 (widget-get widget :value)))
6d528fc5
PA
2576 (custom-menu-filter custom-variable-menu
2577 widget)
d543e20b
PA
2578 event)))
2579 (if answer
2580 (funcall answer widget)))))
2581
2582(defun custom-variable-edit (widget)
2583 "Edit value of WIDGET."
2584 (widget-put widget :custom-state 'unknown)
2585 (widget-put widget :custom-form 'edit)
2586 (custom-redraw widget))
2587
2588(defun custom-variable-edit-lisp (widget)
2365594b 2589 "Edit the Lisp representation of the value of WIDGET."
d543e20b
PA
2590 (widget-put widget :custom-state 'unknown)
2591 (widget-put widget :custom-form 'lisp)
2592 (custom-redraw widget))
2593
2594(defun custom-variable-set (widget)
2595 "Set the current value for the variable being edited by WIDGET."
6d528fc5
PA
2596 (let* ((form (widget-get widget :custom-form))
2597 (state (widget-get widget :custom-state))
2598 (child (car (widget-get widget :children)))
2599 (symbol (widget-value widget))
2600 (set (or (get symbol 'custom-set) 'set-default))
d3d4df42
DL
2601 (comment-widget (widget-get widget :comment-widget))
2602 (comment (widget-value comment-widget))
2603 val)
d543e20b 2604 (cond ((eq state 'hidden)
896a6a5d 2605 (error "Cannot set hidden variable"))
d543e20b
PA
2606 ((setq val (widget-apply child :validate))
2607 (goto-char (widget-get val :from))
2608 (error "%s" (widget-get val :error)))
f985c5f7 2609 ((memq form '(lisp mismatch))
d3d4df42
DL
2610 (when (equal comment "")
2611 (setq comment nil)
2612 ;; Make the comment invisible by hand if it's empty
164cfaeb 2613 (custom-comment-hide comment-widget))
bde4f354 2614 (custom-variable-backup-value widget)
6d528fc5 2615 (funcall set symbol (eval (setq val (widget-value child))))
d3d4df42
DL
2616 (put symbol 'customized-value (list val))
2617 (put symbol 'variable-comment comment)
2618 (put symbol 'customized-variable-comment comment))
d543e20b 2619 (t
d3d4df42
DL
2620 (when (equal comment "")
2621 (setq comment nil)
2622 ;; Make the comment invisible by hand if it's empty
164cfaeb 2623 (custom-comment-hide comment-widget))
bde4f354 2624 (custom-variable-backup-value widget)
6d528fc5 2625 (funcall set symbol (setq val (widget-value child)))
d3d4df42
DL
2626 (put symbol 'customized-value (list (custom-quote val)))
2627 (put symbol 'variable-comment comment)
2628 (put symbol 'customized-variable-comment comment)))
d543e20b
PA
2629 (custom-variable-state-set widget)
2630 (custom-redraw-magic widget)))
2631
2632(defun custom-variable-save (widget)
0db1ff23 2633 "Set and save the value for the variable being edited by WIDGET."
6d528fc5
PA
2634 (let* ((form (widget-get widget :custom-form))
2635 (state (widget-get widget :custom-state))
2636 (child (car (widget-get widget :children)))
2637 (symbol (widget-value widget))
2638 (set (or (get symbol 'custom-set) 'set-default))
d3d4df42
DL
2639 (comment-widget (widget-get widget :comment-widget))
2640 (comment (widget-value comment-widget))
6d528fc5 2641 val)
d543e20b 2642 (cond ((eq state 'hidden)
896a6a5d 2643 (error "Cannot set hidden variable"))
d543e20b
PA
2644 ((setq val (widget-apply child :validate))
2645 (goto-char (widget-get val :from))
6b292312 2646 (error "Saving %s: %s" symbol (widget-get val :error)))
f985c5f7 2647 ((memq form '(lisp mismatch))
d3d4df42
DL
2648 (when (equal comment "")
2649 (setq comment nil)
2650 ;; Make the comment invisible by hand if it's empty
164cfaeb 2651 (custom-comment-hide comment-widget))
d543e20b 2652 (put symbol 'saved-value (list (widget-value child)))
c942535f
RS
2653 (custom-push-theme 'theme-value symbol 'user
2654 'set (list (widget-value child)))
d3d4df42
DL
2655 (funcall set symbol (eval (widget-value child)))
2656 (put symbol 'variable-comment comment)
2657 (put symbol 'saved-variable-comment comment))
d543e20b 2658 (t
d3d4df42
DL
2659 (when (equal comment "")
2660 (setq comment nil)
2661 ;; Make the comment invisible by hand if it's empty
164cfaeb 2662 (custom-comment-hide comment-widget))
d3d4df42
DL
2663 (put symbol 'saved-value
2664 (list (custom-quote (widget-value child))))
c942535f
RS
2665 (custom-push-theme 'theme-value symbol 'user
2666 'set (list (custom-quote (widget-value
2667 child))))
d3d4df42
DL
2668 (funcall set symbol (widget-value child))
2669 (put symbol 'variable-comment comment)
2670 (put symbol 'saved-variable-comment comment)))
d543e20b 2671 (put symbol 'customized-value nil)
d3d4df42 2672 (put symbol 'customized-variable-comment nil)
d543e20b
PA
2673 (custom-save-all)
2674 (custom-variable-state-set widget)
2675 (custom-redraw-magic widget)))
2676
2677(defun custom-variable-reset-saved (widget)
bde4f354
RS
2678 "Restore the saved value for the variable being edited by WIDGET.
2679The value that was current before this operation
2680becomes the backup value, so you can get it again."
6d528fc5 2681 (let* ((symbol (widget-value widget))
d3d4df42 2682 (set (or (get symbol 'custom-set) 'set-default))
d3d4df42
DL
2683 (value (get symbol 'saved-value))
2684 (comment (get symbol 'saved-variable-comment)))
2685 (cond ((or value comment)
2686 (put symbol 'variable-comment comment)
bde4f354 2687 (custom-variable-backup-value widget)
d3d4df42
DL
2688 (condition-case nil
2689 (funcall set symbol (eval (car value)))
2690 (error nil)))
2691 (t
2692 (error "No saved value for %s" symbol)))
d543e20b 2693 (put symbol 'customized-value nil)
d3d4df42 2694 (put symbol 'customized-variable-comment nil)
d543e20b 2695 (widget-put widget :custom-state 'unknown)
d3d4df42 2696 ;; This call will possibly make the comment invisible
d543e20b
PA
2697 (custom-redraw widget)))
2698
25ac13b5 2699(defun custom-variable-reset-standard (widget)
19d63704
RS
2700 "Restore the standard setting for the variable being edited by WIDGET.
2701This operation eliminates any saved setting for the variable,
bde4f354
RS
2702restoring it to the state of a variable that has never been customized.
2703The value that was current before this operation
2704becomes the backup value, so you can get it again."
6d528fc5 2705 (let* ((symbol (widget-value widget))
40627755 2706 (set (or (get symbol 'custom-set) 'set-default)))
25ac13b5 2707 (if (get symbol 'standard-value)
bde4f354
RS
2708 (progn
2709 (custom-variable-backup-value widget)
2710 (funcall set symbol (eval (car (get symbol 'standard-value)))))
5dd0cad0 2711 (error "No standard setting known for %S" symbol))
164cfaeb 2712 (put symbol 'variable-comment nil)
d543e20b 2713 (put symbol 'customized-value nil)
d3d4df42
DL
2714 (put symbol 'customized-variable-comment nil)
2715 (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
d543e20b 2716 (put symbol 'saved-value nil)
c942535f
RS
2717 (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
2718 ;; As a special optimizations we do not (explictly)
2719 ;; save resets to standard when no theme set the value.
2720 (if (null (cdr (get symbol 'theme-value)))
2721 (put symbol 'theme-value nil))
d3d4df42 2722 (put symbol 'saved-variable-comment nil)
d543e20b
PA
2723 (custom-save-all))
2724 (widget-put widget :custom-state 'unknown)
d3d4df42 2725 ;; This call will possibly make the comment invisible
d543e20b
PA
2726 (custom-redraw widget)))
2727
bde4f354
RS
2728(defun custom-variable-backup-value (widget)
2729 "Back up the current value for WIDGET's variable.
2730The backup value is kept in the car of the `backup-value' property."
2731 (let* ((symbol (widget-value widget))
2732 (get (or (get symbol 'custom-get) 'default-value))
2733 (type (custom-variable-type symbol))
2734 (conv (widget-convert type))
2735 (value (if (default-boundp symbol)
2736 (funcall get symbol)
2737 (widget-get conv :value))))
2738 (put symbol 'backup-value (list value))))
2739
2740(defun custom-variable-reset-backup (widget)
2741 "Restore the backup value for the variable being edited by WIDGET.
2742The value that was current before this operation
2743becomes the backup value, so you can use this operation repeatedly
2744to switch between two values."
2745 (let* ((symbol (widget-value widget))
2746 (set (or (get symbol 'custom-set) 'set-default))
2747 (value (get symbol 'backup-value))
2748 (comment-widget (widget-get widget :comment-widget))
2749 (comment (widget-value comment-widget)))
2750 (if value
2751 (progn
2752 (custom-variable-backup-value widget)
2753 (condition-case nil
2754 (funcall set symbol (car value))
2755 (error nil)))
2756 (error "No backup value for %s" symbol))
2757 (put symbol 'customized-value (list (car value)))
2758 (put symbol 'variable-comment comment)
2759 (put symbol 'customized-variable-comment comment)
2760 (custom-variable-state-set widget)
2761 ;; This call will possibly make the comment invisible
2762 (custom-redraw widget)))
2763
d543e20b
PA
2764;;; The `custom-face-edit' Widget.
2765
2766(define-widget 'custom-face-edit 'checklist
2767 "Edit face attributes."
2768 :format "%t: %v"
2769 :tag "Attributes"
2dfa4c57 2770 :extra-offset 13
d3d4df42 2771 :button-args '(:help-echo "Control whether this attribute has any effect.")
d75fa08f
RS
2772 :value-to-internal 'custom-face-edit-fix-value
2773 :match (lambda (widget value)
ee1f522d 2774 (widget-checklist-match widget
d75fa08f 2775 (custom-face-edit-fix-value widget value)))
3ea051cb 2776 :convert-widget 'custom-face-edit-convert-widget
d543e20b 2777 :args (mapcar (lambda (att)
d3d4df42 2778 (list 'group
d543e20b
PA
2779 :inline t
2780 :sibling-args (widget-get (nth 1 att) :sibling-args)
d3d4df42 2781 (list 'const :format "" :value (nth 0 att))
d543e20b
PA
2782 (nth 1 att)))
2783 custom-face-attributes))
2784
d75fa08f 2785(defun custom-face-edit-fix-value (widget value)
0bbe869a
AS
2786 "Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
2787Also change :reverse-video to :inverse-video."
4f985043
RS
2788 (if (listp value)
2789 (let (result)
2790 (while value
2791 (let ((key (car value))
2792 (val (car (cdr value))))
2793 (cond ((eq key :italic)
2794 (push :slant result)
2795 (push (if val 'italic 'normal) result))
2796 ((eq key :bold)
2797 (push :weight result)
2798 (push (if val 'bold 'normal) result))
0bbe869a
AS
2799 ((eq key :reverse-video)
2800 (push :inverse-video result)
2801 (push val result))
ee1f522d 2802 (t
4f985043
RS
2803 (push key result)
2804 (push val result))))
2805 (setq value (cdr (cdr value))))
2806 (setq result (nreverse result))
2807 result)
2808 value))
d75fa08f 2809
3ea051cb
MB
2810(defun custom-face-edit-convert-widget (widget)
2811 "Convert :args as widget types in WIDGET."
2812 (widget-put
2813 widget
2814 :args (mapcar (lambda (arg)
2815 (widget-convert arg
2816 :deactivate 'custom-face-edit-deactivate
2817 :activate 'custom-face-edit-activate
2818 :delete 'custom-face-edit-delete))
2819 (widget-get widget :args)))
2820 widget)
2821
2822(defun custom-face-edit-deactivate (widget)
2823 "Make face widget WIDGET inactive for user modifications."
2824 (unless (widget-get widget :inactive)
2825 (let ((tag (custom-face-edit-attribute-tag widget))
2826 (from (copy-marker (widget-get widget :from)))
3ea051cb
MB
2827 (value (widget-value widget))
2828 (inhibit-read-only t)
2829 (inhibit-modification-hooks t))
2830 (save-excursion
2831 (goto-char from)
2832 (widget-default-delete widget)
2833 (insert tag ": *\n")
2834 (widget-put widget :inactive
2835 (cons value (cons from (- (point) from))))))))
2836
2837(defun custom-face-edit-activate (widget)
2838 "Make face widget WIDGET inactive for user modifications."
2839 (let ((inactive (widget-get widget :inactive))
2840 (inhibit-read-only t)
2841 (inhibit-modification-hooks t))
2842 (when (consp inactive)
2843 (save-excursion
2844 (goto-char (car (cdr inactive)))
2845 (delete-region (point) (+ (point) (cdr (cdr inactive))))
2846 (widget-put widget :inactive nil)
2847 (widget-apply widget :create)
2848 (widget-value-set widget (car inactive))
2849 (widget-setup)))))
2850
2851(defun custom-face-edit-delete (widget)
3127aa13 2852 "Remove WIDGET from the buffer."
3ea051cb
MB
2853 (let ((inactive (widget-get widget :inactive))
2854 (inhibit-read-only t)
2855 (inhibit-modification-hooks t))
2856 (if (not inactive)
2857 ;; Widget is alive, we don't have to do anything special
2858 (widget-default-delete widget)
2859 ;; WIDGET is already deleted because we did so to inactivate it;
2860 ;; now just get rid of the label we put in its place.
2861 (delete-region (car (cdr inactive))
2862 (+ (car (cdr inactive)) (cdr (cdr inactive))))
2863 (widget-put widget :inactive nil))))
ee1f522d 2864
3ea051cb
MB
2865
2866(defun custom-face-edit-attribute-tag (widget)
2867 "Returns the first :tag property in WIDGET or one of its children."
2868 (let ((tag (widget-get widget :tag)))
2869 (or (and (not (equal tag "")) tag)
2870 (let ((children (widget-get widget :children)))
2871 (while (and (null tag) children)
2872 (setq tag (custom-face-edit-attribute-tag (pop children))))
2873 tag))))
2874
d543e20b
PA
2875;;; The `custom-display' Widget.
2876
2877(define-widget 'custom-display 'menu-choice
2878 "Select a display type."
2879 :tag "Display"
2880 :value t
2881 :help-echo "Specify frames where the face attributes should be used."
2882 :args '((const :tag "all" t)
b9afd6dd 2883 (const :tag "defaults" default)
d543e20b
PA
2884 (checklist
2885 :offset 0
2886 :extra-offset 9
2887 :args ((group :sibling-args (:help-echo "\
2888Only match the specified window systems.")
2889 (const :format "Type: "
2890 type)
2891 (checklist :inline t
2892 :offset 0
2893 (const :format "X "
2894 :sibling-args (:help-echo "\
2895The X11 Window System.")
2896 x)
2897 (const :format "PM "
2898 :sibling-args (:help-echo "\
2899OS/2 Presentation Manager.")
2900 pm)
b97aca27 2901 (const :format "W32 "
d543e20b 2902 :sibling-args (:help-echo "\
b97aca27
GV
2903Windows NT/9X.")
2904 w32)
a0b1a022
AS
2905 (const :format "MAC "
2906 :sibling-args (:help-echo "\
2907Macintosh OS.")
2908 mac)
d543e20b
PA
2909 (const :format "DOS "
2910 :sibling-args (:help-echo "\
2911Plain MS-DOS.")
2912 pc)
2913 (const :format "TTY%n"
2914 :sibling-args (:help-echo "\
2915Plain text terminals.")
2916 tty)))
2917 (group :sibling-args (:help-echo "\
2918Only match the frames with the specified color support.")
2919 (const :format "Class: "
2920 class)
2921 (checklist :inline t
2922 :offset 0
2923 (const :format "Color "
2924 :sibling-args (:help-echo "\
2925Match color frames.")
2926 color)
2927 (const :format "Grayscale "
2928 :sibling-args (:help-echo "\
2929Match grayscale frames.")
2930 grayscale)
2931 (const :format "Monochrome%n"
2932 :sibling-args (:help-echo "\
2933Match frames with no color support.")
2934 mono)))
2935 (group :sibling-args (:help-echo "\
c4d9734c
JL
2936The minimum number of colors the frame should support.")
2937 (const :format "" min-colors)
2938 (integer :tag "Minimum number of colors" ))
2939 (group :sibling-args (:help-echo "\
d543e20b
PA
2940Only match frames with the specified intensity.")
2941 (const :format "\
2942Background brightness: "
2943 background)
2944 (checklist :inline t
2945 :offset 0
2946 (const :format "Light "
2947 :sibling-args (:help-echo "\
2948Match frames with light backgrounds.")
2949 light)
2950 (const :format "Dark\n"
2951 :sibling-args (:help-echo "\
2952Match frames with dark backgrounds.")
2b32d1a7
MB
2953 dark)))
2954 (group :sibling-args (:help-echo "\
2955Only match frames that support the specified face attributes.")
2956 (const :format "Supports attributes:" supports)
4abe16b5 2957 (custom-face-edit :inline t :format "%n%v"))))))
d543e20b
PA
2958
2959;;; The `custom-face' Widget.
2960
d478e69d 2961(defface custom-face-tag
b5555381 2962 `((t (:weight bold :height 1.2 :inherit variable-pitch)))
d543e20b 2963 "Face used for face tags."
bd042c03 2964 :group 'custom-faces)
d478e69d
MB
2965;; backward-compatibility alias
2966(put 'custom-face-tag-face 'face-alias 'custom-face-tag)
d543e20b 2967
d64478da
KH
2968(defcustom custom-face-default-form 'selected
2969 "Default form of displaying face definition."
2970 :type '(choice (const all)
2971 (const selected)
2972 (const lisp))
cd32a7ba
DN
2973 :group 'custom-buffer
2974 :version "20.3")
d64478da 2975
d543e20b
PA
2976(define-widget 'custom-face 'custom
2977 "Customize face."
d543e20b
PA
2978 :sample-face 'custom-face-tag-face
2979 :help-echo "Set or reset this face."
23c0fb21 2980 :documentation-property #'face-doc-string
d543e20b
PA
2981 :value-create 'custom-face-value-create
2982 :action 'custom-face-action
9097aeb7 2983 :custom-category 'face
d64478da 2984 :custom-form nil ; defaults to value of `custom-face-default-form'
d543e20b
PA
2985 :custom-set 'custom-face-set
2986 :custom-save 'custom-face-save
2987 :custom-reset-current 'custom-redraw
2988 :custom-reset-saved 'custom-face-reset-saved
25ac13b5 2989 :custom-reset-standard 'custom-face-reset-standard
4f985043 2990 :custom-standard-value 'custom-face-standard-value
d543e20b
PA
2991 :custom-menu 'custom-face-menu-create)
2992
d3d4df42 2993(define-widget 'custom-face-all 'editable-list
d543e20b
PA
2994 "An editable list of display specifications and attributes."
2995 :entry-format "%i %d %v"
2996 :insert-button-args '(:help-echo "Insert new display specification here.")
2997 :append-button-args '(:help-echo "Append new display specification here.")
2998 :delete-button-args '(:help-echo "Delete this display specification.")
2999 :args '((group :format "%v" custom-display custom-face-edit)))
3000
3001(defconst custom-face-all (widget-convert 'custom-face-all)
3002 "Converted version of the `custom-face-all' widget.")
3003
3004(define-widget 'custom-display-unselected 'item
3005 "A display specification that doesn't match the selected display."
3006 :match 'custom-display-unselected-match)
3007
3008(defun custom-display-unselected-match (widget value)
3009 "Non-nil if VALUE is an unselected display specification."
86bd10bc 3010 (not (face-spec-set-match-display value (selected-frame))))
d543e20b 3011
d3d4df42 3012(define-widget 'custom-face-selected 'group
d543e20b 3013 "Edit the attributes of the selected display in a face specification."
2dfa4c57
RS
3014 :args '((choice :inline t
3015 (group :tag "With Defaults" :inline t
3016 (group (const :tag "" default)
3017 (custom-face-edit :tag " Default\n Attributes"))
3018 (repeat :format ""
3019 :inline t
3020 (group custom-display-unselected sexp))
3021 (group (sexp :format "")
3022 (custom-face-edit :tag " Overriding\n Attributes"))
3023 (repeat :format ""
3024 :inline t
3025 sexp))
3026 (group :tag "No Defaults" :inline t
3027 (repeat :format ""
3028 :inline t
3029 (group custom-display-unselected sexp))
3030 (group (sexp :format "")
3031 (custom-face-edit :tag "\n Attributes"))
3032 (repeat :format ""
3033 :inline t
3034 sexp)))))
3035
3036
d543e20b
PA
3037
3038(defconst custom-face-selected (widget-convert 'custom-face-selected)
3039 "Converted version of the `custom-face-selected' widget.")
3040
3ea051cb 3041(defun custom-filter-face-spec (spec filter-index &optional default-filter)
f5b50baa
MB
3042 "Return a canonicalized version of SPEC using.
3043FILTER-INDEX is the index in the entry for each attribute in
3044`custom-face-attributes' at which the appropriate filter function can be
3045found, and DEFAULT-FILTER is the filter to apply for attributes that
3046don't specify one."
3047 (mapcar (lambda (entry)
3048 ;; Filter a single face-spec entry
3049 (let ((tests (car entry))
3050 (unfiltered-attrs
3051 ;; Handle both old- and new-style attribute syntax
3052 (if (listp (car (cdr entry)))
3053 (car (cdr entry))
3054 (cdr entry)))
3055 (filtered-attrs nil))
3056 ;; Filter each face attribute
3057 (while unfiltered-attrs
3058 (let* ((attr (pop unfiltered-attrs))
3059 (pre-filtered-value (pop unfiltered-attrs))
3060 (filter
3061 (or (nth filter-index (assq attr custom-face-attributes))
3062 default-filter))
3063 (filtered-value
3064 (if filter
3065 (funcall filter pre-filtered-value)
3066 pre-filtered-value)))
3067 (push filtered-value filtered-attrs)
3068 (push attr filtered-attrs)))
3069 ;;
3070 (list tests filtered-attrs)))
3071 spec))
3072
3073(defun custom-pre-filter-face-spec (spec)
3074 "Return SPEC changed as necessary for editing by the face customization widget.
3075SPEC must be a full face spec."
3ea051cb 3076 (custom-filter-face-spec spec 2))
f5b50baa
MB
3077
3078(defun custom-post-filter-face-spec (spec)
3079 "Return the customized SPEC in a form suitable for setting the face."
3ea051cb 3080 (custom-filter-face-spec spec 3))
f5b50baa 3081
d543e20b 3082(defun custom-face-value-create (widget)
944c91b6
PA
3083 "Create a list of the display specifications for WIDGET."
3084 (let ((buttons (widget-get widget :buttons))
d3d4df42 3085 children
944c91b6
PA
3086 (symbol (widget-get widget :value))
3087 (tag (widget-get widget :tag))
3088 (state (widget-get widget :custom-state))
3089 (begin (point))
3090 (is-last (widget-get widget :custom-last))
3091 (prefix (widget-get widget :custom-prefix)))
3092 (unless tag
3093 (setq tag (prin1-to-string symbol)))
3094 (cond ((eq custom-buffer-style 'tree)
da5ec617 3095 (insert prefix (if is-last " `--- " " |--- "))
944c91b6 3096 (push (widget-create-child-and-convert
c953515e 3097 widget 'custom-browse-face-tag)
944c91b6
PA
3098 buttons)
3099 (insert " " tag "\n")
3100 (widget-put widget :buttons buttons))
3101 (t
3102 ;; Create tag.
3103 (insert tag)
c069a9d3 3104 (widget-specify-sample widget begin (point))
944c91b6
PA
3105 (if (eq custom-buffer-style 'face)
3106 (insert " ")
a62ebc52
MB
3107 (if (string-match "face\\'" tag)
3108 (insert ":")
3109 (insert " face: ")))
944c91b6 3110 ;; Sample.
944c91b6
PA
3111 (push (widget-create-child-and-convert widget 'item
3112 :format "(%{%t%})"
3113 :sample-face symbol
3114 :tag "sample")
3115 buttons)
3116 ;; Visibility.
3117 (insert " ")
d3d4df42 3118 (push (widget-create-child-and-convert
944c91b6
PA
3119 widget 'visibility
3120 :help-echo "Hide or show this face."
7f663295
RS
3121 :on "Hide Face"
3122 :off "Show Face"
944c91b6
PA
3123 :action 'custom-toggle-parent
3124 (not (eq state 'hidden)))
3125 buttons)
3126 ;; Magic.
3127 (insert "\n")
3128 (let ((magic (widget-create-child-and-convert
3129 widget 'custom-magic nil)))
3130 (widget-put widget :custom-magic magic)
3131 (push magic buttons))
3132 ;; Update buttons.
3133 (widget-put widget :buttons buttons)
3134 ;; Insert documentation.
3135 (widget-default-format-handler widget ?h)
d3d4df42
DL
3136 ;; The comment field
3137 (unless (eq state 'hidden)
3138 (let* ((comment (get symbol 'face-comment))
3139 (comment-widget
3140 (widget-create-child-and-convert
3141 widget 'custom-comment
3142 :parent widget
3143 :value (or comment ""))))
3144 (widget-put widget :comment-widget comment-widget)
3145 (push comment-widget children)))
944c91b6
PA
3146 ;; See also.
3147 (unless (eq state 'hidden)
3148 (when (eq (widget-get widget :custom-level) 1)
3149 (custom-add-parent-links widget))
3150 (custom-add-see-also widget))
3151 ;; Editor.
3152 (unless (eq (preceding-char) ?\n)
3153 (insert "\n"))
3154 (unless (eq state 'hidden)
3155 (message "Creating face editor...")
3156 (custom-load-widget widget)
d64478da
KH
3157 (unless (widget-get widget :custom-form)
3158 (widget-put widget :custom-form custom-face-default-form))
944c91b6 3159 (let* ((symbol (widget-value widget))
61763509
PA
3160 (spec (or (get symbol 'customized-face)
3161 (get symbol 'saved-face)
944c91b6
PA
3162 (get symbol 'face-defface-spec)
3163 ;; Attempt to construct it.
d3d4df42 3164 (list (list t (custom-face-attributes-get
944c91b6
PA
3165 symbol (selected-frame))))))
3166 (form (widget-get widget :custom-form))
3167 (indent (widget-get widget :indent))
fa0b3d46
RS
3168 edit)
3169 ;; If the user has changed this face in some other way,
3170 ;; edit it as the user has specified it.
3171 (if (not (face-spec-match-p symbol spec (selected-frame)))
3172 (setq spec (list (list t (face-attr-construct symbol (selected-frame))))))
f5b50baa 3173 (setq spec (custom-pre-filter-face-spec spec))
fa0b3d46 3174 (setq edit (widget-create-child-and-convert
944c91b6
PA
3175 widget
3176 (cond ((and (eq form 'selected)
d3d4df42 3177 (widget-apply custom-face-selected
944c91b6
PA
3178 :match spec))
3179 (when indent (insert-char ?\ indent))
3180 'custom-face-selected)
3181 ((and (not (eq form 'lisp))
3182 (widget-apply custom-face-all
3183 :match spec))
3184 'custom-face-all)
d3d4df42 3185 (t
944c91b6
PA
3186 (when indent (insert-char ?\ indent))
3187 'sexp))
fa0b3d46 3188 :value spec))
944c91b6 3189 (custom-face-state-set widget)
d3d4df42
DL
3190 (push edit children)
3191 (widget-put widget :children children))
944c91b6 3192 (message "Creating face editor...done"))))))
d543e20b 3193
d3d4df42 3194(defvar custom-face-menu
3aec85bf 3195 '(("Set for Current Session" custom-face-set)
896a6a5d 3196 ("Save for Future Sessions" custom-face-save-command)
6d528fc5
PA
3197 ("Reset to Saved" custom-face-reset-saved
3198 (lambda (widget)
d3d4df42
DL
3199 (or (get (widget-value widget) 'saved-face)
3200 (get (widget-value widget) 'saved-face-comment))))
19d63704 3201 ("Erase Customization" custom-face-reset-standard
6d528fc5 3202 (lambda (widget)
8697863a
PA
3203 (get (widget-value widget) 'face-defface-spec)))
3204 ("---" ignore ignore)
d3d4df42
DL
3205 ("Add Comment" custom-comment-show custom-comment-invisible-p)
3206 ("---" ignore ignore)
8697863a
PA
3207 ("Show all display specs" custom-face-edit-all
3208 (lambda (widget)
3209 (not (eq (widget-get widget :custom-form) 'all))))
3210 ("Just current attributes" custom-face-edit-selected
3211 (lambda (widget)
3212 (not (eq (widget-get widget :custom-form) 'selected))))
a84ff57a 3213 ("Show as Lisp expression" custom-face-edit-lisp
8697863a
PA
3214 (lambda (widget)
3215 (not (eq (widget-get widget :custom-form) 'lisp)))))
d543e20b 3216 "Alist of actions for the `custom-face' widget.
6d528fc5
PA
3217Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3218the menu entry, ACTION is the function to call on the widget when the
3219menu is selected, and FILTER is a predicate which takes a `custom-face'
3220widget as an argument, and returns non-nil if ACTION is valid on that
19d63704 3221widget. If FILTER is nil, ACTION is always valid.")
d543e20b
PA
3222
3223(defun custom-face-edit-selected (widget)
3224 "Edit selected attributes of the value of WIDGET."
3225 (widget-put widget :custom-state 'unknown)
3226 (widget-put widget :custom-form 'selected)
3227 (custom-redraw widget))
3228
3229(defun custom-face-edit-all (widget)
3230 "Edit all attributes of the value of WIDGET."
3231 (widget-put widget :custom-state 'unknown)
3232 (widget-put widget :custom-form 'all)
3233 (custom-redraw widget))
3234
3235(defun custom-face-edit-lisp (widget)
2365594b 3236 "Edit the Lisp representation of the value of WIDGET."
d543e20b
PA
3237 (widget-put widget :custom-state 'unknown)
3238 (widget-put widget :custom-form 'lisp)
3239 (custom-redraw widget))
3240
3241(defun custom-face-state-set (widget)
3242 "Set the state of WIDGET."
d3d4df42
DL
3243 (let* ((symbol (widget-value widget))
3244 (comment (get symbol 'face-comment))
a4992f73
RS
3245 tmp temp
3246 (state
3247 (cond ((progn
3248 (setq tmp (get symbol 'customized-face))
3249 (setq temp (get symbol 'customized-face-comment))
3250 (or tmp temp))
3251 (if (equal temp comment)
3252 'set
3253 'changed))
3254 ((progn
3255 (setq tmp (get symbol 'saved-face))
3256 (setq temp (get symbol 'saved-face-comment))
3257 (or tmp temp))
3258 (if (equal temp comment)
3259 'saved
3260 'changed))
3261 ((get symbol 'face-defface-spec)
3262 (if (equal comment nil)
3263 'standard
3264 'changed))
3265 (t
3266 'rogue))))
3267 ;; If the user called set-face-attribute to change the default
3268 ;; for new frames, this face is "set outside of Customize".
3269 (if (and (not (eq state 'rogue))
3270 (get symbol 'face-modified))
3271 (setq state 'changed))
3272 (widget-put widget :custom-state state)))
d543e20b
PA
3273
3274(defun custom-face-action (widget &optional event)
3275 "Show the menu for `custom-face' WIDGET.
3276Optional EVENT is the location for the menu."
3277 (if (eq (widget-get widget :custom-state) 'hidden)
6d528fc5 3278 (custom-toggle-hide widget)
d543e20b
PA
3279 (let* ((completion-ignore-case t)
3280 (symbol (widget-get widget :value))
25ac13b5
PA
3281 (answer (widget-choose (concat "Operation on "
3282 (custom-unlispify-tag-name symbol))
6d528fc5
PA
3283 (custom-menu-filter custom-face-menu
3284 widget)
3285 event)))
d543e20b
PA
3286 (if answer
3287 (funcall answer widget)))))
3288
3289(defun custom-face-set (widget)
3290 "Make the face attributes in WIDGET take effect."
3291 (let* ((symbol (widget-value widget))
3292 (child (car (widget-get widget :children)))
f5b50baa 3293 (value (custom-post-filter-face-spec (widget-value child)))
d3d4df42
DL
3294 (comment-widget (widget-get widget :comment-widget))
3295 (comment (widget-value comment-widget)))
3296 (when (equal comment "")
3297 (setq comment nil)
3298 ;; Make the comment invisible by hand if it's empty
164cfaeb 3299 (custom-comment-hide comment-widget))
d543e20b 3300 (put symbol 'customized-face value)
f5b50baa
MB
3301 (if (face-spec-choose value)
3302 (face-spec-set symbol value)
3303 ;; face-set-spec ignores empty attribute lists, so just give it
3304 ;; something harmless instead.
3305 (face-spec-set symbol '((t :foreground unspecified))))
d3d4df42
DL
3306 (put symbol 'customized-face-comment comment)
3307 (put symbol 'face-comment comment)
d543e20b
PA
3308 (custom-face-state-set widget)
3309 (custom-redraw-magic widget)))
3310
896a6a5d
RS
3311(defun custom-face-save-command (widget)
3312 "Save in `.emacs' the face attributes in WIDGET."
3313 (custom-face-save widget)
3314 (custom-save-all))
3315
d543e20b 3316(defun custom-face-save (widget)
896a6a5d 3317 "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
d543e20b
PA
3318 (let* ((symbol (widget-value widget))
3319 (child (car (widget-get widget :children)))
e475612a 3320 (value (custom-post-filter-face-spec (widget-value child)))
d3d4df42
DL
3321 (comment-widget (widget-get widget :comment-widget))
3322 (comment (widget-value comment-widget)))
3323 (when (equal comment "")
3324 (setq comment nil)
3325 ;; Make the comment invisible by hand if it's empty
164cfaeb 3326 (custom-comment-hide comment-widget))
e475612a
MB
3327 (if (face-spec-choose value)
3328 (face-spec-set symbol value)
3329 ;; face-set-spec ignores empty attribute lists, so just give it
3330 ;; something harmless instead.
3331 (face-spec-set symbol '((t :foreground unspecified))))
4f985043
RS
3332 (unless (eq (widget-get widget :custom-state) 'standard)
3333 (put symbol 'saved-face value))
c942535f 3334 (custom-push-theme 'theme-face symbol 'user 'set value)
d543e20b 3335 (put symbol 'customized-face nil)
d3d4df42
DL
3336 (put symbol 'face-comment comment)
3337 (put symbol 'customized-face-comment nil)
3338 (put symbol 'saved-face-comment comment)
6321bddd 3339 (custom-save-all)
d543e20b
PA
3340 (custom-face-state-set widget)
3341 (custom-redraw-magic widget)))
3342
3343(defun custom-face-reset-saved (widget)
3344 "Restore WIDGET to the face's default attributes."
3345 (let* ((symbol (widget-value widget))
3346 (child (car (widget-get widget :children)))
d3d4df42
DL
3347 (value (get symbol 'saved-face))
3348 (comment (get symbol 'saved-face-comment))
3349 (comment-widget (widget-get widget :comment-widget)))
3350 (unless (or value comment)
d543e20b
PA
3351 (error "No saved value for this face"))
3352 (put symbol 'customized-face nil)
d3d4df42 3353 (put symbol 'customized-face-comment nil)
25ac13b5 3354 (face-spec-set symbol value)
d3d4df42 3355 (put symbol 'face-comment comment)
d543e20b 3356 (widget-value-set child value)
d3d4df42
DL
3357 ;; This call manages the comment visibility
3358 (widget-value-set comment-widget (or comment ""))
d543e20b
PA
3359 (custom-face-state-set widget)
3360 (custom-redraw-magic widget)))
3361
4f985043
RS
3362(defun custom-face-standard-value (widget)
3363 (get (widget-value widget) 'face-defface-spec))
3364
25ac13b5 3365(defun custom-face-reset-standard (widget)
19d63704
RS
3366 "Restore WIDGET to the face's standard settings.
3367This operation eliminates any saved setting for the face,
3368restoring it to the state of a face that has never been customized."
d543e20b
PA
3369 (let* ((symbol (widget-value widget))
3370 (child (car (widget-get widget :children)))
d3d4df42
DL
3371 (value (get symbol 'face-defface-spec))
3372 (comment-widget (widget-get widget :comment-widget)))
d543e20b 3373 (unless value
5dd0cad0 3374 (error "No standard setting for this face"))
d543e20b 3375 (put symbol 'customized-face nil)
d3d4df42
DL
3376 (put symbol 'customized-face-comment nil)
3377 (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
d543e20b 3378 (put symbol 'saved-face nil)
c942535f
RS
3379 (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
3380 ;; Do not explictly save resets to standards without themes.
3381 (if (null (cdr (get symbol 'theme-face)))
3382 (put symbol 'theme-face nil))
d3d4df42 3383 (put symbol 'saved-face-comment nil)
d543e20b 3384 (custom-save-all))
25ac13b5 3385 (face-spec-set symbol value)
d3d4df42 3386 (put symbol 'face-comment nil)
d543e20b 3387 (widget-value-set child value)
d3d4df42
DL
3388 ;; This call manages the comment visibility
3389 (widget-value-set comment-widget "")
d543e20b
PA
3390 (custom-face-state-set widget)
3391 (custom-redraw-magic widget)))
3392
3393;;; The `face' Widget.
3394
1833b7b3
RS
3395(defvar widget-face-prompt-value-history nil
3396 "History of input to `widget-face-prompt-value'.")
3397
0e739597
DP
3398(define-widget 'face 'symbol
3399 "A Lisp face name (with sample)."
3400 :format "%t: (%{sample%}) %v"
3401 :tag "Face"
3402 :value 'default
3403 :sample-face-get 'widget-face-sample-face-get
3404 :notify 'widget-face-notify
3405 :match (lambda (widget value) (facep value))
1833b7b3
RS
3406 :complete-function (lambda ()
3407 (interactive)
3408 (lisp-complete-symbol 'facep))
1833b7b3
RS
3409 :prompt-match 'facep
3410 :prompt-history 'widget-face-prompt-value-history
1833b7b3
RS
3411 :validate (lambda (widget)
3412 (unless (facep (widget-value widget))
0e739597
DP
3413 (widget-put widget
3414 :error (format "Invalid face: %S"
3415 (widget-value widget)))
3416 widget)))
3417
3418(defun widget-face-sample-face-get (widget)
3419 (let ((value (widget-value widget)))
3420 (if (facep value)
3421 value
3422 'default)))
3423
3424(defun widget-face-notify (widget child &optional event)
3425 "Update the sample, and notify the parent."
3426 (overlay-put (widget-get widget :sample-overlay)
3427 'face (widget-apply widget :sample-face-get))
3428 (widget-default-notify widget child event))
1833b7b3 3429
d543e20b
PA
3430
3431;;; The `hook' Widget.
3432
3433(define-widget 'hook 'list
3434 "A emacs lisp hook"
f985c5f7 3435 :value-to-internal (lambda (widget value)
5aa3f181 3436 (if (and value (symbolp value))
f985c5f7
PA
3437 (list value)
3438 value))
3439 :match (lambda (widget value)
3440 (or (symbolp value)
4743fc91 3441 (widget-group-match widget value)))
2365594b
DL
3442 ;; Avoid adding undefined functions to the hook, especially for
3443 ;; things like `find-file-hook' or even more basic ones, to avoid
3444 ;; chaos.
3445 :set (lambda (symbol value)
d4881668
SM
3446 (dolist (elt value)
3447 (if (fboundp elt)
3448 (add-hook symbol elt))))
d543e20b
PA
3449 :convert-widget 'custom-hook-convert-widget
3450 :tag "Hook")
3451
3452(defun custom-hook-convert-widget (widget)
3c708e98 3453 ;; Handle `:options'.
d543e20b 3454 (let* ((options (widget-get widget :options))
d3d4df42 3455 (other `(editable-list :inline t
d543e20b
PA
3456 :entry-format "%i %d%v"
3457 (function :format " %v")))
3458 (args (if options
3459 (list `(checklist :inline t
3460 ,@(mapcar (lambda (entry)
3461 `(function-item ,entry))
3462 options))
3463 other)
3464 (list other))))
3465 (widget-put widget :args args)
3466 widget))
3467
944c91b6
PA
3468;;; The `custom-group-link' Widget.
3469
3470(define-widget 'custom-group-link 'link
3471 "Show parent in other window when activated."
b62c92bb 3472 :help-echo "Create customization buffer for this group."
944c91b6
PA
3473 :action 'custom-group-link-action)
3474
3475(defun custom-group-link-action (widget &rest ignore)
3476 (customize-group (widget-value widget)))
3477
d543e20b
PA
3478;;; The `custom-group' Widget.
3479
b62c92bb 3480(defcustom custom-group-tag-faces nil
d543e20b 3481 ;; In XEmacs, this ought to play games with font size.
d3d4df42 3482 ;; Fixme: make it do so in Emacs.
d543e20b
PA
3483 "Face used for group tags.
3484The first member is used for level 1 groups, the second for level 2,
d478e69d 3485and so forth. The remaining group tags are shown with `custom-group-tag'."
d543e20b 3486 :type '(repeat face)
bd042c03 3487 :group 'custom-faces)
d543e20b 3488
d478e69d 3489(defface custom-group-tag-1
16b20ed9
GM
3490 `((((class color)
3491 (background dark))
b5555381 3492 (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
ea81d57e
DN
3493 (((min-colors 88) (class color)
3494 (background light))
3495 (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch))
16b20ed9
GM
3496 (((class color)
3497 (background light))
b5555381
RS
3498 (:foreground "red" :weight bold :height 1.2 :inherit variable-pitch))
3499 (t (:weight bold)))
16b20ed9
GM
3500 "Face used for group tags."
3501 :group 'custom-faces)
d478e69d
MB
3502;; backward-compatibility alias
3503(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1)
16b20ed9 3504
d478e69d 3505(defface custom-group-tag
16b20ed9
GM
3506 `((((class color)
3507 (background dark))
b5555381 3508 (:foreground "light blue" :weight bold :height 1.2))
ea81d57e
DN
3509 (((min-colors 88) (class color)
3510 (background light))
3511 (:foreground "blue1" :weight bold :height 1.2))
16b20ed9
GM
3512 (((class color)
3513 (background light))
b5555381
RS
3514 (:foreground "blue" :weight bold :height 1.2))
3515 (t (:weight bold)))
d543e20b 3516 "Face used for low level group tags."
bd042c03 3517 :group 'custom-faces)
d478e69d
MB
3518;; backward-compatibility alias
3519(put 'custom-group-tag-face 'face-alias 'custom-group-tag)
d543e20b
PA
3520
3521(define-widget 'custom-group 'custom
3522 "Customize group."
944c91b6 3523 :format "%v"
d543e20b
PA
3524 :sample-face-get 'custom-group-sample-face-get
3525 :documentation-property 'group-documentation
3526 :help-echo "Set or reset all members of this group."
3527 :value-create 'custom-group-value-create
3528 :action 'custom-group-action
9097aeb7 3529 :custom-category 'group
d543e20b
PA
3530 :custom-set 'custom-group-set
3531 :custom-save 'custom-group-save
3532 :custom-reset-current 'custom-group-reset-current
3533 :custom-reset-saved 'custom-group-reset-saved
25ac13b5 3534 :custom-reset-standard 'custom-group-reset-standard
d543e20b
PA
3535 :custom-menu 'custom-group-menu-create)
3536
3537(defun custom-group-sample-face-get (widget)
3538 ;; Use :sample-face.
3539 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
d478e69d 3540 'custom-group-tag))
d543e20b 3541
8691cfa7
RS
3542(define-widget 'custom-group-visibility 'visibility
3543 "An indicator and manipulator for hidden group contents."
3544 :create 'custom-group-visibility-create)
3545
3546(defun custom-group-visibility-create (widget)
3547 (let ((visible (widget-value widget)))
3548 (if visible
3549 (insert "--------")))
3550 (widget-default-create widget))
3551
4ee1cf9f
PA
3552(defun custom-group-members (symbol groups-only)
3553 "Return SYMBOL's custom group members.
3554If GROUPS-ONLY non-nil, return only those members that are groups."
3555 (if (not groups-only)
3556 (get symbol 'custom-group)
3557 (let (members)
3558 (dolist (entry (get symbol 'custom-group))
3559 (when (eq (nth 1 entry) 'custom-group)
3560 (push entry members)))
3561 (nreverse members))))
3562
d543e20b 3563(defun custom-group-value-create (widget)
944c91b6 3564 "Insert a customize group for WIDGET in the current buffer."
2de2cb02 3565 (unless (eq (widget-get widget :custom-state) 'hidden)
2ee398c4 3566 (custom-load-widget widget))
4ee1cf9f
PA
3567 (let* ((state (widget-get widget :custom-state))
3568 (level (widget-get widget :custom-level))
f985c5f7 3569 ;; (indent (widget-get widget :indent))
4ee1cf9f
PA
3570 (prefix (widget-get widget :custom-prefix))
3571 (buttons (widget-get widget :buttons))
3572 (tag (widget-get widget :tag))
3573 (symbol (widget-value widget))
3574 (members (custom-group-members symbol
3575 (and (eq custom-buffer-style 'tree)
3576 custom-browse-only-groups))))
944c91b6 3577 (cond ((and (eq custom-buffer-style 'tree)
c953515e 3578 (eq state 'hidden)
4ee1cf9f 3579 (or members (custom-unloaded-widget-p widget)))
c953515e 3580 (custom-browse-insert-prefix prefix)
944c91b6 3581 (push (widget-create-child-and-convert
d3d4df42 3582 widget 'custom-browse-visibility
da5ec617 3583 ;; :tag-glyph "plus"
df816618 3584 :tag "+")
944c91b6
PA
3585 buttons)
3586 (insert "-- ")
da5ec617 3587 ;; (widget-glyph-insert nil "-- " "horizontal")
944c91b6 3588 (push (widget-create-child-and-convert
c953515e 3589 widget 'custom-browse-group-tag)
944c91b6
PA
3590 buttons)
3591 (insert " " tag "\n")
3592 (widget-put widget :buttons buttons))
3593 ((and (eq custom-buffer-style 'tree)
4ee1cf9f 3594 (zerop (length members)))
c953515e 3595 (custom-browse-insert-prefix prefix)
da5ec617
PA
3596 (insert "[ ]-- ")
3597 ;; (widget-glyph-insert nil "[ ]" "empty")
3598 ;; (widget-glyph-insert nil "-- " "horizontal")
d3d4df42 3599 (push (widget-create-child-and-convert
c953515e 3600 widget 'custom-browse-group-tag)
944c91b6
PA
3601 buttons)
3602 (insert " " tag "\n")
3603 (widget-put widget :buttons buttons))
3604 ((eq custom-buffer-style 'tree)
c953515e 3605 (custom-browse-insert-prefix prefix)
4ee1cf9f 3606 (if (zerop (length members))
d3d4df42 3607 (progn
c953515e 3608 (custom-browse-insert-prefix prefix)
da5ec617
PA
3609 (insert "[ ]-- ")
3610 ;; (widget-glyph-insert nil "[ ]" "empty")
3611 ;; (widget-glyph-insert nil "-- " "horizontal")
d3d4df42 3612 (push (widget-create-child-and-convert
c953515e 3613 widget 'custom-browse-group-tag)
944c91b6
PA
3614 buttons)
3615 (insert " " tag "\n")
3616 (widget-put widget :buttons buttons))
d3d4df42
DL
3617 (push (widget-create-child-and-convert
3618 widget 'custom-browse-visibility
da5ec617
PA
3619 ;; :tag-glyph "minus"
3620 :tag "-")
944c91b6 3621 buttons)
da5ec617
PA
3622 (insert "-\\ ")
3623 ;; (widget-glyph-insert nil "-\\ " "top")
d3d4df42 3624 (push (widget-create-child-and-convert
c953515e 3625 widget 'custom-browse-group-tag)
944c91b6
PA
3626 buttons)
3627 (insert " " tag "\n")
3628 (widget-put widget :buttons buttons)
3629 (message "Creating group...")
4ee1cf9f 3630 (let* ((members (custom-sort-items members
da5ec617
PA
3631 custom-browse-sort-alphabetically
3632 custom-browse-order-groups))
944c91b6
PA
3633 (prefixes (widget-get widget :custom-prefixes))
3634 (custom-prefix-list (custom-prefix-add symbol prefixes))
944c91b6
PA
3635 (extra-prefix (if (widget-get widget :custom-last)
3636 " "
3637 " | "))
3638 (prefix (concat prefix extra-prefix))
3639 children entry)
3640 (while members
3641 (setq entry (car members)
3642 members (cdr members))
4ee1cf9f
PA
3643 (push (widget-create-child-and-convert
3644 widget (nth 1 entry)
3645 :group widget
3646 :tag (custom-unlispify-tag-name (nth 0 entry))
3647 :custom-prefixes custom-prefix-list
3648 :custom-level (1+ level)
3649 :custom-last (null members)
3650 :value (nth 0 entry)
3651 :custom-prefix prefix)
3652 children))
944c91b6
PA
3653 (widget-put widget :children (reverse children)))
3654 (message "Creating group...done")))
3655 ;; Nested style.
3656 ((eq state 'hidden)
3657 ;; Create level indicator.
26c7b3ef
RS
3658 (unless (eq custom-buffer-style 'links)
3659 (insert-char ?\ (* custom-buffer-indent (1- level)))
3660 (insert "-- "))
944c91b6
PA
3661 ;; Create tag.
3662 (let ((begin (point)))
3663 (insert tag)
3664 (widget-specify-sample widget begin (point)))
3665 (insert " group: ")
3666 ;; Create link/visibility indicator.
3667 (if (eq custom-buffer-style 'links)
3668 (push (widget-create-child-and-convert
d3d4df42 3669 widget 'custom-group-link
b62c92bb 3670 :tag "Go to Group"
944c91b6
PA
3671 symbol)
3672 buttons)
d3d4df42 3673 (push (widget-create-child-and-convert
98d5aafe 3674 widget 'custom-group-visibility
944c91b6
PA
3675 :help-echo "Show members of this group."
3676 :action 'custom-toggle-parent
3677 (not (eq state 'hidden)))
3678 buttons))
3679 (insert " \n")
3680 ;; Create magic button.
3681 (let ((magic (widget-create-child-and-convert
3682 widget 'custom-magic nil)))
3683 (widget-put widget :custom-magic magic)
3684 (push magic buttons))
3685 ;; Update buttons.
3686 (widget-put widget :buttons buttons)
3687 ;; Insert documentation.
26c7b3ef
RS
3688 (if (and (eq custom-buffer-style 'links) (> level 1))
3689 (widget-put widget :documentation-indent 0))
944c91b6
PA
3690 (widget-default-format-handler widget ?h))
3691 ;; Nested style.
3692 (t ;Visible.
d377bee9
RS
3693 ;; Add parent groups references above the group.
3694 (if t ;;; This should test that the buffer
3695 ;;; was made to display a group.
3696 (when (eq level 1)
cd6c0940
RS
3697 (if (custom-add-parent-links widget
3698 "Go to parent group:")
d377bee9 3699 (insert "\n"))))
944c91b6
PA
3700 ;; Create level indicator.
3701 (insert-char ?\ (* custom-buffer-indent (1- level)))
3702 (insert "/- ")
3703 ;; Create tag.
3704 (let ((start (point)))
3705 (insert tag)
3706 (widget-specify-sample widget start (point)))
3707 (insert " group: ")
3708 ;; Create visibility indicator.
3709 (unless (eq custom-buffer-style 'links)
3710 (insert "--------")
d3d4df42 3711 (push (widget-create-child-and-convert
944c91b6
PA
3712 widget 'visibility
3713 :help-echo "Hide members of this group."
3714 :action 'custom-toggle-parent
3715 (not (eq state 'hidden)))
3716 buttons)
3717 (insert " "))
3718 ;; Create more dashes.
3719 ;; Use 76 instead of 75 to compensate for the temporary "<"
d3d4df42 3720 ;; added by `widget-insert'.
944c91b6
PA
3721 (insert-char ?- (- 76 (current-column)
3722 (* custom-buffer-indent level)))
3723 (insert "\\\n")
3724 ;; Create magic button.
3725 (let ((magic (widget-create-child-and-convert
d3d4df42 3726 widget 'custom-magic
944c91b6
PA
3727 :indent 0
3728 nil)))
3729 (widget-put widget :custom-magic magic)
3730 (push magic buttons))
3731 ;; Update buttons.
3732 (widget-put widget :buttons buttons)
3733 ;; Insert documentation.
3734 (widget-default-format-handler widget ?h)
d377bee9
RS
3735 ;; Parent groups.
3736 (if nil ;;; This should test that the buffer
3737 ;;; was not made to display a group.
3738 (when (eq level 1)
3739 (insert-char ?\ custom-buffer-indent)
3740 (custom-add-parent-links widget)))
d3d4df42 3741 (custom-add-see-also widget
944c91b6
PA
3742 (make-string (* custom-buffer-indent level)
3743 ?\ ))
3744 ;; Members.
3745 (message "Creating group...")
4ee1cf9f 3746 (let* ((members (custom-sort-items members
da5ec617
PA
3747 custom-buffer-sort-alphabetically
3748 custom-buffer-order-groups))
944c91b6
PA
3749 (prefixes (widget-get widget :custom-prefixes))
3750 (custom-prefix-list (custom-prefix-add symbol prefixes))
3751 (length (length members))
3752 (count 0)
3753 (children (mapcar (lambda (entry)
3754 (widget-insert "\n")
3755 (message "\
3756Creating group members... %2d%%"
3757 (/ (* 100.0 count) length))
3758 (setq count (1+ count))
3759 (prog1
3760 (widget-create-child-and-convert
3761 widget (nth 1 entry)
3762 :group widget
3763 :tag (custom-unlispify-tag-name
3764 (nth 0 entry))
3765 :custom-prefixes custom-prefix-list
3766 :custom-level (1+ level)
3767 :value (nth 0 entry))
3768 (unless (eq (preceding-char) ?\n)
3769 (widget-insert "\n"))))
3770 members)))
3771 (message "Creating group magic...")
fadbdfea 3772 (mapc 'custom-magic-reset children)
944c91b6
PA
3773 (message "Creating group state...")
3774 (widget-put widget :children children)
3775 (custom-group-state-update widget)
3776 (message "Creating group... done"))
3777 ;; End line
3778 (insert "\n")
3779 (insert-char ?\ (* custom-buffer-indent (1- level)))
3780 (insert "\\- " (widget-get widget :tag) " group end ")
3781 (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
3782 (insert "/\n")))))
d543e20b 3783
d3d4df42 3784(defvar custom-group-menu
3aec85bf 3785 '(("Set for Current Session" custom-group-set
6d528fc5
PA
3786 (lambda (widget)
3787 (eq (widget-get widget :custom-state) 'modified)))
3aec85bf 3788 ("Save for Future Sessions" custom-group-save
6d528fc5
PA
3789 (lambda (widget)
3790 (memq (widget-get widget :custom-state) '(modified set))))
3791 ("Reset to Current" custom-group-reset-current
3792 (lambda (widget)
86bd10bc 3793 (memq (widget-get widget :custom-state) '(modified))))
6d528fc5
PA
3794 ("Reset to Saved" custom-group-reset-saved
3795 (lambda (widget)
86bd10bc 3796 (memq (widget-get widget :custom-state) '(modified set))))
25ac13b5 3797 ("Reset to standard setting" custom-group-reset-standard
6d528fc5 3798 (lambda (widget)
86bd10bc 3799 (memq (widget-get widget :custom-state) '(modified set saved)))))
d543e20b 3800 "Alist of actions for the `custom-group' widget.
6d528fc5
PA
3801Each entry has the form (NAME ACTION FILTER) where NAME is the name of
3802the menu entry, ACTION is the function to call on the widget when the
3803menu is selected, and FILTER is a predicate which takes a `custom-group'
3804widget as an argument, and returns non-nil if ACTION is valid on that
d3d4df42 3805widget. If FILTER is nil, ACTION is always valid.")
d543e20b
PA
3806
3807(defun custom-group-action (widget &optional event)
3808 "Show the menu for `custom-group' WIDGET.
3809Optional EVENT is the location for the menu."
3810 (if (eq (widget-get widget :custom-state) 'hidden)
6d528fc5 3811 (custom-toggle-hide widget)
d543e20b 3812 (let* ((completion-ignore-case t)
25ac13b5
PA
3813 (answer (widget-choose (concat "Operation on "
3814 (custom-unlispify-tag-name
3815 (widget-get widget :value)))
6d528fc5
PA
3816 (custom-menu-filter custom-group-menu
3817 widget)
d543e20b
PA
3818 event)))
3819 (if answer
3820 (funcall answer widget)))))
3821
3822(defun custom-group-set (widget)
3823 "Set changes in all modified group members."
3824 (let ((children (widget-get widget :children)))
fadbdfea
DL
3825 (mapc (lambda (child)
3826 (when (eq (widget-get child :custom-state) 'modified)
3827 (widget-apply child :custom-set)))
d543e20b
PA
3828 children )))
3829
3830(defun custom-group-save (widget)
3831 "Save all modified group members."
3832 (let ((children (widget-get widget :children)))
fadbdfea
DL
3833 (mapc (lambda (child)
3834 (when (memq (widget-get child :custom-state) '(modified set))
3835 (widget-apply child :custom-save)))
d543e20b
PA
3836 children )))
3837
3838(defun custom-group-reset-current (widget)
3839 "Reset all modified group members."
3840 (let ((children (widget-get widget :children)))
fadbdfea
DL
3841 (mapc (lambda (child)
3842 (when (eq (widget-get child :custom-state) 'modified)
3843 (widget-apply child :custom-reset-current)))
d543e20b
PA
3844 children )))
3845
3846(defun custom-group-reset-saved (widget)
3847 "Reset all modified or set group members."
3848 (let ((children (widget-get widget :children)))
fadbdfea
DL
3849 (mapc (lambda (child)
3850 (when (memq (widget-get child :custom-state) '(modified set))
3851 (widget-apply child :custom-reset-saved)))
d543e20b
PA
3852 children )))
3853
25ac13b5 3854(defun custom-group-reset-standard (widget)
d543e20b
PA
3855 "Reset all modified, set, or saved group members."
3856 (let ((children (widget-get widget :children)))
fadbdfea
DL
3857 (mapc (lambda (child)
3858 (when (memq (widget-get child :custom-state)
3859 '(modified set saved))
3860 (widget-apply child :custom-reset-standard)))
d543e20b
PA
3861 children )))
3862
3863(defun custom-group-state-update (widget)
3864 "Update magic."
3865 (unless (eq (widget-get widget :custom-state) 'hidden)
3866 (let* ((children (widget-get widget :children))
3867 (states (mapcar (lambda (child)
3868 (widget-get child :custom-state))
3869 children))
25ac13b5
PA
3870 (magics custom-magic-alist)
3871 (found 'standard))
d543e20b
PA
3872 (while magics
3873 (let ((magic (car (car magics))))
3874 (if (and (not (eq magic 'hidden))
3875 (memq magic states))
3876 (setq found magic
3877 magics nil)
3878 (setq magics (cdr magics)))))
3879 (widget-put widget :custom-state found)))
3880 (custom-magic-reset widget))
f8d869d1
RS
3881\f
3882;;; Reading and writing the custom file.
d543e20b 3883
a1a4fa22 3884;;;###autoload
1e4ed6df 3885(defcustom custom-file nil
d543e20b 3886 "File used for storing customization information.
1e4ed6df 3887The default is nil, which means to use your init file
09b73f49
RS
3888as specified by `user-init-file'. If the value is not nil,
3889it should be an absolute file name.
3890
5aa971e3
LT
3891You can set this option through Custom, if you carefully read the
3892last paragraph below. However, usually it is simpler to write
3893something like the following in your init file:
3894
3895\(setq custom-file \"~/.emacs-custom.el\")
3896\(load custom-file)
3897
3898Note that both lines are necessary: the first line tells Custom to
3899save all customizations in this file, but does not load it.
3900
3901When you change this variable outside Custom, look in the
3902previous custom file \(usually your init file) for the
3903forms `(custom-set-variables ...)' and `(custom-set-faces ...)',
3904and copy them (whichever ones you find) to the new custom file.
3905This will preserve your existing customizations.
3906
3907If you save this option using Custom, Custom will write all
3908currently saved customizations, including the new one for this
3909option itself, into the file you specify, overwriting any
3910`custom-set-variables' and `custom-set-faces' forms already
3911present in that file. It will not delete any customizations from
3912the old custom file. You should do that manually if that is what you
3913want. You also have to put something like `\(load \"CUSTOM-FILE\")
3914in your init file, where CUSTOM-FILE is the actual name of the
3915file. Otherwise, Emacs will not load the file when it starts up,
3916and hence will not set `custom-file' to that file either."
3917 :type '(choice (const :tag "Your Emacs init file" nil)
3918 (file :format "%t:%v%d"
3919 :doc
3920 "Please read entire docstring below before setting \
3921this through Custom.
3922Click om \"More\" \(or position point there and press RETURN)
3923if only the first line of the docstring is shown."))
d543e20b
PA
3924 :group 'customize)
3925
176eb8cb
KH
3926(defun custom-file ()
3927 "Return the file name for saving customizations."
541044b0
RS
3928 (file-chase-links
3929 (or custom-file
3930 (let ((user-init-file user-init-file)
3931 (default-init-file
3932 (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
3933 (when (null user-init-file)
3934 (if (or (file-exists-p default-init-file)
3935 (and (eq system-type 'windows-nt)
3936 (file-exists-p "~/_emacs")))
3937 ;; Started with -q, i.e. the file containing
3938 ;; Custom settings hasn't been read. Saving
3939 ;; settings there would overwrite other settings.
3940 (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
3941 (setq user-init-file default-init-file))
3942 user-init-file))))
176eb8cb 3943
f8d869d1
RS
3944;;;###autoload
3945(defun custom-save-all ()
3946 "Save all customizations in `custom-file'."
3947 (let* ((filename (custom-file))
3948 (recentf-exclude (if recentf-mode
3949 (cons (concat "\\`"
3950 (regexp-quote (custom-file))
3951 "\\'")
3952 recentf-exclude)))
3953 (old-buffer (find-buffer-visiting filename)))
3954 (with-current-buffer (or old-buffer (find-file-noselect filename))
3955 (let ((inhibit-read-only t))
3956 (custom-save-variables)
3957 (custom-save-faces))
3958 (let ((file-precious-flag t))
3959 (save-buffer))
3960 (unless old-buffer
3961 (kill-buffer (current-buffer))))))
3962\f
3963;; Editing the custom file contents in a buffer.
3964
d543e20b 3965(defun custom-save-delete (symbol)
f8d869d1 3966 "Delete all calls to SYMBOL from the contents of the current buffer.
a34511a1 3967Leave point at the old location of the first such call,
f8d869d1
RS
3968or (if there were none) at the end of the buffer.
3969
3970This function does not save the buffer."
d543e20b 3971 (goto-char (point-min))
cbe8bb8e
KH
3972 ;; Skip all whitespace and comments.
3973 (while (forward-comment 1))
3974 (or (eobp)
3975 (save-excursion (forward-sexp (buffer-size)))) ; Test for scan errors.
a34511a1
RS
3976 (let (first)
3977 (catch 'found
3978 (while t ;; We exit this loop only via throw.
3979 ;; Skip all whitespace and comments.
3980 (while (forward-comment 1))
3981 (let ((start (point))
3982 (sexp (condition-case nil
3983 (read (current-buffer))
3984 (end-of-file (throw 'found nil)))))
3985 (when (and (listp sexp)
3986 (eq (car sexp) symbol))
3987 (delete-region start (point))
3988 (unless first
3989 (setq first (point)))))))
3990 (if first
3991 (goto-char first)
189638d5
GM
3992 ;; Move in front of local variables, otherwise long Custom
3993 ;; entries would make them ineffective.
3994 (let ((pos (point-max))
3995 (case-fold-search t))
3996 (save-excursion
3997 (goto-char (point-max))
3998 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
3999 'move)
4000 (when (search-forward "Local Variables:" nil t)
4001 (setq pos (line-beginning-position))))
4002 (goto-char pos)))))
d543e20b
PA
4003
4004(defun custom-save-variables ()
4005 "Save all customized variables in `custom-file'."
4006 (save-excursion
c942535f
RS
4007 (custom-save-delete 'custom-load-themes)
4008 (custom-save-delete 'custom-reset-variables)
d543e20b 4009 (custom-save-delete 'custom-set-variables)
c942535f
RS
4010 (custom-save-loaded-themes)
4011 (custom-save-resets 'theme-value 'custom-reset-variables nil)
d151422c
MR
4012 (let ((standard-output (current-buffer))
4013 (saved-list (make-list 1 0))
4014 sort-fold-case)
4015 ;; First create a sorted list of saved variables.
4016 (mapatoms
4017 (lambda (symbol)
4018 (if (get symbol 'saved-value)
4019 (nconc saved-list (list symbol)))))
4020 (setq saved-list (sort (cdr saved-list) 'string<))
d543e20b
PA
4021 (unless (bolp)
4022 (princ "\n"))
aec2bb63 4023 (princ "(custom-set-variables
99b398e0
RS
4024 ;; custom-set-variables was added by Custom.
4025 ;; If you edit it by hand, you could mess it up, so be careful.
4026 ;; Your init file should contain only one such instance.
4027 ;; If there is more than one, they won't work right.\n")
d9f67134
SM
4028 (dolist (symbol saved-list)
4029 (let ((spec (car-safe (get symbol 'theme-value)))
4030 (value (get symbol 'saved-value))
4031 (requests (get symbol 'custom-requests))
4032 (now (not (or (custom-variable-p symbol)
4033 (and (not (boundp symbol))
4034 (not (eq (get symbol 'force-value)
4035 'rogue))))))
40627755 4036 (comment (get symbol 'saved-variable-comment)))
d9f67134
SM
4037 ;; Check `requests'.
4038 (dolist (request requests)
4039 (when (and (symbolp request) (not (featurep request)))
4040 (message "Unknown requested feature: %s" request)
4041 (setq requests (delq request requests))))
4042 (when (or (and spec
4043 (eq (nth 0 spec) 'user)
4044 (eq (nth 1 spec) 'set))
4045 comment
4046 (and (null spec) (get symbol 'saved-value)))
4047 (unless (bolp)
4048 (princ "\n"))
4049 (princ " '(")
4050 (prin1 symbol)
4051 (princ " ")
4052 (prin1 (car value))
4053 (when (or now requests comment)
4054 (princ " ")
4055 (prin1 now)
4056 (when (or requests comment)
4057 (princ " ")
4058 (prin1 requests)
4059 (when comment
4060 (princ " ")
4061 (prin1 comment))))
4062 (princ ")"))))
a34511a1
RS
4063 (if (bolp)
4064 (princ " "))
d543e20b
PA
4065 (princ ")")
4066 (unless (looking-at "\n")
4067 (princ "\n")))))
4068
4069(defun custom-save-faces ()
4070 "Save all customized faces in `custom-file'."
4071 (save-excursion
c942535f 4072 (custom-save-delete 'custom-reset-faces)
d543e20b 4073 (custom-save-delete 'custom-set-faces)
c942535f 4074 (custom-save-resets 'theme-face 'custom-reset-faces '(default))
d151422c
MR
4075 (let ((standard-output (current-buffer))
4076 (saved-list (make-list 1 0))
4077 sort-fold-case)
4078 ;; First create a sorted list of saved faces.
4079 (mapatoms
4080 (lambda (symbol)
4081 (if (get symbol 'saved-face)
4082 (nconc saved-list (list symbol)))))
4083 (setq saved-list (sort (cdr saved-list) 'string<))
4084 ;; The default face must be first, since it affects the others.
4085 (if (memq 'default saved-list)
4086 (setq saved-list (cons 'default (delq 'default saved-list))))
d543e20b
PA
4087 (unless (bolp)
4088 (princ "\n"))
aec2bb63 4089 (princ "(custom-set-faces
99b398e0
RS
4090 ;; custom-set-faces was added by Custom.
4091 ;; If you edit it by hand, you could mess it up, so be careful.
4092 ;; Your init file should contain only one such instance.
4093 ;; If there is more than one, they won't work right.\n")
d9f67134
SM
4094 (dolist (symbol saved-list)
4095 (let ((spec (car-safe (get symbol 'theme-face)))
4096 (value (get symbol 'saved-face))
4097 (now (not (or (get symbol 'face-defface-spec)
4098 (and (not (custom-facep symbol))
4099 (not (get symbol 'force-face))))))
4100 (comment (get symbol 'saved-face-comment)))
4101 (when (or (and spec
4102 (eq (nth 0 spec) 'user)
4103 (eq (nth 1 spec) 'set))
4104 comment
4105 (and (null spec) (get symbol 'saved-face)))
4106 ;; Don't print default face here.
4107 (unless (bolp)
4108 (princ "\n"))
4109 (princ " '(")
4110 (prin1 symbol)
4111 (princ " ")
4112 (prin1 value)
4113 (when (or now comment)
4114 (princ " ")
4115 (prin1 now)
4116 (when comment
4117 (princ " ")
4118 (prin1 comment)))
4119 (princ ")"))))
a34511a1
RS
4120 (if (bolp)
4121 (princ " "))
d543e20b
PA
4122 (princ ")")
4123 (unless (looking-at "\n")
08b4ae6c 4124 (princ "\n")))))
c942535f
RS
4125
4126(defun custom-save-resets (property setter special)
4127 (let (started-writing ignored-special)
4128 ;; (custom-save-delete setter) Done by caller
4129 (let ((standard-output (current-buffer))
4130 (mapper `(lambda (object)
4131 (let ((spec (car-safe (get object (quote ,property)))))
4132 (when (and (not (memq object ignored-special))
4133 (eq (nth 0 spec) 'user)
4134 (eq (nth 1 spec) 'reset))
4135 ;; Do not write reset statements unless necessary.
4136 (unless started-writing
4137 (setq started-writing t)
4138 (unless (bolp)
4139 (princ "\n"))
4140 (princ "(")
4141 (princ (quote ,setter))
4142 (princ "\n '(")
4143 (prin1 object)
4144 (princ " ")
4145 (prin1 (nth 3 spec))
4146 (princ ")")))))))
4147 (mapc mapper special)
4148 (setq ignored-special special)
4149 (mapatoms mapper)
4150 (when started-writing
4151 (princ ")\n")))))
ee1f522d 4152
c942535f
RS
4153(defun custom-save-loaded-themes ()
4154 (let ((themes (reverse (get 'user 'theme-loads-themes)))
4155 (standard-output (current-buffer)))
4156 (when themes
4157 (unless (bolp) (princ "\n"))
4158 (princ "(custom-load-themes")
4159 (mapc (lambda (theme)
4160 (princ "\n '")
4161 (prin1 theme)) themes)
ee1f522d 4162 (princ " )\n"))))
d543e20b 4163
6d528fc5 4164;;;###autoload
f9dd586e 4165(defun customize-save-customized ()
6d528fc5
PA
4166 "Save all user options which have been set in this session."
4167 (interactive)
4168 (mapatoms (lambda (symbol)
4169 (let ((face (get symbol 'customized-face))
d3d4df42
DL
4170 (value (get symbol 'customized-value))
4171 (face-comment (get symbol 'customized-face-comment))
4172 (variable-comment
4173 (get symbol 'customized-variable-comment)))
4174 (when face
6d528fc5 4175 (put symbol 'saved-face face)
c942535f 4176 (custom-push-theme 'theme-face symbol 'user 'set value)
6d528fc5 4177 (put symbol 'customized-face nil))
d3d4df42 4178 (when value
6d528fc5 4179 (put symbol 'saved-value value)
c942535f 4180 (custom-push-theme 'theme-value symbol 'user 'set value)
d3d4df42
DL
4181 (put symbol 'customized-value nil))
4182 (when variable-comment
4183 (put symbol 'saved-variable-comment variable-comment)
4184 (put symbol 'customized-variable-comment nil))
4185 (when face-comment
4186 (put symbol 'saved-face-comment face-comment)
4187 (put symbol 'customized-face-comment nil)))))
6d528fc5
PA
4188 ;; We really should update all custom buffers here.
4189 (custom-save-all))
f8d869d1 4190\f
d543e20b
PA
4191;;; The Customize Menu.
4192
bd042c03
PA
4193;;; Menu support
4194
25ac13b5
PA
4195(defcustom custom-menu-nesting 2
4196 "Maximum nesting in custom menus."
4197 :type 'integer
6aaedd12 4198 :group 'custom-menu)
d543e20b
PA
4199
4200(defun custom-face-menu-create (widget symbol)
4201 "Ignoring WIDGET, create a menu entry for customization face SYMBOL."
4202 (vector (custom-unlispify-menu-entry symbol)
86bd10bc 4203 `(customize-face ',symbol)
d543e20b
PA
4204 t))
4205
4206(defun custom-variable-menu-create (widget symbol)
4207 "Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
4208 (let ((type (get symbol 'custom-type)))
4209 (unless (listp type)
4210 (setq type (list type)))
4211 (if (and type (widget-get type :custom-menu))
4212 (widget-apply type :custom-menu symbol)
4213 (vector (custom-unlispify-menu-entry symbol)
86bd10bc 4214 `(customize-variable ',symbol)
d543e20b
PA
4215 t))))
4216
bd042c03 4217;; Add checkboxes to boolean variable entries.
d543e20b
PA
4218(widget-put (get 'boolean 'widget-type)
4219 :custom-menu (lambda (widget symbol)
4220 (vector (custom-unlispify-menu-entry symbol)
86bd10bc 4221 `(customize-variable ',symbol)
d543e20b
PA
4222 ':style 'toggle
4223 ':selected symbol)))
4224
d04a3972
DL
4225(defun custom-group-menu-create (widget symbol)
4226 "Ignoring WIDGET, create a menu entry for customization group SYMBOL."
4227 `( ,(custom-unlispify-menu-entry symbol t)
4228 :filter (lambda (&rest junk)
3b2f3d30
SM
4229 (let ((menu (custom-menu-create ',symbol)))
4230 (if (consp menu) (cdr menu) menu)))))
d543e20b 4231
bd042c03
PA
4232;;;###autoload
4233(defun custom-menu-create (symbol)
d543e20b 4234 "Create menu for customization group SYMBOL.
d543e20b 4235The menu is in a format applicable to `easy-menu-define'."
bd042c03 4236 (let* ((item (vector (custom-unlispify-menu-entry symbol)
86bd10bc 4237 `(customize-group ',symbol)
bd042c03
PA
4238 t)))
4239 (if (and (or (not (boundp 'custom-menu-nesting))
4240 (>= custom-menu-nesting 0))
2de2cb02
MR
4241 (progn
4242 (custom-load-symbol symbol)
4243 (< (length (get symbol 'custom-group)) widget-menu-max-size)))
d543e20b 4244 (let ((custom-prefix-list (custom-prefix-add symbol
25ac13b5 4245 custom-prefix-list))
da5ec617
PA
4246 (members (custom-sort-items (get symbol 'custom-group)
4247 custom-menu-sort-alphabetically
4248 custom-menu-order-groups)))
d543e20b
PA
4249 `(,(custom-unlispify-menu-entry symbol t)
4250 ,item
4251 "--"
4252 ,@(mapcar (lambda (entry)
4253 (widget-apply (if (listp (nth 1 entry))
4254 (nth 1 entry)
4255 (list (nth 1 entry)))
4256 :custom-menu (nth 0 entry)))
25ac13b5 4257 members)))
d543e20b
PA
4258 item)))
4259
4260;;;###autoload
bd042c03
PA
4261(defun customize-menu-create (symbol &optional name)
4262 "Return a customize menu for customization group SYMBOL.
d3d4df42 4263If optional NAME is given, use that as the name of the menu.
bd042c03
PA
4264Otherwise the menu will be named `Customize'.
4265The format is suitable for use with `easy-menu-define'."
4266 (unless name
4267 (setq name "Customize"))
d04a3972
DL
4268 `(,name
4269 :filter (lambda (&rest junk)
3b2f3d30
SM
4270 (let ((menu (custom-menu-create ',symbol)))
4271 (if (consp menu) (cdr menu) menu)))))
d543e20b 4272
bd042c03
PA
4273;;; The Custom Mode.
4274
e4105348 4275(defvar custom-mode-map
b92aaee0
SM
4276 ;; This keymap should be dense, but a dense keymap would prevent inheriting
4277 ;; "\r" bindings from the parent map.
e4105348
SM
4278 ;; Actually, this misfeature of dense keymaps was fixed on 2001-11-26.
4279 (let ((map (make-keymap)))
4280 (set-keymap-parent map widget-keymap)
4281 (suppress-keymap map)
4282 (define-key map " " 'scroll-up)
4283 (define-key map "\177" 'scroll-down)
91f48803 4284 (define-key map "\C-c\C-c" 'Custom-set)
e4105348
SM
4285 (define-key map "\C-x\C-s" 'Custom-save)
4286 (define-key map "q" 'Custom-buffer-done)
4287 (define-key map "u" 'Custom-goto-parent)
4288 (define-key map "n" 'widget-forward)
4289 (define-key map "p" 'widget-backward)
e6038ca3 4290 (define-key map [mouse-1] 'widget-move-and-invoke)
e4105348
SM
4291 map)
4292 "Keymap for `custom-mode'.")
0f3335c0 4293
d3d4df42 4294(easy-menu-define Custom-mode-menu
bd042c03
PA
4295 custom-mode-map
4296 "Menu used in customization buffers."
4297 `("Custom"
944c91b6 4298 ,(customize-menu-create 'customize)
ab678382
RS
4299 ["Set" Custom-set t]
4300 ["Save" Custom-save t]
4301 ["Reset to Current" Custom-reset-current t]
4302 ["Reset to Saved" Custom-reset-saved t]
4303 ["Reset to Standard Settings" Custom-reset-standard t]
91f48803 4304 ["Info" (info "(emacs)Easy Customization") t]))
bd042c03 4305
b62c92bb
RS
4306(defun Custom-goto-parent ()
4307 "Go to the parent group listed at the top of this buffer.
4308If several parents are listed, go to the first of them."
4309 (interactive)
4310 (save-excursion
4311 (goto-char (point-min))
4312 (if (search-forward "\nGo to parent group: " nil t)
4313 (let* ((button (get-char-property (point) 'button))
4314 (parent (downcase (widget-get button :tag))))
4315 (customize-group parent)))))
4316
bd042c03 4317(defcustom custom-mode-hook nil
d3d4df42 4318 "Hook called when entering Custom mode."
bd042c03 4319 :type 'hook
6aaedd12 4320 :group 'custom-buffer )
bd042c03 4321
b62c92bb
RS
4322(defun custom-state-buffer-message (widget)
4323 (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
4324 (message "To install your edits, invoke [State] and choose the Set operation")))
8691cfa7 4325
bd042c03
PA
4326(defun custom-mode ()
4327 "Major mode for editing customization buffers.
4328
4329The following commands are available:
4330
4331Move to next button or editable field. \\[widget-forward]
4332Move to previous button or editable field. \\[widget-backward]
4ee1cf9f
PA
4333\\<widget-field-keymap>\
4334Complete content of editable text field. \\[widget-complete]
4335\\<custom-mode-map>\
0f3335c0 4336Invoke button under the mouse pointer. \\[Custom-move-and-invoke]
25ac13b5 4337Invoke button under point. \\[widget-button-press]
ab678382
RS
4338Set all modifications. \\[Custom-set]
4339Make all modifications default. \\[Custom-save]
4340Reset all modified options. \\[Custom-reset-current]
4341Reset all modified or set options. \\[Custom-reset-saved]
4342Reset all options. \\[Custom-reset-standard]
bd042c03
PA
4343
4344Entry to this mode calls the value of `custom-mode-hook'
4345if that value is non-nil."
4346 (kill-all-local-variables)
4347 (setq major-mode 'custom-mode
4348 mode-name "Custom")
4349 (use-local-map custom-mode-map)
ab678382 4350 (easy-menu-add Custom-mode-menu)
bd042c03 4351 (make-local-variable 'custom-options)
9b7826f4 4352 (make-local-variable 'custom-local-buffer)
b62c92bb 4353 (make-local-variable 'widget-documentation-face)
d478e69d 4354 (setq widget-documentation-face 'custom-documentation)
3aec85bf 4355 (make-local-variable 'widget-button-face)
87911bdb
CY
4356 (setq widget-button-face custom-button)
4357 (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
4358 (if custom-raised-buttons
4359 (set (make-local-variable 'widget-mouse-face) custom-button))
4360
d3d4df42
DL
4361 ;; When possible, use relief for buttons, not bracketing. This test
4362 ;; may not be optimal.
4363 (when custom-raised-buttons
4364 (set (make-local-variable 'widget-push-button-prefix) "")
4365 (set (make-local-variable 'widget-push-button-suffix) "")
4366 (set (make-local-variable 'widget-link-prefix) "")
4367 (set (make-local-variable 'widget-link-suffix) ""))
b62c92bb 4368 (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
9598ae53 4369 (run-mode-hooks 'custom-mode-hook))
d543e20b 4370
7f352f86
DL
4371(put 'custom-mode 'mode-class 'special)
4372
2365594b
DL
4373(add-to-list
4374 'debug-ignored-errors
4375 "^No user options have changed defaults in recent Emacs versions$")
4376
d543e20b
PA
4377;;; The End.
4378
4379(provide 'cus-edit)
4380
f7105ede 4381;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f
d3d4df42 4382;;; cus-edit.el ends here