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