Acknowledge AZ for Emacs icons.
[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)
e46e5225
JL
496 (setq val (if (and (symbolp v) (custom-variable-p v))
497 (completing-read
498 (format "Customize option (default %s): " v) obarray
499 'custom-variable-p t nil nil (symbol-name v))
500 (completing-read "Customize option: " obarray
501 'custom-variable-p t)))
bd042c03 502 (list (if (equal val "")
5b5cdd97
RS
503 (if (symbolp v) v nil)
504 (intern val)))))
bd042c03 505
6d528fc5
PA
506(defun custom-menu-filter (menu widget)
507 "Convert MENU to the form used by `widget-choose'.
508MENU should be in the same format as `custom-variable-menu'.
509WIDGET is the widget to apply the filter entries of MENU on."
510 (let ((result nil)
511 current name action filter)
d3d4df42 512 (while menu
6d528fc5
PA
513 (setq current (car menu)
514 name (nth 0 current)
515 action (nth 1 current)
516 filter (nth 2 current)
517 menu (cdr menu))
518 (if (or (null filter) (funcall filter widget))
519 (push (cons name action) result)
520 (push name result)))
521 (nreverse result)))
522
bd042c03
PA
523;;; Unlispify.
524
d543e20b 525(defvar custom-prefix-list nil
2365594b 526 "List of prefixes that should be ignored by `custom-unlispify'.")
d543e20b
PA
527
528(defcustom custom-unlispify-menu-entries t
529 "Display menu entries as words instead of symbols if non nil."
6aaedd12 530 :group 'custom-menu
d543e20b
PA
531 :type 'boolean)
532
cda987f4
RS
533(defcustom custom-unlispify-remove-prefixes nil
534 "Non-nil means remove group prefixes from option names in buffer."
535 :group 'custom-menu
42b4edc5 536 :group 'custom-buffer
cda987f4
RS
537 :type 'boolean)
538
d543e20b 539(defun custom-unlispify-menu-entry (symbol &optional no-suffix)
2365594b 540 "Convert SYMBOL into a menu entry."
d543e20b
PA
541 (cond ((not custom-unlispify-menu-entries)
542 (symbol-name symbol))
543 ((get symbol 'custom-tag)
544 (if no-suffix
545 (get symbol 'custom-tag)
546 (concat (get symbol 'custom-tag) "...")))
547 (t
d9f67134 548 (with-current-buffer (get-buffer-create " *Custom-Work*")
d543e20b
PA
549 (erase-buffer)
550 (princ symbol (current-buffer))
551 (goto-char (point-min))
3b2f3d30
SM
552 ;; FIXME: Boolean variables are not predicates, so they shouldn't
553 ;; end with `-p'. -stef
554 ;; (when (and (eq (get symbol 'custom-type) 'boolean)
555 ;; (re-search-forward "-p\\'" nil t))
556 ;; (replace-match "" t t)
557 ;; (goto-char (point-min)))
cda987f4
RS
558 (if custom-unlispify-remove-prefixes
559 (let ((prefixes custom-prefix-list)
560 prefix)
561 (while prefixes
562 (setq prefix (car prefixes))
563 (if (search-forward prefix (+ (point) (length prefix)) t)
d3d4df42 564 (progn
cda987f4
RS
565 (setq prefixes nil)
566 (delete-region (point-min) (point)))
567 (setq prefixes (cdr prefixes))))))
d543e20b
PA
568 (subst-char-in-region (point-min) (point-max) ?- ?\ t)
569 (capitalize-region (point-min) (point-max))
d3d4df42 570 (unless no-suffix
d543e20b
PA
571 (goto-char (point-max))
572 (insert "..."))
573 (buffer-string)))))
574
575(defcustom custom-unlispify-tag-names t
576 "Display tag names as words instead of symbols if non nil."
6aaedd12 577 :group 'custom-buffer
d543e20b
PA
578 :type 'boolean)
579
580(defun custom-unlispify-tag-name (symbol)
2365594b 581 "Convert SYMBOL into a menu entry."
d543e20b
PA
582 (let ((custom-unlispify-menu-entries custom-unlispify-tag-names))
583 (custom-unlispify-menu-entry symbol t)))
584
585(defun custom-prefix-add (symbol prefixes)
2365594b 586 "Add SYMBOL to list of ignored PREFIXES."
d543e20b
PA
587 (cons (or (get symbol 'custom-prefix)
588 (concat (symbol-name symbol) "-"))
589 prefixes))
590
bd042c03
PA
591;;; Guess.
592
593(defcustom custom-guess-name-alist
594 '(("-p\\'" boolean)
595 ("-hook\\'" hook)
596 ("-face\\'" face)
597 ("-file\\'" file)
598 ("-function\\'" function)
599 ("-functions\\'" (repeat function))
600 ("-list\\'" (repeat sexp))
601 ("-alist\\'" (repeat (cons sexp sexp))))
602 "Alist of (MATCH TYPE).
603
d3d4df42 604MATCH should be a regexp matching the name of a symbol, and TYPE should
bd042c03
PA
605be a widget suitable for editing the value of that symbol. The TYPE
606of the first entry where MATCH matches the name of the symbol will be
d3d4df42 607used.
bd042c03
PA
608
609This is used for guessing the type of variables not declared with
610customize."
611 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
d543e20b
PA
612 :group 'customize)
613
bd042c03
PA
614(defcustom custom-guess-doc-alist
615 '(("\\`\\*?Non-nil " boolean))
616 "Alist of (MATCH TYPE).
d543e20b 617
bd042c03
PA
618MATCH should be a regexp matching a documentation string, and TYPE
619should be a widget suitable for editing the value of a variable with
620that documentation string. The TYPE of the first entry where MATCH
621matches the name of the symbol will be used.
d543e20b 622
bd042c03
PA
623This is used for guessing the type of variables not declared with
624customize."
625 :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
626 :group 'customize)
d543e20b 627
bd042c03
PA
628(defun custom-guess-type (symbol)
629 "Guess a widget suitable for editing the value of SYMBOL.
d3d4df42 630This is done by matching SYMBOL with `custom-guess-name-alist' and
bd042c03
PA
631if that fails, the doc string with `custom-guess-doc-alist'."
632 (let ((name (symbol-name symbol))
633 (names custom-guess-name-alist)
634 current found)
635 (while names
636 (setq current (car names)
637 names (cdr names))
638 (when (string-match (nth 0 current) name)
639 (setq found (nth 1 current)
640 names nil)))
641 (unless found
642 (let ((doc (documentation-property symbol 'variable-documentation))
643 (docs custom-guess-doc-alist))
d3d4df42 644 (when doc
bd042c03
PA
645 (while docs
646 (setq current (car docs)
647 docs (cdr docs))
648 (when (string-match (nth 0 current) doc)
649 (setq found (nth 1 current)
650 docs nil))))))
651 found))
d543e20b 652
25ac13b5
PA
653;;; Sorting.
654
da5ec617
PA
655(defcustom custom-browse-sort-alphabetically nil
656 "If non-nil, sort members of each customization group alphabetically."
657 :type 'boolean
658 :group 'custom-browse)
659
660(defcustom custom-browse-order-groups nil
661 "If non-nil, order group members within each customization group.
662If `first', order groups before non-groups.
663If `last', order groups after non-groups."
664 :type '(choice (const first)
665 (const last)
666 (const :tag "none" nil))
667 :group 'custom-browse)
668
c953515e
PA
669(defcustom custom-browse-only-groups nil
670 "If non-nil, show group members only within each customization group."
671 :type 'boolean
672 :group 'custom-browse)
673
477ca0e8 674(defcustom custom-buffer-sort-alphabetically nil
da5ec617 675 "If non-nil, sort members of each customization group alphabetically."
944c91b6 676 :type 'boolean
6aaedd12 677 :group 'custom-buffer)
25ac13b5 678
da5ec617
PA
679(defcustom custom-buffer-order-groups 'last
680 "If non-nil, order group members within each customization group.
681If `first', order groups before non-groups.
682If `last', order groups after non-groups."
683 :type '(choice (const first)
684 (const last)
685 (const :tag "none" nil))
6aaedd12 686 :group 'custom-buffer)
25ac13b5 687
944c91b6 688(defcustom custom-menu-sort-alphabetically nil
da5ec617 689 "If non-nil, sort members of each customization group alphabetically."
944c91b6 690 :type 'boolean
6aaedd12 691 :group 'custom-menu)
25ac13b5 692
da5ec617
PA
693(defcustom custom-menu-order-groups 'first
694 "If non-nil, order group members within each customization group.
695If `first', order groups before non-groups.
696If `last', order groups after non-groups."
697 :type '(choice (const first)
698 (const last)
699 (const :tag "none" nil))
6aaedd12
PA
700 :group 'custom-menu)
701
b4854a23
KH
702;;;###autoload (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
703
da5ec617
PA
704(defun custom-sort-items (items sort-alphabetically order-groups)
705 "Return a sorted copy of ITEMS.
706ITEMS should be a `custom-group' property.
707If SORT-ALPHABETICALLY non-nil, sort alphabetically.
708If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
709groups after non-groups, if nil do not order groups at all."
710 (sort (copy-sequence items)
711 (lambda (a b)
712 (let ((typea (nth 1 a)) (typeb (nth 1 b))
359476e0 713 (namea (nth 0 a)) (nameb (nth 0 b)))
da5ec617
PA
714 (cond ((not order-groups)
715 ;; Since we don't care about A and B order, maybe sort.
716 (when sort-alphabetically
717 (string-lessp namea nameb)))
718 ((eq typea 'custom-group)
719 ;; If B is also a group, maybe sort. Otherwise, order A and B.
720 (if (eq typeb 'custom-group)
721 (when sort-alphabetically
722 (string-lessp namea nameb))
723 (eq order-groups 'first)))
724 ((eq typeb 'custom-group)
725 ;; Since A cannot be a group, order A and B.
726 (eq order-groups 'last))
727 (sort-alphabetically
728 ;; Since A and B cannot be groups, sort.
729 (string-lessp namea nameb)))))))
25ac13b5 730
d543e20b
PA
731;;; Custom Mode Commands.
732
bd042c03
PA
733(defvar custom-options nil
734 "Customization widgets in the current buffer.")
735
ab678382 736(defun Custom-set ()
d543e20b
PA
737 "Set changes in all modified options."
738 (interactive)
739 (let ((children custom-options))
fadbdfea
DL
740 (mapc (lambda (child)
741 (when (eq (widget-get child :custom-state) 'modified)
742 (widget-apply child :custom-set)))
d543e20b
PA
743 children)))
744
ab678382 745(defun Custom-save ()
d543e20b
PA
746 "Set all modified group members and save them."
747 (interactive)
748 (let ((children custom-options))
fadbdfea
DL
749 (mapc (lambda (child)
750 (when (memq (widget-get child :custom-state)
751 '(modified set changed rogue))
752 (widget-apply child :custom-save)))
d543e20b
PA
753 children))
754 (custom-save-all))
755
d3d4df42 756(defvar custom-reset-menu
ab678382
RS
757 '(("Current" . Custom-reset-current)
758 ("Saved" . Custom-reset-saved)
19d63704 759 ("Erase Customization (use standard settings)" . Custom-reset-standard))
d543e20b
PA
760 "Alist of actions for the `Reset' button.
761The key is a string containing the name of the action, the value is a
2365594b 762Lisp function taking the widget as an element which will be called
d543e20b
PA
763when the action is chosen.")
764
765(defun custom-reset (event)
766 "Select item from reset menu."
767 (let* ((completion-ignore-case t)
768 (answer (widget-choose "Reset to"
769 custom-reset-menu
770 event)))
771 (if answer
772 (funcall answer))))
773
ab678382 774(defun Custom-reset-current (&rest ignore)
d543e20b
PA
775 "Reset all modified group members to their current value."
776 (interactive)
777 (let ((children custom-options))
fadbdfea 778 (mapc (lambda (widget)
1d58631a
MR
779 (if (memq (widget-get widget :custom-state)
780 '(modified changed))
781 (widget-apply widget :custom-reset-current)))
782 children)))
d543e20b 783
ab678382 784(defun Custom-reset-saved (&rest ignore)
d543e20b
PA
785 "Reset all modified or set group members to their saved value."
786 (interactive)
787 (let ((children custom-options))
fadbdfea 788 (mapc (lambda (widget)
1d58631a
MR
789 (if (memq (widget-get widget :custom-state)
790 '(modified set changed rogue))
791 (widget-apply widget :custom-reset-saved)))
792 children)))
d543e20b 793
ab678382 794(defun Custom-reset-standard (&rest ignore)
19d63704
RS
795 "Erase all customization (either current or saved) for the group members.
796The immediate result is to restore them to their standard settings.
797This operation eliminates any saved settings for the group members,
798making them as if they had never been customized at all."
d543e20b
PA
799 (interactive)
800 (let ((children custom-options))
fadbdfea 801 (mapc (lambda (widget)
4f985043 802 (and (widget-apply widget :custom-standard-value)
fadbdfea
DL
803 (if (memq (widget-get widget :custom-state)
804 '(modified set changed saved rogue))
805 (widget-apply widget :custom-reset-standard))))
d543e20b
PA
806 children)))
807
808;;; The Customize Commands
809
d3d4df42 810(defun custom-prompt-variable (prompt-var prompt-val &optional comment)
6d528fc5
PA
811 "Prompt for a variable and a value and return them as a list.
812PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the
813prompt for the value. The %s escape in PROMPT-VAL is replaced with
814the name of the variable.
815
816If the variable has a `variable-interactive' property, that is used as if
817it were the arg to `interactive' (which see) to interactively read the value.
818
819If the variable has a `custom-type' property, it must be a widget and the
d3d4df42
DL
820`:prompt-value' property of that widget will be used for reading the value.
821
822If optional COMMENT argument is non nil, also prompt for a comment and return
823it as the third element in the list."
6d528fc5 824 (let* ((var (read-variable prompt-var))
d3d4df42
DL
825 (minibuffer-help-form '(describe-variable var))
826 (val
6d528fc5
PA
827 (let ((prop (get var 'variable-interactive))
828 (type (get var 'custom-type))
829 (prompt (format prompt-val var)))
830 (unless (listp type)
831 (setq type (list type)))
832 (cond (prop
833 ;; Use VAR's `variable-interactive' property
834 ;; as an interactive spec for prompting.
835 (call-interactively (list 'lambda '(arg)
836 (list 'interactive prop)
837 'arg)))
838 (type
839 (widget-prompt-value type
840 prompt
841 (if (boundp var)
842 (symbol-value var))
843 (not (boundp var))))
844 (t
d3d4df42
DL
845 (eval-minibuffer prompt))))))
846 (if comment
847 (list var val
848 (read-string "Comment: " (get var 'variable-comment)))
849 (list var val))))
6d528fc5
PA
850
851;;;###autoload
7ec8d2c6 852(defun customize-set-value (variable value &optional comment)
4f9b9060 853 "Set VARIABLE to VALUE, and return VALUE. VALUE is a Lisp object.
6d528fc5
PA
854
855If VARIABLE has a `variable-interactive' property, that is used as if
856it were the arg to `interactive' (which see) to interactively read the value.
857
858If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
859`:prompt-value' property of that widget will be used for reading the value.
860
861If given a prefix (or a COMMENT argument), also prompt for a comment."
6d528fc5 862 (interactive (custom-prompt-variable "Set variable: "
d3d4df42
DL
863 "Set %s to value: "
864 current-prefix-arg))
ee1f522d 865
d3d4df42 866 (cond ((string= comment "")
7ec8d2c6 867 (put variable 'variable-comment nil))
d3d4df42 868 (comment
7ec8d2c6
PJ
869 (put variable 'variable-comment comment)))
870 (set variable value))
6d528fc5
PA
871
872;;;###autoload
2365594b 873(defun customize-set-variable (variable value &optional comment)
4f9b9060
PA
874 "Set the default for VARIABLE to VALUE, and return VALUE.
875VALUE is a Lisp object.
6d528fc5
PA
876
877If VARIABLE has a `custom-set' property, that is used for setting
878VARIABLE, otherwise `set-default' is used.
879
880The `customized-value' property of the VARIABLE will be set to a list
881with a quoted VALUE as its sole list member.
882
883If VARIABLE has a `variable-interactive' property, that is used as if
884it were the arg to `interactive' (which see) to interactively read the value.
885
886If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
887`:prompt-value' property of that widget will be used for reading the value.
888
889If given a prefix (or a COMMENT argument), also prompt for a comment."
6d528fc5 890 (interactive (custom-prompt-variable "Set variable: "
d3d4df42
DL
891 "Set customized value for %s to: "
892 current-prefix-arg))
4f9b9060 893 (custom-load-symbol variable)
2365594b
DL
894 (funcall (or (get variable 'custom-set) 'set-default) variable value)
895 (put variable 'customized-value (list (custom-quote value)))
d3d4df42 896 (cond ((string= comment "")
2365594b
DL
897 (put variable 'variable-comment nil)
898 (put variable 'customized-variable-comment nil))
d3d4df42 899 (comment
2365594b 900 (put variable 'variable-comment comment)
4f9b9060
PA
901 (put variable 'customized-variable-comment comment)))
902 value)
6d528fc5 903
4ee1cf9f 904;;;###autoload
7ec8d2c6 905(defun customize-save-variable (variable value &optional comment)
4ee1cf9f 906 "Set the default for VARIABLE to VALUE, and save it for future sessions.
4f9b9060
PA
907Return VALUE.
908
4ee1cf9f
PA
909If VARIABLE has a `custom-set' property, that is used for setting
910VARIABLE, otherwise `set-default' is used.
911
912The `customized-value' property of the VARIABLE will be set to a list
913with a quoted VALUE as its sole list member.
914
915If VARIABLE has a `variable-interactive' property, that is used as if
916it were the arg to `interactive' (which see) to interactively read the value.
917
918If VARIABLE has a `custom-type' property, it must be a widget and the
d3d4df42
DL
919`:prompt-value' property of that widget will be used for reading the value.
920
921If given a prefix (or a COMMENT argument), also prompt for a comment."
901cd78b 922 (interactive (custom-prompt-variable "Set and save variable: "
d3d4df42
DL
923 "Set and save value for %s as: "
924 current-prefix-arg))
7ec8d2c6
PJ
925 (funcall (or (get variable 'custom-set) 'set-default) variable value)
926 (put variable 'saved-value (list (custom-quote value)))
c942535f 927 (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
d3d4df42 928 (cond ((string= comment "")
7ec8d2c6
PJ
929 (put variable 'variable-comment nil)
930 (put variable 'saved-variable-comment nil))
d3d4df42 931 (comment
7ec8d2c6
PJ
932 (put variable 'variable-comment comment)
933 (put variable 'saved-variable-comment comment)))
4f9b9060
PA
934 (custom-save-all)
935 value)
4ee1cf9f 936
d543e20b 937;;;###autoload
5dd0cad0
RS
938(defun customize ()
939 "Select a customization buffer which you can use to set user options.
940User options are structured into \"groups\".
941Initially the top-level group `Emacs' and its immediate subgroups
942are shown; the contents of those subgroups are initially hidden."
943 (interactive)
dc2e979f 944 (customize-group 'emacs))
5dd0cad0 945
87434e7a
SM
946;;;###autoload
947(defun customize-mode (mode)
948 "Customize options related to the current major mode.
949If a prefix \\[universal-argument] was given (or if the current major mode has no known group),
950then prompt for the MODE to customize."
951 (interactive
952 (list
953 (let ((completion-regexp-list '("-mode\\'"))
954 (group (custom-group-of-mode major-mode)))
955 (if (and group (not current-prefix-arg))
956 major-mode
957 (intern
958 (completing-read (if group
959 (format "Major mode (default %s): " major-mode)
960 "Major mode: ")
961 obarray
962 'custom-group-of-mode
963 t nil nil (if group (symbol-name major-mode))))))))
964 (customize-group (custom-group-of-mode mode)))
965
966
5dd0cad0
RS
967;;;###autoload
968(defun customize-group (group)
969 "Customize GROUP, which must be a customization group."
07e694f8 970 (interactive (list (let ((completion-ignore-case t))
5b76833f 971 (completing-read "Customize group (default emacs): "
d3d4df42 972 obarray
07e694f8 973 (lambda (symbol)
5aa3f181
RS
974 (or (get symbol 'custom-loads)
975 (get symbol 'custom-group)))
07e694f8 976 t))))
5dd0cad0
RS
977 (when (stringp group)
978 (if (string-equal "" group)
979 (setq group 'emacs)
980 (setq group (intern group))))
241d3080
RS
981 (let ((name (format "*Customize Group: %s*"
982 (custom-unlispify-tag-name group))))
983 (if (get-buffer name)
b4854a23 984 (pop-to-buffer name)
241d3080 985 (custom-buffer-create (list (list group 'custom-group))
3aec85bf
RS
986 name
987 (concat " for group "
988 (custom-unlispify-tag-name group))))))
d543e20b 989
6d528fc5 990;;;###autoload
fd88fe73
RS
991(defun customize-group-other-window (group)
992 "Customize GROUP, which must be a customization group."
993 (interactive (list (let ((completion-ignore-case t))
5b76833f 994 (completing-read "Customize group (default emacs): "
d3d4df42 995 obarray
fd88fe73
RS
996 (lambda (symbol)
997 (or (get symbol 'custom-loads)
998 (get symbol 'custom-group)))
999 t))))
1000 (when (stringp group)
1001 (if (string-equal "" group)
1002 (setq group 'emacs)
1003 (setq group (intern group))))
fd88fe73
RS
1004 (let ((name (format "*Customize Group: %s*"
1005 (custom-unlispify-tag-name group))))
1006 (if (get-buffer name)
5f97a49d 1007 (let (
ffec8c5a
MR
1008 ;; Copied from `custom-buffer-create-other-window'.
1009 (pop-up-windows t)
ffec8c5a
MR
1010 (same-window-buffer-names nil)
1011 (same-window-regexps nil))
5f97a49d 1012 (pop-to-buffer name))
fd88fe73
RS
1013 (custom-buffer-create-other-window
1014 (list (list group 'custom-group))
1015 name
1016 (concat " for group "
1017 (custom-unlispify-tag-name group))))))
6d528fc5 1018
9097aeb7
PA
1019;;;###autoload
1020(defalias 'customize-variable 'customize-option)
38d58078 1021
d543e20b 1022;;;###autoload
38d58078
RS
1023(defun customize-option (symbol)
1024 "Customize SYMBOL, which must be a user option variable."
bd042c03 1025 (interactive (custom-variable-prompt))
dcb380c0
LT
1026 (let ((basevar (indirect-variable symbol)))
1027 (custom-buffer-create (list (list basevar 'custom-variable))
1028 (format "*Customize Option: %s*"
1029 (custom-unlispify-tag-name basevar)))
1030 (unless (eq symbol basevar)
1031 (message "`%s' is an alias for `%s'" symbol basevar))))
d543e20b 1032
ffec8c5a
MR
1033;;;###autoload
1034(defalias 'customize-variable-other-window 'customize-option-other-window)
1035
1036;;;###autoload
1037(defun customize-option-other-window (symbol)
1038 "Customize SYMBOL, which must be a user option variable.
1039Show the buffer in another window, but don't select it."
1040 (interactive (custom-variable-prompt))
dcb380c0
LT
1041 (let ((basevar (indirect-variable symbol)))
1042 (custom-buffer-create-other-window
1043 (list (list basevar 'custom-variable))
1044 (format "*Customize Option: %s*" (custom-unlispify-tag-name basevar)))
1045 (unless (eq symbol basevar)
1046 (message "`%s' is an alias for `%s'" symbol basevar))))
ffec8c5a 1047
e418be26
KH
1048(defvar customize-changed-options-previous-release "20.2"
1049 "Version for `customize-changed-options' to refer back to by default.")
1050
c32de15e 1051;;;###autoload
f50dc5d2 1052(defun customize-changed-options (since-version)
e418be26
KH
1053 "Customize all user option variables changed in Emacs itself.
1054This includes new user option variables and faces, and new
1055customization groups, as well as older options and faces whose default
1056values have changed since the previous major Emacs release.
1057
1058With argument SINCE-VERSION (a string), customize all user option
1059variables that were added (or their meanings were changed) since that
2ee398c4 1060version."
e418be26 1061
f50dc5d2
KH
1062 (interactive "sCustomize options changed, since version (default all versions): ")
1063 (if (equal since-version "")
26c67de8
DL
1064 (setq since-version nil)
1065 (unless (condition-case nil
1066 (numberp (read since-version))
1067 (error nil))
1068 (signal 'wrong-type-argument (list 'numberp since-version))))
e418be26
KH
1069 (unless since-version
1070 (setq since-version customize-changed-options-previous-release))
cba752d0
MR
1071
1072 ;; Load the information for versions since since-version. We use
1073 ;; custom-load-symbol for this.
1074 (put 'custom-versions-load-alist 'custom-loads nil)
1075 (dolist (elt custom-versions-load-alist)
2ee398c4
MR
1076 (if (customize-version-lessp since-version (car elt))
1077 (dolist (load (cdr elt))
1078 (custom-add-load 'custom-versions-load-alist load))))
cba752d0
MR
1079 (custom-load-symbol 'custom-versions-load-alist)
1080 (put 'custom-versions-load-alist 'custom-loads nil)
1081
1082 (let (found)
1083 (mapatoms
1084 (lambda (symbol)
1085 (let ((version (get symbol 'custom-version)))
1086 (if version
1087 (when (customize-version-lessp since-version version)
1088 (if (or (get symbol 'custom-group)
1089 (get symbol 'group-documentation))
1090 (push (list symbol 'custom-group) found))
1091 (if (custom-variable-p symbol)
1092 (push (list symbol 'custom-variable) found))
1093 (if (custom-facep symbol)
1094 (push (list symbol 'custom-face) found)))))))
1095 (if found
1096 (custom-buffer-create (custom-sort-items found t 'first)
1097 "*Customize Changed Options*")
1098 (error "No user option defaults have been changed since Emacs %s"
1099 since-version))))
f50dc5d2
KH
1100
1101(defun customize-version-lessp (version1 version2)
26c67de8
DL
1102 ;; Why are the versions strings, and given that they are, why aren't
1103 ;; they converted to numbers and compared as such here? -- fx
1104
e418be26
KH
1105 ;; In case someone made a mistake and left out the quotes
1106 ;; in the :version value.
1107 (if (numberp version2)
1108 (setq version2 (prin1-to-string version2)))
f50dc5d2 1109 (let (major1 major2 minor1 minor2)
26c67de8
DL
1110 (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version1)
1111 (setq major1 (read (or (match-string 1 version1)
1112 "0")))
1113 (setq minor1 (read (or (match-string 3 version1)
1114 "0")))
1115 (string-match "\\([0-9]+\\)\\(\\.\\([0-9]+\\)\\)?" version2)
1116 (setq major2 (read (or (match-string 1 version2)
1117 "0")))
1118 (setq minor2 (read (or (match-string 3 version2)
1119 "0")))
f50dc5d2
KH
1120 (or (< major1 major2)
1121 (and (= major1 major2)
1122 (< minor1 minor2)))))
c942535f 1123
d543e20b 1124;;;###autoload
cdd50dea 1125(defun customize-face (&optional face)
3127aa13 1126 "Customize FACE, which should be a face name or nil.
c40f3193
GM
1127If FACE is nil, customize all faces. If FACE is actually a
1128face-alias, customize the face it is aliased to.
d29a536a
GM
1129
1130Interactively, when point is on text which has a face specified,
3127aa13 1131suggest to customize that face, if it's customizable."
d29a536a 1132 (interactive
cdd50dea
RS
1133 (list (read-face-name "Customize face" "all faces" t)))
1134 (if (member face '(nil ""))
1135 (setq face (face-list)))
1136 (if (and (listp face) (null (cdr face)))
1137 (setq face (car face)))
1138 (if (listp face)
da5ec617 1139 (custom-buffer-create (custom-sort-items
cdd50dea
RS
1140 (mapcar (lambda (s)
1141 (list s 'custom-face))
1142 face)
da5ec617
PA
1143 t nil)
1144 "*Customize Faces*")
c40f3193
GM
1145 ;; If FACE is actually an alias, customize the face it is aliased to.
1146 (if (get face 'face-alias)
1147 (setq face (get face 'face-alias)))
cdd50dea 1148 (unless (facep face)
b59b77f1 1149 (error "Invalid face %S" face))
cdd50dea 1150 (custom-buffer-create (list (list face 'custom-face))
86bd10bc 1151 (format "*Customize Face: %s*"
cdd50dea 1152 (custom-unlispify-tag-name face)))))
d543e20b 1153
bd042c03 1154;;;###autoload
701f49d2 1155(defun customize-face-other-window (&optional face)
3127aa13 1156 "Show customization buffer for face FACE in other window.
c40f3193 1157If FACE is actually a face-alias, customize the face it is aliased to.
d29a536a
GM
1158
1159Interactively, when point is on text which has a face specified,
3127aa13 1160suggest to customize that face, if it's customizable."
d29a536a 1161 (interactive
501d8923
RS
1162 (list (read-face-name "Customize face" "all faces" t)))
1163 (if (member face '(nil ""))
1164 (setq face (face-list)))
1165 (if (and (listp face) (null (cdr face)))
1166 (setq face (car face)))
1167 (if (listp face)
1168 (custom-buffer-create-other-window
1169 (custom-sort-items
1170 (mapcar (lambda (s)
1171 (list s 'custom-face))
1172 face)
1173 t nil)
1174 "*Customize Faces*")
c40f3193
GM
1175 (if (get face 'face-alias)
1176 (setq face (get face 'face-alias)))
501d8923 1177 (unless (facep face)
b59b77f1 1178 (error "Invalid face %S" face))
d3d4df42 1179 (custom-buffer-create-other-window
501d8923
RS
1180 (list (list face 'custom-face))
1181 (format "*Customize Face: %s*"
1182 (custom-unlispify-tag-name face)))))
bd042c03 1183
d543e20b
PA
1184;;;###autoload
1185(defun customize-customized ()
6d528fc5
PA
1186 "Customize all user options set since the last save in this session."
1187 (interactive)
1188 (let ((found nil))
1189 (mapatoms (lambda (symbol)
d3d4df42
DL
1190 (and (or (get symbol 'customized-face)
1191 (get symbol 'customized-face-comment))
6d528fc5 1192 (custom-facep symbol)
a1a4fa22 1193 (push (list symbol 'custom-face) found))
d3d4df42
DL
1194 (and (or (get symbol 'customized-value)
1195 (get symbol 'customized-variable-comment))
6d528fc5 1196 (boundp symbol)
a1a4fa22 1197 (push (list symbol 'custom-variable) found))))
da5ec617
PA
1198 (if (not found)
1199 (error "No customized user options")
1200 (custom-buffer-create (custom-sort-items found t nil)
1201 "*Customize Customized*"))))
6d528fc5
PA
1202
1203;;;###autoload
963c2e09
PA
1204(defun customize-rogue ()
1205 "Customize all user variable modified outside customize."
1206 (interactive)
1207 (let ((found nil))
1208 (mapatoms (lambda (symbol)
1209 (let ((cval (or (get symbol 'customized-value)
1210 (get symbol 'saved-value)
1211 (get symbol 'standard-value))))
1212 (when (and cval ;Declared with defcustom.
1213 (default-boundp symbol) ;Has a value.
3127aa13 1214 (not (equal (eval (car cval))
963c2e09
PA
1215 ;; Which does not match customize.
1216 (default-value symbol))))
1217 (push (list symbol 'custom-variable) found)))))
1218 (if (not found)
1219 (error "No rogue user options")
1220 (custom-buffer-create (custom-sort-items found t nil)
1221 "*Customize Rogue*"))))
1222;;;###autoload
6d528fc5
PA
1223(defun customize-saved ()
1224 "Customize all already saved user options."
d543e20b
PA
1225 (interactive)
1226 (let ((found nil))
1227 (mapatoms (lambda (symbol)
d3d4df42
DL
1228 (and (or (get symbol 'saved-face)
1229 (get symbol 'saved-face-comment))
d543e20b 1230 (custom-facep symbol)
a1a4fa22 1231 (push (list symbol 'custom-face) found))
d3d4df42
DL
1232 (and (or (get symbol 'saved-value)
1233 (get symbol 'saved-variable-comment))
d543e20b 1234 (boundp symbol)
a1a4fa22 1235 (push (list symbol 'custom-variable) found))))
da5ec617
PA
1236 (if (not found )
1237 (error "No saved user options")
1238 (custom-buffer-create (custom-sort-items found t nil)
1239 "*Customize Saved*"))))
d543e20b
PA
1240
1241;;;###autoload
1242(defun customize-apropos (regexp &optional all)
1243 "Customize all user options matching REGEXP.
a1a4fa22
PA
1244If ALL is `options', include only options.
1245If ALL is `faces', include only faces.
1246If ALL is `groups', include only groups.
1247If ALL is t (interactively, with prefix arg), include options which are not
1248user-settable, as well as faces and groups."
d543e20b
PA
1249 (interactive "sCustomize regexp: \nP")
1250 (let ((found nil))
1251 (mapatoms (lambda (symbol)
1252 (when (string-match regexp (symbol-name symbol))
a1a4fa22
PA
1253 (when (and (not (memq all '(faces options)))
1254 (get symbol 'custom-group))
1255 (push (list symbol 'custom-group) found))
1256 (when (and (not (memq all '(options groups)))
1257 (custom-facep symbol))
1258 (push (list symbol 'custom-face) found))
1259 (when (and (not (memq all '(groups faces)))
1260 (boundp symbol)
d543e20b 1261 (or (get symbol 'saved-value)
3a495e15 1262 (custom-variable-p symbol)
a1a4fa22
PA
1263 (if (memq all '(nil options))
1264 (user-variable-p symbol)
1265 (get symbol 'variable-documentation))))
1266 (push (list symbol 'custom-variable) found)))))
1267 (if (not found)
1268 (error "No matches")
da5ec617
PA
1269 (custom-buffer-create (custom-sort-items found t
1270 custom-buffer-order-groups)
1271 "*Customize Apropos*"))))
a1a4fa22
PA
1272
1273;;;###autoload
1274(defun customize-apropos-options (regexp &optional arg)
1275 "Customize all user options matching REGEXP.
1276With prefix arg, include options which are not user-settable."
1277 (interactive "sCustomize regexp: \nP")
1278 (customize-apropos regexp (or arg 'options)))
1279
1280;;;###autoload
1281(defun customize-apropos-faces (regexp)
1282 "Customize all user faces matching REGEXP."
1283 (interactive "sCustomize regexp: \n")
1284 (customize-apropos regexp 'faces))
1285
1286;;;###autoload
1287(defun customize-apropos-groups (regexp)
1288 "Customize all user groups matching REGEXP."
1289 (interactive "sCustomize regexp: \n")
1290 (customize-apropos regexp 'groups))
d543e20b 1291
6d528fc5
PA
1292;;; Buffer.
1293
944c91b6
PA
1294(defcustom custom-buffer-style 'links
1295 "Control the presentation style for customization buffers.
1296The value should be a symbol, one of:
1297
1298brackets: groups nest within each other with big horizontal brackets.
1299links: groups have links to subgroups."
1300 :type '(radio (const brackets)
1301 (const links))
1302 :group 'custom-buffer)
1303
97733c3d
RS
1304(defcustom custom-buffer-done-kill nil
1305 "*Non-nil means exiting a Custom buffer should kill it."
1306 :type 'boolean
bf247b6e 1307 :version "22.1"
d3d4df42
DL
1308 :group 'custom-buffer)
1309
944c91b6
PA
1310(defcustom custom-buffer-indent 3
1311 "Number of spaces to indent nested groups."
1312 :type 'integer
1313 :group 'custom-buffer)
1314
40627755
SM
1315(defun custom-get-fresh-buffer (name)
1316 "Get a fresh new buffer with name NAME.
a153acb7
SM
1317If the buffer already exist, clean it up to be like new.
1318Beware: it's not quite like new. Good enough for custom, but maybe
1319not for everybody."
1320 ;; To be more complete, we should also kill all permanent-local variables,
1321 ;; but it's not needed for custom.
40627755 1322 (let ((buf (get-buffer name)))
fd1c38f4 1323 (when (and buf (buffer-local-value 'buffer-file-name buf))
a153acb7
SM
1324 ;; This will check if the file is not saved.
1325 (kill-buffer buf)
1326 (setq buf nil))
40627755
SM
1327 (if (null buf)
1328 (get-buffer-create name)
1329 (with-current-buffer buf
1330 (kill-all-local-variables)
a153acb7 1331 (run-hooks 'kill-buffer-hook)
f5a9b180
SM
1332 ;; Delete overlays before erasing the buffer so the overlay hooks
1333 ;; don't get run spuriously when we erase the buffer.
40627755
SM
1334 (let ((ols (overlay-lists)))
1335 (dolist (ol (nconc (car ols) (cdr ols)))
1336 (delete-overlay ol)))
f5a9b180 1337 (erase-buffer)
40627755
SM
1338 buf))))
1339
d543e20b 1340;;;###autoload
3aec85bf 1341(defun custom-buffer-create (options &optional name description)
d543e20b 1342 "Create a buffer containing OPTIONS.
86bd10bc 1343Optional NAME is the name of the buffer.
d543e20b
PA
1344OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
1345SYMBOL is a customization option, and WIDGET is a widget for editing
1346that option."
40627755 1347 (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*")))
3aec85bf 1348 (custom-buffer-create-internal options description))
bd042c03 1349
6d528fc5 1350;;;###autoload
3aec85bf 1351(defun custom-buffer-create-other-window (options &optional name description)
5f97a49d
RS
1352 "Create a buffer containing OPTIONS, and display it in another window.
1353The result includes selecting that window.
86bd10bc 1354Optional NAME is the name of the buffer.
bd042c03
PA
1355OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
1356SYMBOL is a customization option, and WIDGET is a widget for editing
1357that option."
86bd10bc 1358 (unless name (setq name "*Customization*"))
5f97a49d 1359 (let ((pop-up-windows t)
b4854a23
KH
1360 (same-window-buffer-names nil)
1361 (same-window-regexps nil))
40627755 1362 (pop-to-buffer (custom-get-fresh-buffer name))
5f97a49d 1363 (custom-buffer-create-internal options description)))
9097aeb7
PA
1364
1365(defcustom custom-reset-button-menu nil
1366 "If non-nil, only show a single reset button in customize buffers.
1367This button will have a menu with all three reset operations."
1368 :type 'boolean
6aaedd12 1369 :group 'custom-buffer)
bd042c03 1370
c42c5c7c
KS
1371(defcustom custom-buffer-verbose-help t
1372 "If non-nil, include explanatory text in the customization buffer."
1373 :type 'boolean
1374 :group 'custom-buffer)
1375
d3d4df42 1376(defun Custom-buffer-done (&rest ignore)
97733c3d 1377 "Exit current Custom buffer according to `custom-buffer-done-kill'."
d3d4df42 1378 (interactive)
97733c3d 1379 (quit-window custom-buffer-done-kill))
d3d4df42 1380
87911bdb
CY
1381(defvar custom-button nil
1382 "Face used for buttons in customization buffers.")
1383
1384(defvar custom-button-pressed nil
1385 "Face used for pressed buttons in customization buffers.")
1386
d3d4df42
DL
1387(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
1388 '(("unspecified" . unspecified))))
1389 "If non-nil, indicate active buttons in a `raised-button' style.
1390Otherwise use brackets."
1391 :type 'boolean
1392 :version "21.1"
87911bdb
CY
1393 :group 'custom-buffer
1394 :set (lambda (variable value)
1395 (custom-set-default variable value)
1396 (setq custom-button
1397 (if value 'custom-button 'custom-button-unraised))
1398 (setq custom-button-pressed
1399 (if value
1400 'custom-button-pressed
1401 'custom-button-pressed-unraised))))
d3d4df42 1402
3aec85bf 1403(defun custom-buffer-create-internal (options &optional description)
d543e20b 1404 (custom-mode)
c42c5c7c
KS
1405 (if custom-buffer-verbose-help
1406 (progn
1407 (widget-insert "This is a customization buffer")
1408 (if description
1409 (widget-insert description))
1410 (widget-insert (format ".
d3d4df42 1411%s show active fields; type RET or click mouse-1
3aec85bf 1412on an active field to invoke its action. Editing an option value
167eefc5
LT
1413changes only the text in the buffer. Invoke the State button to set or
1414save the option value. Saving an option normally edits your init file.
1415Invoke "
1416 (if custom-raised-buttons
1417 "`Raised' buttons"
1418 "Square brackets")))
1419 (widget-create 'info-link
1420 :tag "Custom file"
1421 "(emacs)Saving Customizations")
1422 (widget-insert
1423 " for information on how to save in a different file.
1424Invoke ")
c42c5c7c
KS
1425 (widget-create 'info-link
1426 :tag "Help"
1427 :help-echo "Read the online help."
1428 "(emacs)Easy Customization")
167eefc5 1429 (widget-insert " for general information.\n\n")
c42c5c7c
KS
1430 (widget-insert "Operate on everything in this buffer:\n "))
1431 (widget-insert " "))
25ac13b5 1432 (widget-create 'push-button
0f3335c0 1433 :tag "Set for Current Session"
b62c92bb
RS
1434 :help-echo "\
1435Make your editing in this buffer take effect for this session."
25ac13b5 1436 :action (lambda (widget &optional event)
ab678382 1437 (Custom-set)))
25ac13b5
PA
1438 (widget-insert " ")
1439 (widget-create 'push-button
0f3335c0 1440 :tag "Save for Future Sessions"
25ac13b5 1441 :help-echo "\
9f5d3236 1442Make your editing in this buffer take effect for future Emacs sessions.
470cefd3 1443This updates your Emacs initialization file or creates a new one."
25ac13b5 1444 :action (lambda (widget &optional event)
ab678382 1445 (Custom-save)))
9097aeb7 1446 (if custom-reset-button-menu
0f3335c0
RS
1447 (progn
1448 (widget-insert " ")
1449 (widget-create 'push-button
1450 :tag "Reset"
1451 :help-echo "Show a menu with reset operations."
1452 :mouse-down-action (lambda (&rest junk) t)
1453 :action (lambda (widget &optional event)
1454 (custom-reset event))))
1455 (widget-insert "\n ")
9097aeb7
PA
1456 (widget-create 'push-button
1457 :tag "Reset"
c32de15e 1458 :help-echo "\
b62c92bb 1459Reset all edited text in this buffer to reflect current values."
ab678382 1460 :action 'Custom-reset-current)
9097aeb7
PA
1461 (widget-insert " ")
1462 (widget-create 'push-button
1463 :tag "Reset to Saved"
c32de15e 1464 :help-echo "\
b62c92bb 1465Reset all values in this buffer to their saved settings."
ab678382 1466 :action 'Custom-reset-saved)
9097aeb7
PA
1467 (widget-insert " ")
1468 (widget-create 'push-button
19d63704 1469 :tag "Erase Customization"
c32de15e 1470 :help-echo "\
19d63704 1471Un-customize all values in this buffer. They get their standard settings."
ab678382 1472 :action 'Custom-reset-standard))
c42c5c7c
KS
1473 (if (not custom-buffer-verbose-help)
1474 (progn
1475 (widget-insert " ")
1476 (widget-create 'info-link
1477 :tag "Help"
1478 :help-echo "Read the online help."
1479 "(emacs)Easy Customization")))
0eef62d5 1480 (widget-insert " ")
25ac13b5 1481 (widget-create 'push-button
d3d4df42 1482 :tag "Finish"
91a38db1
DL
1483 :help-echo
1484 (lambda (&rest ignore)
97733c3d
RS
1485 (if custom-buffer-done-kill
1486 "Kill this buffer"
1487 "Bury this buffer"))
d3d4df42 1488 :action #'Custom-buffer-done)
25ac13b5
PA
1489 (widget-insert "\n\n")
1490 (message "Creating customization items...")
fadbdfea 1491 (buffer-disable-undo)
d3d4df42 1492 (setq custom-options
d543e20b
PA
1493 (if (= (length options) 1)
1494 (mapcar (lambda (entry)
1495 (widget-create (nth 1 entry)
c32de15e 1496 :documentation-shown t
d543e20b
PA
1497 :custom-state 'unknown
1498 :tag (custom-unlispify-tag-name
1499 (nth 0 entry))
1500 :value (nth 0 entry)))
1501 options)
1502 (let ((count 0)
1503 (length (length options)))
1504 (mapcar (lambda (entry)
6b292312
DL
1505 (prog2
1506 (message "Creating customization items ...%2d%%"
1507 (/ (* 100.0 count) length))
1508 (widget-create (nth 1 entry)
d543e20b
PA
1509 :tag (custom-unlispify-tag-name
1510 (nth 0 entry))
1511 :value (nth 0 entry))
6b292312
DL
1512 (setq count (1+ count))
1513 (unless (eq (preceding-char) ?\n)
1514 (widget-insert "\n"))
1515 (widget-insert "\n")))
1516 options))))
d543e20b
PA
1517 (unless (eq (preceding-char) ?\n)
1518 (widget-insert "\n"))
a9bcbf3f 1519 (message "Creating customization items ...done")
1833b7b3 1520 (message "Resetting customization items...")
944c91b6 1521 (unless (eq custom-buffer-style 'tree)
fadbdfea 1522 (mapc 'custom-magic-reset custom-options))
1833b7b3 1523 (message "Resetting customization items...done")
d543e20b
PA
1524 (message "Creating customization setup...")
1525 (widget-setup)
fadbdfea 1526 (buffer-enable-undo)
d543e20b 1527 (goto-char (point-min))
1833b7b3 1528 (message "Creating customization setup...done"))
d543e20b 1529
944c91b6
PA
1530;;; The Tree Browser.
1531
1532;;;###autoload
4ee1cf9f 1533(defun customize-browse (&optional group)
944c91b6 1534 "Create a tree browser for the customize hierarchy."
cda987f4 1535 (interactive)
4ee1cf9f
PA
1536 (unless group
1537 (setq group 'emacs))
1538 (let ((name "*Customize Browser*"))
40627755 1539 (pop-to-buffer (custom-get-fresh-buffer name)))
4ee1cf9f
PA
1540 (custom-mode)
1541 (widget-insert "\
cda987f4
RS
1542Square brackets show active fields; type RET or click mouse-1
1543on an active field to invoke its action.
df816618 1544Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
4ee1cf9f
PA
1545 (if custom-browse-only-groups
1546 (widget-insert "\
c953515e 1547Invoke the [Group] button below to edit that item in another window.\n\n")
d3d4df42
DL
1548 (widget-insert "Invoke the ")
1549 (widget-create 'item
4ee1cf9f
PA
1550 :format "%t"
1551 :tag "[Group]"
1552 :tag-glyph "folder")
1553 (widget-insert ", ")
d3d4df42 1554 (widget-create 'item
4ee1cf9f
PA
1555 :format "%t"
1556 :tag "[Face]"
1557 :tag-glyph "face")
1558 (widget-insert ", and ")
d3d4df42 1559 (widget-create 'item
4ee1cf9f
PA
1560 :format "%t"
1561 :tag "[Option]"
1562 :tag-glyph "option")
1563 (widget-insert " buttons below to edit that
c953515e 1564item in another window.\n\n"))
4ee1cf9f 1565 (let ((custom-buffer-style 'tree))
d3d4df42 1566 (widget-create 'custom-group
4ee1cf9f
PA
1567 :custom-last t
1568 :custom-state 'unknown
1569 :tag (custom-unlispify-tag-name group)
1570 :value group))
f134b461 1571 (widget-setup)
4ee1cf9f 1572 (goto-char (point-min)))
944c91b6 1573
c953515e 1574(define-widget 'custom-browse-visibility 'item
1edec9cf 1575 "Control visibility of items in the customize tree browser."
da5ec617 1576 :format "%[[%t]%]"
c953515e 1577 :action 'custom-browse-visibility-action)
944c91b6 1578
c953515e 1579(defun custom-browse-visibility-action (widget &rest ignore)
944c91b6
PA
1580 (let ((custom-buffer-style 'tree))
1581 (custom-toggle-parent widget)))
1582
c953515e 1583(define-widget 'custom-browse-group-tag 'push-button
944c91b6 1584 "Show parent in other window when activated."
cd6c0940 1585 :tag "Group"
da5ec617 1586 :tag-glyph "folder"
c953515e 1587 :action 'custom-browse-group-tag-action)
944c91b6 1588
c953515e 1589(defun custom-browse-group-tag-action (widget &rest ignore)
944c91b6
PA
1590 (let ((parent (widget-get widget :parent)))
1591 (customize-group-other-window (widget-value parent))))
1592
c953515e 1593(define-widget 'custom-browse-variable-tag 'push-button
944c91b6 1594 "Show parent in other window when activated."
cd6c0940 1595 :tag "Option"
da5ec617 1596 :tag-glyph "option"
c953515e 1597 :action 'custom-browse-variable-tag-action)
944c91b6 1598
c953515e 1599(defun custom-browse-variable-tag-action (widget &rest ignore)
944c91b6
PA
1600 (let ((parent (widget-get widget :parent)))
1601 (customize-variable-other-window (widget-value parent))))
1602
c953515e 1603(define-widget 'custom-browse-face-tag 'push-button
944c91b6 1604 "Show parent in other window when activated."
cd6c0940 1605 :tag "Face"
da5ec617 1606 :tag-glyph "face"
c953515e 1607 :action 'custom-browse-face-tag-action)
944c91b6 1608
c953515e 1609(defun custom-browse-face-tag-action (widget &rest ignore)
944c91b6
PA
1610 (let ((parent (widget-get widget :parent)))
1611 (customize-face-other-window (widget-value parent))))
1612
c953515e 1613(defconst custom-browse-alist '((" " "space")
da5ec617
PA
1614 (" | " "vertical")
1615 ("-\\ " "top")
1616 (" |-" "middle")
1617 (" `-" "bottom")))
1618
c953515e 1619(defun custom-browse-insert-prefix (prefix)
da5ec617 1620 "Insert PREFIX. On XEmacs convert it to line graphics."
d3d4df42 1621 ;; Fixme: do graphics.
da5ec617 1622 (if nil ; (string-match "XEmacs" emacs-version)
d3d4df42 1623 (progn
da5ec617
PA
1624 (insert "*")
1625 (while (not (string-equal prefix ""))
1626 (let ((entry (substring prefix 0 3)))
1627 (setq prefix (substring prefix 3))
1628 (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
c953515e 1629 (name (nth 1 (assoc entry custom-browse-alist))))
da5ec617
PA
1630 (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
1631 (overlay-put overlay 'start-open t)
1632 (overlay-put overlay 'end-open t)))))
1633 (insert prefix)))
1634
d543e20b
PA
1635;;; Modification of Basic Widgets.
1636;;
1637;; We add extra properties to the basic widgets needed here. This is
1638;; fine, as long as we are careful to stay within out own namespace.
1639;;
1640;; We want simple widgets to be displayed by default, but complex
1641;; widgets to be hidden.
1642
1643(widget-put (get 'item 'widget-type) :custom-show t)
1644(widget-put (get 'editable-field 'widget-type)
1645 :custom-show (lambda (widget value)
1646 (let ((pp (pp-to-string value)))
1647 (cond ((string-match "\n" pp)
1648 nil)
1649 ((> (length pp) 40)
1650 nil)
1651 (t t)))))
1652(widget-put (get 'menu-choice 'widget-type) :custom-show t)
1653
1654;;; The `custom-manual' Widget.
1655
1656(define-widget 'custom-manual 'info-link
1657 "Link to the manual entry for this customization option."
1658 :help-echo "Read the manual entry for this option."
1659 :tag "Manual")
1660
1661;;; The `custom-magic' Widget.
1662
6aaedd12
PA
1663(defgroup custom-magic-faces nil
1664 "Faces used by the magic button."
1665 :group 'custom-faces
1666 :group 'custom-buffer)
1667
d478e69d
MB
1668(defface custom-invalid '((((class color))
1669 (:foreground "yellow1" :background "red1"))
1670 (t
1671 (:weight bold :slant italic :underline t)))
6aaedd12
PA
1672 "Face used when the customize item is invalid."
1673 :group 'custom-magic-faces)
d478e69d
MB
1674;; backward-compatibility alias
1675(put 'custom-invalid-face 'face-alias 'custom-invalid)
d543e20b 1676
d478e69d
MB
1677(defface custom-rogue '((((class color))
1678 (:foreground "pink" :background "black"))
1679 (t
1680 (:underline t)))
6aaedd12
PA
1681 "Face used when the customize item is not defined for customization."
1682 :group 'custom-magic-faces)
d478e69d
MB
1683;; backward-compatibility alias
1684(put 'custom-rogue-face 'face-alias 'custom-rogue)
d543e20b 1685
d478e69d
MB
1686(defface custom-modified '((((min-colors 88) (class color))
1687 (:foreground "white" :background "blue1"))
ea81d57e 1688 (((class color))
d478e69d 1689 (:foreground "white" :background "blue"))
2dfa4c57 1690 (t
d478e69d
MB
1691 (:slant italic :bold)))
1692 "Face used when the customize item has been modified."
1693 :group 'custom-magic-faces)
1694;; backward-compatibility alias
1695(put 'custom-modified-face 'face-alias 'custom-modified)
1696
1697(defface custom-set '((((min-colors 88) (class color))
1698 (:foreground "blue1" :background "white"))
1699 (((class color))
1700 (:foreground "blue" :background "white"))
1701 (t
1702 (:slant italic)))
6aaedd12
PA
1703 "Face used when the customize item has been set."
1704 :group 'custom-magic-faces)
d478e69d
MB
1705;; backward-compatibility alias
1706(put 'custom-set-face 'face-alias 'custom-set)
1707
1708(defface custom-changed '((((min-colors 88) (class color))
1709 (:foreground "white" :background "blue1"))
1710 (((class color))
1711 (:foreground "white" :background "blue"))
1712 (t
1713 (:slant italic)))
6aaedd12
PA
1714 "Face used when the customize item has been changed."
1715 :group 'custom-magic-faces)
d478e69d
MB
1716;; backward-compatibility alias
1717(put 'custom-changed-face 'face-alias 'custom-changed)
d543e20b 1718
d478e69d 1719(defface custom-saved '((t (:underline t)))
6aaedd12
PA
1720 "Face used when the customize item has been saved."
1721 :group 'custom-magic-faces)
d478e69d
MB
1722;; backward-compatibility alias
1723(put 'custom-saved-face 'face-alias 'custom-saved)
d543e20b 1724
2dfa4c57
RS
1725(defconst custom-magic-alist
1726 '((nil "#" underline "\
167eefc5 1727UNINITIALIZED, you should not see this.")
2dfa4c57 1728 (unknown "?" italic "\
167eefc5 1729UNKNOWN, you should not see this.")
2dfa4c57 1730 (hidden "-" default "\
167eefc5 1731HIDDEN, invoke \"Show\" in the previous line to show." "\
cbc7d892 1732group now hidden, invoke \"Show\", above, to show contents.")
d478e69d 1733 (invalid "x" custom-invalid "\
167eefc5 1734INVALID, the displayed value cannot be set.")
d478e69d 1735 (modified "*" custom-modified "\
167eefc5 1736EDITED, shown value does not take effect until you set or save it." "\
1833b7b3 1737something in this group has been edited but not set.")
d478e69d 1738 (set "+" custom-set "\
167eefc5 1739SET for current session only." "\
1833b7b3 1740something in this group has been set but not saved.")
d478e69d 1741 (changed ":" custom-changed "\
167eefc5 1742CHANGED outside Customize; operating on it here may be unreliable." "\
25ac13b5 1743something in this group has been changed outside customize.")
d478e69d 1744 (saved "!" custom-saved "\
167eefc5 1745SAVED and set." "\
5dd0cad0 1746something in this group has been set and saved.")
d478e69d 1747 (rogue "@" custom-rogue "\
167eefc5 1748NO CUSTOMIZATION DATA; you should not see this." "\
25ac13b5 1749something in this group is not prepared for customization.")
2dfa4c57 1750 (standard " " nil "\
167eefc5 1751STANDARD." "\
c32de15e 1752visible group members are all at standard settings."))
d543e20b 1753 "Alist of customize option states.
d3d4df42 1754Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
d543e20b
PA
1755
1756STATE is one of the following symbols:
1757
1758`nil'
1759 For internal use, should never occur.
1760`unknown'
1761 For internal use, should never occur.
1762`hidden'
d3d4df42 1763 This item is not being displayed.
d543e20b
PA
1764`invalid'
1765 This item is modified, but has an invalid form.
1766`modified'
1767 This item is modified, and has a valid form.
1768`set'
1769 This item has been set but not saved.
1770`changed'
167eefc5 1771 The current value of this item has been changed outside Customize.
d543e20b
PA
1772`saved'
1773 This item is marked for saving.
1774`rogue'
1775 This item has no customization information.
25ac13b5 1776`standard'
5dd0cad0 1777 This item is unchanged from the standard setting.
d543e20b
PA
1778
1779MAGIC is a string used to present that state.
1780
1781FACE is a face used to present the state.
1782
25ac13b5
PA
1783ITEM-DESC is a string describing the state for options.
1784
1785GROUP-DESC is a string describing the state for groups. If this is
1786left out, ITEM-DESC will be used.
1787
9097aeb7
PA
1788The string %c in either description will be replaced with the
1789category of the item. These are `group'. `option', and `face'.
1790
25ac13b5 1791The list should be sorted most significant first.")
d543e20b
PA
1792
1793(defcustom custom-magic-show 'long
3acab5ef 1794 "If non-nil, show textual description of the state.
b62c92bb 1795If `long', show a full-line description, not just one word."
d543e20b 1796 :type '(choice (const :tag "no" nil)
c992338c
AS
1797 (const long)
1798 (other :tag "short" short))
6aaedd12 1799 :group 'custom-buffer)
d543e20b 1800
9097aeb7 1801(defcustom custom-magic-show-hidden '(option face)
b62c92bb
RS
1802 "Control whether the State button is shown for hidden items.
1803The value should be a list with the custom categories where the State
9097aeb7
PA
1804button should be visible. Possible categories are `group', `option',
1805and `face'."
1806 :type '(set (const group) (const option) (const face))
6aaedd12 1807 :group 'custom-buffer)
3acab5ef 1808
25ac13b5 1809(defcustom custom-magic-show-button nil
b62c92bb 1810 "Show a \"magic\" button indicating the state of each customization option."
d543e20b 1811 :type 'boolean
6aaedd12 1812 :group 'custom-buffer)
d543e20b
PA
1813
1814(define-widget 'custom-magic 'default
1815 "Show and manipulate state for a customization option."
1816 :format "%v"
86bd10bc 1817 :action 'widget-parent-action
6d528fc5 1818 :notify 'ignore
d543e20b
PA
1819 :value-get 'ignore
1820 :value-create 'custom-magic-value-create
1821 :value-delete 'widget-children-value-delete)
1822
86bd10bc
PA
1823(defun widget-magic-mouse-down-action (widget &optional event)
1824 ;; Non-nil unless hidden.
d3d4df42 1825 (not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
86bd10bc
PA
1826 :custom-state)
1827 'hidden)))
1828
d543e20b 1829(defun custom-magic-value-create (widget)
2365594b 1830 "Create compact status report for WIDGET."
d543e20b
PA
1831 (let* ((parent (widget-get widget :parent))
1832 (state (widget-get parent :custom-state))
3acab5ef 1833 (hidden (eq state 'hidden))
25ac13b5 1834 (entry (assq state custom-magic-alist))
d543e20b
PA
1835 (magic (nth 1 entry))
1836 (face (nth 2 entry))
9097aeb7
PA
1837 (category (widget-get parent :custom-category))
1838 (text (or (and (eq category 'group)
25ac13b5
PA
1839 (nth 4 entry))
1840 (nth 3 entry)))
f985c5f7 1841 (form (widget-get parent :custom-form))
d543e20b 1842 children)
9097aeb7 1843 (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
d3d4df42 1844 (setq text (concat (match-string 1 text)
9097aeb7
PA
1845 (symbol-name category)
1846 (match-string 2 text))))
3acab5ef 1847 (when (and custom-magic-show
9097aeb7
PA
1848 (or (not hidden)
1849 (memq category custom-magic-show-hidden)))
25ac13b5 1850 (insert " ")
26c7b3ef
RS
1851 (when (and (eq category 'group)
1852 (not (and (eq custom-buffer-style 'links)
1853 (> (widget-get parent :custom-level) 1))))
944c91b6
PA
1854 (insert-char ?\ (* custom-buffer-indent
1855 (widget-get parent :custom-level))))
d3d4df42
DL
1856 (push (widget-create-child-and-convert
1857 widget 'choice-item
d5c42d02 1858 :help-echo "Change the state of this item."
3acab5ef 1859 :format (if hidden "%t" "%[%t%]")
25ac13b5
PA
1860 :button-prefix 'widget-push-button-prefix
1861 :button-suffix 'widget-push-button-suffix
86bd10bc
PA
1862 :mouse-down-action 'widget-magic-mouse-down-action
1863 :tag "State")
d543e20b
PA
1864 children)
1865 (insert ": ")
b62c92bb
RS
1866 (let ((start (point)))
1867 (if (eq custom-magic-show 'long)
1868 (insert text)
1869 (insert (symbol-name state)))
f985c5f7
PA
1870 (cond ((eq form 'lisp)
1871 (insert " (lisp)"))
1872 ((eq form 'mismatch)
1873 (insert " (mismatch)")))
d478e69d 1874 (put-text-property start (point) 'face 'custom-state))
d543e20b 1875 (insert "\n"))
26c7b3ef
RS
1876 (when (and (eq category 'group)
1877 (not (and (eq custom-buffer-style 'links)
1878 (> (widget-get parent :custom-level) 1))))
944c91b6
PA
1879 (insert-char ?\ (* custom-buffer-indent
1880 (widget-get parent :custom-level))))
d543e20b
PA
1881 (when custom-magic-show-button
1882 (when custom-magic-show
1883 (let ((indent (widget-get parent :indent)))
1884 (when indent
1885 (insert-char ? indent))))
d3d4df42
DL
1886 (push (widget-create-child-and-convert
1887 widget 'choice-item
86bd10bc
PA
1888 :mouse-down-action 'widget-magic-mouse-down-action
1889 :button-face face
3acab5ef
PA
1890 :button-prefix ""
1891 :button-suffix ""
86bd10bc 1892 :help-echo "Change the state."
3acab5ef 1893 :format (if hidden "%t" "%[%t%]")
f985c5f7 1894 :tag (if (memq form '(lisp mismatch))
86bd10bc
PA
1895 (concat "(" magic ")")
1896 (concat "[" magic "]")))
d543e20b
PA
1897 children)
1898 (insert " "))
1899 (widget-put widget :children children)))
1900
1901(defun custom-magic-reset (widget)
1902 "Redraw the :custom-magic property of WIDGET."
1903 (let ((magic (widget-get widget :custom-magic)))
1904 (widget-value-set magic (widget-value magic))))
1905
d543e20b
PA
1906;;; The `custom' Widget.
1907
d478e69d 1908(defface custom-button
3060662f 1909 '((((type x w32 mac) (class color)) ; Like default modeline
1a578e9b
AC
1910 (:box (:line-width 2 :style released-button)
1911 :background "lightgrey" :foreground "black"))
d3d4df42
DL
1912 (t
1913 nil))
87911bdb 1914 "Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
d3d4df42
DL
1915 :version "21.1"
1916 :group 'custom-faces)
d478e69d
MB
1917;; backward-compatibility alias
1918(put 'custom-button-face 'face-alias 'custom-button)
d3d4df42 1919
87911bdb
CY
1920(defface custom-button-unraised
1921 '((((min-colors 88)
1922 (class color) (background light)) :foreground "blue1" :underline t)
1923 (((class color) (background light)) :foreground "blue" :underline t)
1924 (((min-colors 88)
1925 (class color) (background dark)) :foreground "cyan1" :underline t)
1926 (((class color) (background dark)) :foreground "cyan" :underline t)
1927 (t :underline t))
1928 "Face for custom buffer buttons if `custom-raised-buttons' is nil."
1929 :version "22.1"
1930 :group 'custom-faces)
1931
1932(setq custom-button
1933 (if custom-raised-buttons 'custom-button 'custom-button-unraised))
1934
d478e69d 1935(defface custom-button-pressed
3060662f 1936 '((((type x w32 mac) (class color))
1a578e9b
AC
1937 (:box (:line-width 2 :style pressed-button)
1938 :background "lightgrey" :foreground "black"))
d3d4df42
DL
1939 (t
1940 (:inverse-video t)))
87911bdb 1941 "Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
d3d4df42 1942 :version "21.1"
b62c92bb 1943 :group 'custom-faces)
d478e69d
MB
1944;; backward-compatibility alias
1945(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
b62c92bb 1946
87911bdb
CY
1947(defface custom-button-pressed-unraised
1948 '((default :inherit custom-button-unraised)
1949 (((class color) (background light)) :foreground "magenta4")
1950 (((class color) (background dark)) :foreground "violet"))
1951 "Face for pressed custom buttons if `custom-raised-buttons' is nil."
1952 :version "22.1"
1953 :group 'custom-faces)
1954
1955(setq custom-button-pressed
1956 (if custom-raised-buttons
1957 'custom-button-pressed
1958 'custom-button-pressed-unraised))
1959
d478e69d 1960(defface custom-documentation nil
b62c92bb
RS
1961 "Face used for documentation strings in customization buffers."
1962 :group 'custom-faces)
d478e69d
MB
1963;; backward-compatibility alias
1964(put 'custom-documentation-face 'face-alias 'custom-documentation)
1965
1966(defface custom-state '((((class color)
1967 (background dark))
1968 (:foreground "lime green"))
1969 (((class color)
1970 (background light))
1971 (:foreground "dark green"))
1972 (t nil))
b62c92bb
RS
1973 "Face used for State descriptions in the customize buffer."
1974 :group 'custom-faces)
d478e69d
MB
1975;; backward-compatibility alias
1976(put 'custom-state-face 'face-alias 'custom-state)
b62c92bb 1977
d543e20b
PA
1978(define-widget 'custom 'default
1979 "Customize a user option."
944c91b6 1980 :format "%v"
d543e20b 1981 :convert-widget 'custom-convert-widget
d543e20b 1982 :notify 'custom-notify
944c91b6 1983 :custom-prefix ""
d543e20b
PA
1984 :custom-level 1
1985 :custom-state 'hidden
1986 :documentation-property 'widget-subclass-responsibility
1987 :value-create 'widget-subclass-responsibility
1988 :value-delete 'widget-children-value-delete
86bd10bc
PA
1989 :value-get 'widget-value-value-get
1990 :validate 'widget-children-validate
d543e20b
PA
1991 :match (lambda (widget value) (symbolp value)))
1992
1993(defun custom-convert-widget (widget)
2365594b 1994 "Initialize :value and :tag from :args in WIDGET."
d543e20b 1995 (let ((args (widget-get widget :args)))
d3d4df42 1996 (when args
d543e20b
PA
1997 (widget-put widget :value (widget-apply widget
1998 :value-to-internal (car args)))
1999 (widget-put widget :tag (custom-unlispify-tag-name (car args)))
2000 (widget-put widget :args nil)))
2001 widget)
2002
d543e20b
PA
2003(defun custom-notify (widget &rest args)
2004 "Keep track of changes."
0a3a0b56
PA
2005 (let ((state (widget-get widget :custom-state)))
2006 (unless (eq state 'modified)
2007 (unless (memq state '(nil unknown hidden))
2008 (widget-put widget :custom-state 'modified))
2009 (custom-magic-reset widget)
2010 (apply 'widget-default-notify widget args))))
d543e20b
PA
2011
2012(defun custom-redraw (widget)
2013 "Redraw WIDGET with current settings."
6d528fc5
PA
2014 (let ((line (count-lines (point-min) (point)))
2015 (column (current-column))
2016 (pos (point))
d543e20b
PA
2017 (from (marker-position (widget-get widget :from)))
2018 (to (marker-position (widget-get widget :to))))
2019 (save-excursion
2020 (widget-value-set widget (widget-value widget))
2021 (custom-redraw-magic widget))
2022 (when (and (>= pos from) (<= pos to))
6d528fc5 2023 (condition-case nil
d3d4df42 2024 (progn
86bd10bc
PA
2025 (if (> column 0)
2026 (goto-line line)
2027 (goto-line (1+ line)))
6d528fc5
PA
2028 (move-to-column column))
2029 (error nil)))))
d543e20b
PA
2030
2031(defun custom-redraw-magic (widget)
2032 "Redraw WIDGET state with current settings."
d3d4df42 2033 (while widget
d543e20b 2034 (let ((magic (widget-get widget :custom-magic)))
d3d4df42 2035 (cond (magic
944c91b6
PA
2036 (widget-value-set magic (widget-value magic))
2037 (when (setq widget (widget-get widget :group))
2038 (custom-group-state-update widget)))
2039 (t
2040 (setq widget nil)))))
d543e20b
PA
2041 (widget-setup))
2042
2043(defun custom-show (widget value)
2044 "Non-nil if WIDGET should be shown with VALUE by default."
2045 (let ((show (widget-get widget :custom-show)))
2046 (cond ((null show)
2047 nil)
2048 ((eq t show)
2049 t)
2050 (t
2051 (funcall show widget value)))))
2052
d543e20b
PA
2053(defun custom-load-widget (widget)
2054 "Load all dependencies for WIDGET."
2055 (custom-load-symbol (widget-value widget)))
2056
c953515e 2057(defun custom-unloaded-symbol-p (symbol)
3127aa13 2058 "Return non-nil if the dependencies of SYMBOL have not yet been loaded."
c953515e
PA
2059 (let ((found nil)
2060 (loads (get symbol 'custom-loads))
2061 load)
2062 (while loads
2063 (setq load (car loads)
2064 loads (cdr loads))
2065 (cond ((symbolp load)
2066 (unless (featurep load)
2067 (setq found t)))
2068 ((assoc load load-history))
2069 ((assoc (locate-library load) load-history)
2070 (message nil))
2071 (t
2072 (setq found t))))
2073 found))
2074
2075(defun custom-unloaded-widget-p (widget)
3127aa13 2076 "Return non-nil if the dependencies of WIDGET have not yet been loaded."
c953515e
PA
2077 (custom-unloaded-symbol-p (widget-value widget)))
2078
6d528fc5
PA
2079(defun custom-toggle-hide (widget)
2080 "Toggle visibility of WIDGET."
c953515e 2081 (custom-load-widget widget)
6d528fc5
PA
2082 (let ((state (widget-get widget :custom-state)))
2083 (cond ((memq state '(invalid modified))
2084 (error "There are unset changes"))
2085 ((eq state 'hidden)
2086 (widget-put widget :custom-state 'unknown))
d3d4df42 2087 (t
3acab5ef 2088 (widget-put widget :documentation-shown nil)
6d528fc5 2089 (widget-put widget :custom-state 'hidden)))
8697863a
PA
2090 (custom-redraw widget)
2091 (widget-setup)))
6d528fc5 2092
3acab5ef 2093(defun custom-toggle-parent (widget &rest ignore)
b62c92bb 2094 "Toggle visibility of parent of WIDGET."
3acab5ef
PA
2095 (custom-toggle-hide (widget-get widget :parent)))
2096
944c91b6
PA
2097(defun custom-add-see-also (widget &optional prefix)
2098 "Add `See also ...' to WIDGET if there are any links.
2099Insert PREFIX first if non-nil."
2100 (let* ((symbol (widget-get widget :value))
2101 (links (get symbol 'custom-links))
2102 (many (> (length links) 2))
2103 (buttons (widget-get widget :buttons))
2104 (indent (widget-get widget :indent)))
2105 (when links
2106 (when indent
2107 (insert-char ?\ indent))
2108 (when prefix
2109 (insert prefix))
2110 (insert "See also ")
2111 (while links
2112 (push (widget-create-child-and-convert widget (car links))
2113 buttons)
2114 (setq links (cdr links))
2115 (cond ((null links)
2116 (insert ".\n"))
2117 ((null (cdr links))
2118 (if many
2119 (insert ", and ")
2120 (insert " and ")))
d3d4df42 2121 (t
944c91b6
PA
2122 (insert ", "))))
2123 (widget-put widget :buttons buttons))))
2124
cd6c0940
RS
2125(defun custom-add-parent-links (widget &optional initial-string)
2126 "Add \"Parent groups: ...\" to WIDGET if the group has parents.
08adfdbb 2127The value is non-nil if any parents were found.
cd6c0940 2128If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
944c91b6
PA
2129 (let ((name (widget-value widget))
2130 (type (widget-type widget))
2131 (buttons (widget-get widget :buttons))
d377bee9 2132 (start (point))
ac00d71c 2133 (parents nil))
cd6c0940 2134 (insert (or initial-string "Parent groups:"))
944c91b6 2135 (mapatoms (lambda (symbol)
08adfdbb
LT
2136 (when (member (list name type) (get symbol 'custom-group))
2137 (insert " ")
2138 (push (widget-create-child-and-convert
2139 widget 'custom-group-link
2140 :tag (custom-unlispify-tag-name symbol)
2141 symbol)
2142 buttons)
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