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