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