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