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