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