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