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