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