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