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