;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
"Basic text editing facilities."
:group 'emacs)
+(defgroup convenience nil
+ "Convenience features for faster editing."
+ :group 'emacs)
+
+(defgroup files nil
+ "Support for editing files."
+ :group 'emacs)
+
+(defgroup wp nil
+ "Support for editing text files."
+ :tag "Text"
+ :group 'emacs)
+
+(defgroup data nil
+ "Support for editing binary data files."
+ :group 'emacs)
+
(defgroup abbrev nil
"Abbreviation handling, typing shortcuts, macros."
:tag "Abbreviations"
- :group 'editing)
+ :group 'convenience)
(defgroup matching nil
"Various sorts of searching and matching."
(defgroup outlines nil
"Support for hierarchical outlining."
- :group 'editing)
+ :group 'wp)
(defgroup external nil
"Interfacing to external utilities."
:group 'emacs)
+(defgroup comm nil
+ "Communications, networking, and remote access to files."
+ :tag "Communication"
+ :group 'emacs)
+
(defgroup processes nil
"Process, subshell, compilation, and job control support."
- :group 'external
- :group 'development)
-
-(defgroup convenience nil
- "Convenience features for faster editing."
- :group 'emacs)
+ :group 'external)
(defgroup programming nil
"Support for programming in other languages."
"Programming tools."
:group 'programming)
-(defgroup oop nil
- "Support for object-oriented programming."
- :group 'programming)
-
(defgroup applications nil
"Applications written in Emacs."
:group 'emacs)
"Fitting Emacs with its environment."
:group 'emacs)
-(defgroup comm nil
- "Communications, networking, remote access to files."
- :tag "Communication"
- :group 'environment)
-
(defgroup hardware nil
- "Support for interfacing with exotic hardware."
+ "Support for interfacing with miscellaneous hardware."
:group 'environment)
(defgroup terminals nil
"Front-ends/assistants for, or emulators of, UNIX features."
:group 'environment)
-(defgroup vms nil
- "Support code for vms."
- :group 'environment)
-
(defgroup i18n nil
"Internationalization and alternate character-set support."
:link '(custom-manual "(emacs)International")
"Support for Emacs frames and window systems."
:group 'environment)
-(defgroup data nil
- "Support editing files of data."
- :group 'emacs)
-
-(defgroup files nil
- "Support editing files."
- :group 'emacs)
-
-(defgroup wp nil
- "Word processing."
- :group 'emacs)
-
(defgroup tex nil
"Code related to the TeX formatter."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
"Support for multiple fonts."
:group 'emacs)
-(defgroup hypermedia nil
- "Support for links between text or other media types."
- :group 'emacs)
-
(defgroup help nil
"Support for on-line help systems."
:group 'emacs)
"Debugging Emacs itself."
:group 'development)
-(defgroup minibuffer nil
- "Controlling the behavior of the minibuffer."
- :link '(custom-manual "(emacs)Minibuffer")
- :group 'environment)
-
(defgroup keyboard nil
"Input from the keyboard."
:group 'environment)
:link '(custom-manual "(emacs)Windows")
:group 'environment)
-(defgroup mac nil
- "Mac specific features."
- :link '(custom-manual "(emacs)Mac OS")
- :group 'environment
- :version "22.1"
- :prefix "mac-")
-
;;; Custom mode keymaps
(defvar custom-mode-map
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
- "Keymap for `custom-mode'.")
+ "Keymap for `Custom-mode'.")
(defvar custom-mode-link-map
(let ((map (make-keymap)))
(define-key map [down-mouse-1] 'mouse-drag-region)
(define-key map [mouse-2] 'widget-move-and-invoke)
map)
- "Local keymap for links in `custom-mode'.")
+ "Local keymap for links in `Custom-mode'.")
(defvar custom-field-keymap
(let ((map (copy-keymap widget-field-keymap)))
:group 'custom-browse)
;;;###autoload
-(defcustom custom-buffer-sort-alphabetically nil
- "If non-nil, sort each customization group alphabetically in Custom buffer."
+(defcustom custom-buffer-sort-alphabetically t
+ "Whether to sort customization groups alphabetically in Custom buffer."
:type 'boolean
:group 'custom-buffer)
(const :tag "none" nil))
:group 'custom-menu)
-;;;###autoload (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'")
+;;;###autoload (add-hook 'same-window-regexps (purecopy "\\`\\*Customiz.*\\*\\'"))
(defun custom-sort-items (items sort-alphabetically order-groups)
"Return a sorted copy of ITEMS.
;;; Custom Mode Commands.
;; This variable is used by `custom-tool-bar-map', or directly by
-;; `custom-buffer-create-internal' if the toolbar is not present and
-;; `custom-buffer-verbose-help' is non-nil.
+;; `custom-buffer-create-internal' if `custom-buffer-verbose-help' is non-nil.
(defvar custom-commands
'(("Set for current session" Custom-set t
(defun Custom-save (&rest ignore)
"Set all edited settings, then save all settings that have been set.
-If a setting was edited and set before, this saves it.
-If a setting was merely edited before, this sets it then saves it."
+If a setting was edited and set before, this saves it. If a
+setting was merely edited before, this sets it then saves it."
(interactive)
- (if (custom-command-apply
- (lambda (child)
- (when (memq (widget-get child :custom-state)
- '(modified set changed rogue))
- (widget-apply child :custom-save)))
- "Save all settings in this buffer? " t)
- (custom-save-all)))
+ (when (custom-command-apply
+ (lambda (child)
+ (when (memq (widget-get child :custom-state)
+ '(modified set changed rogue))
+ (widget-apply child :custom-mark-to-save)))
+ "Save all settings in this buffer? " t)
+ ;; Save changes to buffer and redraw.
+ (custom-save-all)
+ (dolist (child custom-options)
+ (widget-apply child :custom-state-set-and-redraw))))
(defun custom-reset (widget &optional event)
"Select item from reset menu."
(widget-apply widget :custom-reset-saved)))
"Reset all settings (current values and buffer text) to saved values? "))
+;; The next two variables are bound to '(t) by `Custom-reset-standard'
+;; and `custom-group-reset-standard'. If these variables are nil, both
+;; `custom-variable-reset-standard' and `custom-face-reset-standard'
+;; save, reset and redraw the handled widget immediately. Otherwise,
+;; they add the widget to the corresponding list and leave it to
+;; `custom-reset-standard-save-and-update' to save, reset and redraw it.
+(defvar custom-reset-standard-variables-list nil)
+(defvar custom-reset-standard-faces-list nil)
+
+;; The next function was excerpted from `custom-variable-reset-standard'
+;; and `custom-face-reset-standard' and is used to avoid calling
+;; `custom-save-all' repeatedly (and thus saving settings to file one by
+;; one) when erasing all customizations.
+(defun custom-reset-standard-save-and-update ()
+ "Save settings and redraw after erasing customizations."
+ (when (or (and custom-reset-standard-variables-list
+ (not (eq custom-reset-standard-variables-list '(t))))
+ (and custom-reset-standard-faces-list
+ (not (eq custom-reset-standard-faces-list '(t)))))
+ ;; Save settings to file.
+ (custom-save-all)
+ ;; Set state of and redraw variables.
+ (dolist (widget custom-reset-standard-variables-list)
+ (unless (eq widget t)
+ (widget-put widget :custom-state 'unknown)
+ (custom-redraw widget)))
+ ;; Set state of and redraw faces.
+ (dolist (widget custom-reset-standard-faces-list)
+ (unless (eq widget t)
+ (let* ((symbol (widget-value widget))
+ (child (car (widget-get widget :children)))
+ (value (get symbol 'face-defface-spec))
+ (comment-widget (widget-get widget :comment-widget)))
+ (put symbol 'face-comment nil)
+ (widget-value-set child
+ (custom-pre-filter-face-spec
+ (list (list t (custom-face-attributes-get
+ symbol nil)))))
+ ;; This call manages the comment visibility
+ (widget-value-set comment-widget "")
+ (custom-face-state-set widget)
+ (custom-redraw-magic widget))))))
+
(defun Custom-reset-standard (&rest ignore)
- "Erase all customization (either current or saved) for the group members.
+ "Erase all customizations (either current or saved) in current buffer.
The immediate result is to restore them to their standard values.
This operation eliminates any saved values for the group members,
making them as if they had never been customized at all."
(interactive)
- (custom-command-apply
- (lambda (widget)
- (and (or (null (widget-get widget :custom-standard-value))
- (widget-apply widget :custom-standard-value))
- (memq (widget-get widget :custom-state)
- '(modified set changed saved rogue))
- (widget-apply widget :custom-reset-standard)))
- "Erase all customizations for settings in this buffer? " t))
+ ;; Bind these temporarily.
+ (let ((custom-reset-standard-variables-list '(t))
+ (custom-reset-standard-faces-list '(t)))
+ (custom-command-apply
+ (lambda (widget)
+ (and (or (null (widget-get widget :custom-standard-value))
+ (widget-apply widget :custom-standard-value))
+ (memq (widget-get widget :custom-state)
+ '(modified set changed saved rogue))
+ (widget-apply widget :custom-mark-to-reset-standard)))
+ "Erase all customizations for settings in this buffer? " t)
+ (custom-reset-standard-save-and-update)))
;;; The Customize Commands
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "21.1"
+(defvar customize-changed-options-previous-release "23.1"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
+(declare-function apropos-parse-pattern "apropos" (pattern))
+
;;;###autoload
-(defun customize-apropos (regexp &optional all)
- "Customize all loaded options, faces and groups matching REGEXP.
-If ALL is `options', include only options.
-If ALL is `faces', include only faces.
-If ALL is `groups', include only groups.
-If ALL is t (interactively, with prefix arg), include variables
+(defun customize-apropos (pattern &optional type)
+ "Customize all loaded options, faces and groups matching PATTERN.
+PATTERN can be a word, a list of words (separated by spaces),
+or a regexp (using some regexp special characters). If it is a word,
+search for matches for that word as a substring. If it is a list of words,
+search for matches for any two (or more) of those words.
+
+If TYPE is `options', include only options.
+If TYPE is `faces', include only faces.
+If TYPE is `groups', include only groups.
+If TYPE is t (interactively, with prefix arg), include variables
that are not customizable options, as well as faces and groups
\(but we recommend using `apropos-variable' instead)."
- (interactive "sCustomize (regexp): \nP")
- (let ((found nil))
- (mapatoms (lambda (symbol)
- (when (string-match regexp (symbol-name symbol))
- (when (and (not (memq all '(faces options)))
- (get symbol 'custom-group))
- (push (list symbol 'custom-group) found))
- (when (and (not (memq all '(options groups)))
- (custom-facep symbol))
- (push (list symbol 'custom-face) found))
- (when (and (not (memq all '(groups faces)))
- (boundp symbol)
- (eq (indirect-variable symbol) symbol)
- (or (get symbol 'saved-value)
- (custom-variable-p symbol)
- (and (not (memq all '(nil options)))
- (get symbol 'variable-documentation))))
- (push (list symbol 'custom-variable) found)))))
+ (interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
+ (require 'apropos)
+ (apropos-parse-pattern pattern)
+ (let (found tests)
+ (mapatoms
+ `(lambda (symbol)
+ (when (string-match apropos-regexp (symbol-name symbol))
+ ,(if (not (memq type '(faces options)))
+ '(if (get symbol 'custom-group)
+ (push (list symbol 'custom-group) found)))
+ ,(if (not (memq type '(options groups)))
+ '(if (custom-facep symbol)
+ (push (list symbol 'custom-face) found)))
+ ,(if (not (memq type '(groups faces)))
+ `(if (and (boundp symbol)
+ (eq (indirect-variable symbol) symbol)
+ (or (get symbol 'saved-value)
+ (custom-variable-p symbol)
+ ,(if (not (memq type '(nil options)))
+ '(get symbol 'variable-documentation))))
+ (push (list symbol 'custom-variable) found))))))
(if (not found)
(error "No %s matching %s"
- (if (eq all t)
- "items"
- (format "customizable %s"
- (if (memq all '(options faces groups))
- (symbol-name all)
- "items")))
- regexp)
+ (if (eq type t)
+ "items"
+ (format "customizable %s"
+ (if (memq type '(options faces groups))
+ (symbol-name type)
+ "items")))
+ pattern)
(custom-buffer-create
(custom-sort-items found t custom-buffer-order-groups)
"*Customize Apropos*"))))
;;;###autoload
(defun customize-apropos-options (regexp &optional arg)
"Customize all loaded customizable options matching REGEXP.
-With prefix arg, include variables that are not customizable options
+With prefix ARG, include variables that are not customizable options
\(but it is better to use `apropos-variable' if you want to find those)."
(interactive "sCustomize options (regexp): \nP")
(customize-apropos regexp (or arg 'options)))
:group 'custom-buffer)
(defcustom custom-buffer-done-kill nil
- "*Non-nil means exiting a Custom buffer should kill it."
+ "Non-nil means exiting a Custom buffer should kill it."
:type 'boolean
:version "22.1"
:group 'custom-buffer)
(defvar custom-button-pressed nil
"Face used for pressed buttons in customization buffers.")
+(defcustom custom-search-field t
+ "If non-nil, show a search field in Custom buffers."
+ :type 'boolean
+ :version "24.1"
+ :group 'custom-buffer)
+
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
"If non-nil, indicate active buttons in a `raised-button' style.
'custom-button-pressed-unraised))))
(defun custom-buffer-create-internal (options &optional description)
- (custom-mode)
+ (Custom-mode)
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
(when custom-buffer-verbose-help
- (widget-insert "Editing a setting changes only the text in this buffer."
- (if init-file
- "
-To set apply your changes, use the Save or Set buttons.
-Saving a change normally works by editing your init file."
- "
-Currently, these settings cannot be saved for future Emacs sessions,
-possibly because you started Emacs with `-q'.")
+ (widget-insert (if init-file
+ "To apply changes, use the Save or Set buttons."
+ "Custom settings cannot be saved; maybe you started Emacs with `-q'.")
"\nFor details, see ")
(widget-create 'custom-manual
:tag "Saving Customizations"
:help-echo "Read the Emacs manual."
"(emacs)Top")
(widget-insert "."))
- ;; Insert custom command buttons if the toolbar is not in use.
-
(widget-insert "\n")
- ;; tool-bar is not dumped in builds without x.
- (when (not (and (bound-and-true-p tool-bar-mode) (display-graphic-p)))
- (if custom-buffer-verbose-help
- (widget-insert "\n
- Operate on all settings in this buffer that are not marked HIDDEN:\n"))
- (let ((button (lambda (tag action active help icon)
- (widget-insert " ")
- (if (eval active)
- (widget-create 'push-button :tag tag
- :help-echo help :action action))))
- (commands custom-commands))
- (apply button (pop commands)) ; Set for current session
- (apply button (pop commands)) ; Save for future sessions
- (if custom-reset-button-menu
- (progn
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Reset buffer"
- :help-echo "Show a menu with reset operations."
- :mouse-down-action 'ignore
- :action 'custom-reset))
- (widget-insert "\n")
- (apply button (pop commands)) ; Undo edits
- (apply button (pop commands)) ; Reset to saved
- (apply button (pop commands)) ; Erase customization
- (widget-insert " ")
- (pop commands) ; Help (omitted)
- (apply button (pop commands))))) ; Exit
+
+ ;; Insert the search field.
+ (when custom-search-field
+ (widget-insert "\n")
+ (let* ((echo "Search for custom items")
+ (search-widget
+ (widget-create
+ 'editable-field
+ :size 40 :help-echo echo
+ :action `(lambda (widget &optional event)
+ (customize-apropos (widget-value widget))))))
+ (widget-insert " ")
+ (widget-create-child-and-convert
+ search-widget 'push-button
+ :tag "Search"
+ :help-echo echo :action
+ (lambda (widget &optional event)
+ (customize-apropos (widget-value (widget-get widget :parent)))))
+ (widget-insert "\n")))
+
+ ;; The custom command buttons are also in the toolbar, so for a
+ ;; time they were not inserted in the buffer if the toolbar was in use.
+ ;; But it can be a little confusing for the buffer layout to
+ ;; change according to whether or nor the toolbar is on, not to
+ ;; mention that a custom buffer can in theory be created in a
+ ;; frame with a toolbar, then later viewed in one without.
+ ;; So now the buttons are always inserted in the buffer. (Bug#1326)
+ (if custom-buffer-verbose-help
+ (widget-insert "
+ Operate on all settings in this buffer:\n"))
+ (let ((button (lambda (tag action active help icon)
+ (widget-insert " ")
+ (if (eval active)
+ (widget-create 'push-button :tag tag
+ :help-echo help :action action))))
+ (commands custom-commands))
+ (apply button (pop commands)) ; Set for current session
+ (apply button (pop commands)) ; Save for future sessions
+ (if custom-reset-button-menu
+ (progn
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Reset buffer"
+ :help-echo "Show a menu with reset operations."
+ :mouse-down-action 'ignore
+ :action 'custom-reset))
+ (widget-insert "\n")
+ (apply button (pop commands)) ; Undo edits
+ (apply button (pop commands)) ; Reset to saved
+ (apply button (pop commands)) ; Erase customization
+ (widget-insert " ")
+ (pop commands) ; Help (omitted)
+ (apply button (pop commands)))) ; Exit
(widget-insert "\n\n"))
;; Now populate the custom buffer.
(setq group 'emacs))
(let ((name "*Customize Browser*"))
(pop-to-buffer (custom-get-fresh-buffer name)))
- (custom-mode)
+ (Custom-mode)
(widget-insert (format "\
%s buttons; type RET or click mouse-1
on a button to invoke its action.
;;; Modification of Basic Widgets.
;;
;; We add extra properties to the basic widgets needed here. This is
-;; fine, as long as we are careful to stay within out own namespace.
+;; fine, as long as we are careful to stay within our own namespace.
;;
;; We want simple widgets to be displayed by default, but complex
;; widgets to be hidden.
(:weight bold :slant italic :underline t)))
"Face used when the customize item is invalid."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-invalid-face 'face-alias 'custom-invalid)
+(define-obsolete-face-alias 'custom-invalid-face 'custom-invalid "22.1")
(defface custom-rogue '((((class color))
(:foreground "pink" :background "black"))
(:underline t)))
"Face used when the customize item is not defined for customization."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-rogue-face 'face-alias 'custom-rogue)
+(define-obsolete-face-alias 'custom-rogue-face 'custom-rogue "22.1")
(defface custom-modified '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(:slant italic :bold)))
"Face used when the customize item has been modified."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-modified-face 'face-alias 'custom-modified)
+(define-obsolete-face-alias 'custom-modified-face 'custom-modified "22.1")
(defface custom-set '((((min-colors 88) (class color))
(:foreground "blue1" :background "white"))
(:slant italic)))
"Face used when the customize item has been set."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-set-face 'face-alias 'custom-set)
+(define-obsolete-face-alias 'custom-set-face 'custom-set "22.1")
(defface custom-changed '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(:slant italic)))
"Face used when the customize item has been changed."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-changed-face 'face-alias 'custom-changed)
+(define-obsolete-face-alias 'custom-changed-face 'custom-changed "22.1")
(defface custom-themed '((((min-colors 88) (class color))
(:foreground "white" :background "blue1"))
(defface custom-saved '((t (:underline t)))
"Face used when the customize item has been saved."
:group 'custom-magic-faces)
-;; backward-compatibility alias
-(put 'custom-saved-face 'face-alias 'custom-saved)
+(define-obsolete-face-alias 'custom-saved-face 'custom-saved "22.1")
(defconst custom-magic-alist
'((nil "#" underline "\
(nth 3 entry)))
(form (widget-get parent :custom-form))
children)
- (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
- (setq text (concat (match-string 1 text)
- (symbol-name category)
- (match-string 2 text))))
- (when (and custom-magic-show
- (or (not hidden)
- (memq category custom-magic-show-hidden)))
- (insert " ")
+ (unless (eq state 'hidden)
+ (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text)
+ (setq text (concat (match-string 1 text)
+ (symbol-name category)
+ (match-string 2 text))))
+ (when (and custom-magic-show
+ (or (not hidden)
+ (memq category custom-magic-show-hidden)))
+ (insert " ")
+ (when (and (eq category 'group)
+ (not (and (eq custom-buffer-style 'links)
+ (> (widget-get parent :custom-level) 1))))
+ (insert-char ?\ (* custom-buffer-indent
+ (widget-get parent :custom-level))))
+ (push (widget-create-child-and-convert
+ widget 'choice-item
+ :help-echo "Change the state of this item."
+ :format (if hidden "%t" "%[%t%]")
+ :button-prefix 'widget-push-button-prefix
+ :button-suffix 'widget-push-button-suffix
+ :mouse-down-action 'widget-magic-mouse-down-action
+ :tag "State")
+ children)
+ (insert ": ")
+ (let ((start (point)))
+ (if (eq custom-magic-show 'long)
+ (insert text)
+ (insert (symbol-name state)))
+ (cond ((eq form 'lisp)
+ (insert " (lisp)"))
+ ((eq form 'mismatch)
+ (insert " (mismatch)")))
+ (put-text-property start (point) 'face 'custom-state))
+ (insert "\n"))
(when (and (eq category 'group)
(not (and (eq custom-buffer-style 'links)
(> (widget-get parent :custom-level) 1))))
(insert-char ?\ (* custom-buffer-indent
(widget-get parent :custom-level))))
- (push (widget-create-child-and-convert
- widget 'choice-item
- :help-echo "Change the state of this item."
- :format (if hidden "%t" "%[%t%]")
- :button-prefix 'widget-push-button-prefix
- :button-suffix 'widget-push-button-suffix
- :mouse-down-action 'widget-magic-mouse-down-action
- :tag "State")
- children)
- (insert ": ")
- (let ((start (point)))
- (if (eq custom-magic-show 'long)
- (insert text)
- (insert (symbol-name state)))
- (cond ((eq form 'lisp)
- (insert " (lisp)"))
- ((eq form 'mismatch)
- (insert " (mismatch)")))
- (put-text-property start (point) 'face 'custom-state))
- (insert "\n"))
- (when (and (eq category 'group)
- (not (and (eq custom-buffer-style 'links)
- (> (widget-get parent :custom-level) 1))))
- (insert-char ?\ (* custom-buffer-indent
- (widget-get parent :custom-level))))
- (when custom-magic-show-button
- (when custom-magic-show
- (let ((indent (widget-get parent :indent)))
- (when indent
- (insert-char ? indent))))
- (push (widget-create-child-and-convert
- widget 'choice-item
- :mouse-down-action 'widget-magic-mouse-down-action
- :button-face face
- :button-prefix ""
- :button-suffix ""
- :help-echo "Change the state."
- :format (if hidden "%t" "%[%t%]")
- :tag (if (memq form '(lisp mismatch))
- (concat "(" magic ")")
- (concat "[" magic "]")))
- children)
- (insert " "))
- (widget-put widget :children children)))
+ (when custom-magic-show-button
+ (when custom-magic-show
+ (let ((indent (widget-get parent :indent)))
+ (when indent
+ (insert-char ? indent))))
+ (push (widget-create-child-and-convert
+ widget 'choice-item
+ :mouse-down-action 'widget-magic-mouse-down-action
+ :button-face face
+ :button-prefix ""
+ :button-suffix ""
+ :help-echo "Change the state."
+ :format (if hidden "%t" "%[%t%]")
+ :tag (if (memq form '(lisp mismatch))
+ (concat "(" magic ")")
+ (concat "[" magic "]")))
+ children)
+ (insert " "))
+ (widget-put widget :children children))))
(defun custom-magic-reset (widget)
"Redraw the :custom-magic property of WIDGET."
;;; The `custom' Widget.
(defface custom-button
- '((((type x w32 mac) (class color)) ; Like default modeline
+ '((((type x w32 ns) (class color)) ; Like default modeline
(:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
(t
"Face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-button-face 'face-alias 'custom-button)
+(define-obsolete-face-alias 'custom-button-face 'custom-button "22.1")
(defface custom-button-mouse
- '((((type x w32 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style released-button)
:background "grey90" :foreground "black"))
(t
- nil))
+ ;; This is for text terminals that support mouse, like GPM mouse
+ ;; or the MS-DOS terminal: inverse-video makes the button stand
+ ;; out on mouse-over.
+ (:inverse-video t)))
"Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
:version "22.1"
:group 'custom-faces)
(if custom-raised-buttons 'custom-button-mouse 'highlight))
(defface custom-button-pressed
- '((((type x w32 mac) (class color))
+ '((((type x w32 ns) (class color))
(:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black"))
(t
"Face for pressed custom buttons if `custom-raised-buttons' is non-nil."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
+(define-obsolete-face-alias 'custom-button-pressed-face
+ 'custom-button-pressed "22.1")
(defface custom-button-pressed-unraised
'((default :inherit custom-button-unraised)
(defface custom-documentation '((t nil))
"Face used for documentation strings in customization buffers."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-documentation-face 'face-alias 'custom-documentation)
+(define-obsolete-face-alias 'custom-documentation-face
+ 'custom-documentation "22.1")
(defface custom-state '((((class color)
(background dark))
(t nil))
"Face used for State descriptions in the customize buffer."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-state-face 'face-alias 'custom-state)
+(define-obsolete-face-alias 'custom-state-face 'custom-state "22.1")
(defface custom-link
'((t :inherit link))
(when (and (>= pos from) (<= pos to))
(condition-case nil
(progn
- (if (> column 0)
- (goto-line line)
- (goto-line (1+ line)))
+ (goto-char (point-min))
+ (forward-line (if (> column 0)
+ (1- line)
+ line))
(move-to-column column))
(error nil)))))
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
(let ((show (widget-get widget :custom-show)))
- (cond ((null show)
- nil)
- ((eq t show)
- t)
- (t
- (funcall show widget value)))))
+ (if (functionp show)
+ (funcall show widget value)
+ show)))
(defun custom-load-widget (widget)
"Load all dependencies for WIDGET."
"Toggle visibility of WIDGET."
(custom-load-widget widget)
(let ((state (widget-get widget :custom-state)))
- (cond ((memq state '(invalid modified))
- (error "There are unset changes"))
+ (cond ((memq state '(invalid modified set))
+ (error "There are unsaved changes"))
((eq state 'hidden)
(widget-put widget :custom-state 'unknown))
(t
(insert ", "))))
(widget-put widget :buttons buttons))))
-(defun custom-add-parent-links (widget &optional initial-string
- doc-initial-string)
+(defun custom-add-parent-links (widget &optional initial-string doc-initial-string)
"Add \"Parent groups: ...\" to WIDGET if the group has parents.
The value is non-nil if any parents were found.
If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
symbol)
buttons)
(setq parents (cons symbol parents)))))
- (and (null (get name 'custom-links)) ;No links of its own.
- (= (length parents) 1) ;A single parent.
- (let* ((links (delq nil (mapcar (lambda (w)
- (unless (eq (widget-type w)
- 'custom-group-link)
- w))
- (get (car parents) 'custom-links))))
- (many (> (length links) 2)))
- (when links
- (let ((pt (point))
- (left-margin (+ left-margin 2)))
- (insert "\n" (or doc-initial-string "Group documentation:") " ")
- (while links
- (push (widget-create-child-and-convert
- widget (car links)
- :button-face 'custom-link
- :mouse-face 'highlight
- :pressed-face 'highlight)
- buttons)
- (setq links (cdr links))
- (cond ((null links)
- (insert ".\n"))
- ((null (cdr links))
- (if many
- (insert ", and ")
- (insert " and ")))
- (t
- (insert ", "))))
- (fill-region-as-paragraph pt (point))
- (delete-to-left-margin (1+ pt) (+ pt 2))))))
(if parents
(insert "\n")
(delete-region start (point)))
:background "dim gray")
(t
:slant italic))
- "Face used for comments on variables or faces"
+ "Face used for comments on variables or faces."
:version "21.1"
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-comment-face 'face-alias 'custom-comment)
+(define-obsolete-face-alias 'custom-comment-face 'custom-comment "22.1")
;; like font-lock-comment-face
(defface custom-comment-tag
(((class grayscale) (background dark))
(:foreground "LightGray" :weight bold :slant italic))
(t (:weight bold)))
- "Face used for variables or faces comment tags"
+ "Face used for the comment tag on variables or faces."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
+(define-obsolete-face-alias 'custom-comment-tag-face 'custom-comment-tag "22.1")
(define-widget 'custom-comment 'string
"User comment."
:tag "Comment"
:help-echo "Edit a comment here."
- :sample-face 'custom-comment-tag-face
- :value-face 'custom-comment-face
+ :sample-face 'custom-comment-tag
+ :value-face 'custom-comment
:shown nil
:create 'custom-comment-create)
;;; The `custom-variable' Widget.
-;; When this was underlined blue, users confused it with a
-;; Mosaic-style hyperlink...
(defface custom-variable-tag
`((((class color)
(background dark))
(t (:weight bold)))
"Face used for unpushable variable tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag)
+(define-obsolete-face-alias 'custom-variable-tag-face
+ 'custom-variable-tag "22.1")
(defface custom-variable-button '((t (:underline t :weight bold)))
"Face used for pushable variable tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-variable-button-face 'face-alias 'custom-variable-button)
+(define-obsolete-face-alias 'custom-variable-button-face
+ 'custom-variable-button "22.1")
(defcustom custom-variable-default-form 'edit
"Default form of displaying variable values."
(documentation-property variable 'variable-documentation)))
(define-widget 'custom-variable 'custom
- "Customize variable."
+ "A widget for displaying a Custom variable.
+
+The following property has a special meaning for this widget:
+:hidden-states - A list of widget states for which the widget's initial
+ contents should be hidden."
:format "%v"
:help-echo "Set or reset this variable."
:documentation-property #'custom-variable-documentation
:custom-form nil ; defaults to value of `custom-variable-default-form'
:value-create 'custom-variable-value-create
:action 'custom-variable-action
+ :hidden-states '(standard)
:custom-set 'custom-variable-set
- :custom-save 'custom-variable-save
+ :custom-mark-to-save 'custom-variable-mark-to-save
:custom-reset-current 'custom-redraw
:custom-reset-saved 'custom-variable-reset-saved
:custom-reset-standard 'custom-variable-reset-standard
- :custom-standard-value 'custom-variable-standard-value)
+ :custom-mark-to-reset-standard 'custom-variable-mark-to-reset-standard
+ :custom-standard-value 'custom-variable-standard-value
+ :custom-state-set-and-redraw 'custom-variable-state-set-and-redraw)
(defun custom-variable-type (symbol)
"Return a widget suitable for editing the value of SYMBOL.
(let* ((buttons (widget-get widget :buttons))
(children (widget-get widget :children))
(form (widget-get widget :custom-form))
- (state (widget-get widget :custom-state))
(symbol (widget-get widget :value))
(tag (widget-get widget :tag))
(type (custom-variable-type symbol))
(last (widget-get widget :custom-last))
(value (if (default-boundp symbol)
(funcall get symbol)
- (widget-get conv :value))))
- ;; If the widget is new, the child determines whether it is hidden.
- (cond (state)
- ((custom-show type value)
- (setq state 'unknown))
- (t
- (setq state 'hidden)))
+ (widget-get conv :value)))
+ (state (or (widget-get widget :custom-state)
+ (if (memq (custom-variable-state symbol value)
+ (widget-get widget :hidden-states))
+ 'hidden))))
+
;; If we don't know the state, see if we need to edit it in lisp form.
+ (unless state
+ (setq state (if (custom-show type value) 'unknown 'hidden)))
(when (eq state 'unknown)
(unless (widget-apply conv :match value)
- ;; (widget-apply (widget-convert type) :match value)
(setq form 'mismatch)))
;; Now we can create the child widget.
(cond ((eq custom-buffer-style 'tree)
((eq state 'hidden)
;; Indicate hidden value.
(push (widget-create-child-and-convert
- widget 'item
- :format "%{%t%}: "
- :sample-face 'custom-variable-tag-face
- :tag tag
- :parent widget)
- buttons)
- (push (widget-create-child-and-convert
- widget 'visibility
+ widget 'custom-visibility
:help-echo "Show the value of this option."
+ :on-image "down"
+ :on "Hide"
+ :off-image "right"
:off "Show Value"
:action 'custom-toggle-parent
nil)
+ buttons)
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'item
+ :format "%{%t%} "
+ :sample-face 'custom-variable-tag
+ :tag tag
+ :parent widget)
buttons))
((memq form '(lisp mismatch))
;; In lisp mode edit the saved value when possible.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide the value of this option."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (insert " ")
(let* ((value (cond ((get symbol 'saved-value)
(car (get symbol 'saved-value)))
((get symbol 'standard-value)
(t
(custom-quote (widget-get conv :value))))))
(insert (symbol-name symbol) ": ")
- (push (widget-create-child-and-convert
- widget 'visibility
- :help-echo "Hide the value of this option."
- :on "Hide Value"
- :off "Show Value"
- :action 'custom-toggle-parent
- t)
- buttons)
- (insert " ")
(push (widget-create-child-and-convert
widget 'sexp
:button-face 'custom-variable-button-face
children)))
(t
;; Edit mode.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this option."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ t)
+ buttons)
+ (insert " ")
(let* ((format (widget-get type :format))
tag-format value-format)
(unless (string-match ":" format)
:action 'custom-tag-action
:help-echo "Change value of this option."
:mouse-down-action 'custom-tag-mouse-down-action
- :button-face 'custom-variable-button-face
- :sample-face 'custom-variable-tag-face
+ :button-face 'custom-variable-button
+ :sample-face 'custom-variable-tag
tag)
buttons)
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'visibility
- :help-echo "Hide the value of this option."
- :on "Hide Value"
- :off "Show Value"
- :action 'custom-toggle-parent
- t)
- buttons)
(push (widget-create-child-and-convert
widget type
:format value-format
;; Don't push it !!! Custom assumes that the first child is the
;; value one.
(setq children (append children (list comment-widget)))))
- ;; Update the rest of the properties properties.
+ ;; Update the rest of the properties.
(widget-put widget :custom-form form)
(widget-put widget :children children)
;; Now update the state.
(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
:mouse-down-action args))
-(defun custom-variable-state-set (widget)
- "Set the state of WIDGET."
- (let* ((symbol (widget-value widget))
- (get (or (get symbol 'custom-get) 'default-value))
+(defun custom-variable-state (symbol val)
+ "Return the state of SYMBOL if its value is VAL.
+If SYMBOL has a non-nil `custom-get' property, it overrides VAL.
+Possible return values are `standard', `saved', `set', `themed',
+`changed', and `rogue'."
+ (let* ((get (or (get symbol 'custom-get) 'default-value))
(value (if (default-boundp symbol)
(funcall get symbol)
- (widget-get widget :value)))
+ val))
(comment (get symbol 'variable-comment))
tmp
- temp
- (state (cond ((progn (setq tmp (get symbol 'customized-value))
- (setq temp
- (get symbol 'customized-variable-comment))
- (or tmp temp))
- (if (condition-case nil
- (and (equal value (eval (car tmp)))
- (equal comment temp))
- (error nil))
- 'set
- 'changed))
- ((progn (setq tmp (get symbol 'theme-value))
- (setq temp (get symbol 'saved-variable-comment))
- (or tmp temp))
- (if (condition-case nil
- (and (equal comment temp)
- (equal value
- (eval
- (car (custom-variable-theme-value
- symbol)))))
- (error nil))
- (cond
- ((eq (caar tmp) 'user) 'saved)
- ((eq (caar tmp) 'changed)
- (if (condition-case nil
- (and (null comment)
- (equal value
- (eval
- (car (get symbol 'standard-value)))))
- (error nil))
- ;; The value was originally set outside
- ;; custom, but it was set to the standard
- ;; value (probably an autoloaded defcustom).
- 'standard
- 'changed))
- (t 'themed))
- 'changed))
- ((setq tmp (get symbol 'standard-value))
- (if (condition-case nil
- (and (equal value (eval (car tmp)))
- (equal comment nil))
- (error nil))
- 'standard
- 'changed))
- (t 'rogue))))
- (widget-put widget :custom-state state)))
+ temp)
+ (cond ((progn (setq tmp (get symbol 'customized-value))
+ (setq temp
+ (get symbol 'customized-variable-comment))
+ (or tmp temp))
+ (if (condition-case nil
+ (and (equal value (eval (car tmp)))
+ (equal comment temp))
+ (error nil))
+ 'set
+ 'changed))
+ ((progn (setq tmp (get symbol 'theme-value))
+ (setq temp (get symbol 'saved-variable-comment))
+ (or tmp temp))
+ (if (condition-case nil
+ (and (equal comment temp)
+ (equal value
+ (eval
+ (car (custom-variable-theme-value
+ symbol)))))
+ (error nil))
+ (cond
+ ((eq (caar tmp) 'user) 'saved)
+ ((eq (caar tmp) 'changed)
+ (if (condition-case nil
+ (and (null comment)
+ (equal value
+ (eval
+ (car (get symbol 'standard-value)))))
+ (error nil))
+ ;; The value was originally set outside
+ ;; custom, but it was set to the standard
+ ;; value (probably an autoloaded defcustom).
+ 'standard
+ 'changed))
+ (t 'themed))
+ 'changed))
+ ((setq tmp (get symbol 'standard-value))
+ (if (condition-case nil
+ (and (equal value (eval (car tmp)))
+ (equal comment nil))
+ (error nil))
+ 'standard
+ 'changed))
+ (t 'rogue))))
+
+(defun custom-variable-state-set (widget &optional state)
+ "Set the state of WIDGET to STATE.
+If STATE is nil, the value is computed by `custom-variable-state'."
+ (widget-put widget :custom-state
+ (or state (custom-variable-state (widget-value widget)
+ (widget-get widget :value)))))
(defun custom-variable-standard-value (widget)
(get (widget-value widget) 'standard-value))
(custom-variable-state-set widget)
(custom-redraw-magic widget)))
-(defun custom-variable-save (widget)
- "Set and save the value for the variable being edited by WIDGET."
+(defun custom-variable-mark-to-save (widget)
+ "Set value and mark for saving the variable edited by WIDGET."
(let* ((form (widget-get widget :custom-form))
(state (widget-get widget :custom-state))
(child (car (widget-get widget :children)))
(put symbol 'variable-comment comment)
(put symbol 'saved-variable-comment comment)))
(put symbol 'customized-value nil)
- (put symbol 'customized-variable-comment nil)
- (custom-save-all)
- (custom-variable-state-set widget)
- (custom-redraw-magic widget)))
+ (put symbol 'customized-variable-comment nil)))
+
+(defsubst custom-variable-state-set-and-redraw (widget)
+ "Set state of variable widget WIDGET and redraw with current settings."
+ (custom-variable-state-set widget)
+ (custom-redraw-magic widget))
+
+(defun custom-variable-save (widget)
+ "Save value of variable edited by widget WIDGET."
+ (custom-variable-mark-to-save widget)
+ (custom-save-all)
+ (custom-variable-state-set-and-redraw widget))
(defun custom-variable-reset-saved (widget)
"Restore the saved value for the variable being edited by WIDGET.
;; This call will possibly make the comment invisible
(custom-redraw widget)))
-(defun custom-variable-reset-standard (widget)
- "Restore the standard setting for the variable being edited by WIDGET.
-This operation eliminates any saved setting for the variable,
-restoring it to the state of a variable that has never been customized.
-The value that was current before this operation
-becomes the backup value, so you can get it again."
+(defun custom-variable-mark-to-reset-standard (widget)
+ "Mark to restore standard setting for the variable edited by widget WIDGET.
+If `custom-reset-standard-variables-list' is nil, save, reset and
+redraw the widget immediately."
(let* ((symbol (widget-value widget)))
(if (get symbol 'standard-value)
(custom-variable-backup-value widget)
(put symbol 'customized-variable-comment nil)
(custom-push-theme 'theme-value symbol 'user 'reset)
(custom-theme-recalc-variable symbol)
- (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
- (put symbol 'saved-value nil)
- (put symbol 'saved-variable-comment nil)
- (custom-save-all))
- (widget-put widget :custom-state 'unknown)
- ;; This call will possibly make the comment invisible
- (custom-redraw widget)))
+ (if (and custom-reset-standard-variables-list
+ (or (get symbol 'saved-value) (get symbol 'saved-variable-comment)))
+ (progn
+ (put symbol 'saved-value nil)
+ (put symbol 'saved-variable-comment nil)
+ ;; Append this to `custom-reset-standard-variables-list' to
+ ;; have `custom-reset-standard-save-and-update' save setting
+ ;; to the file, update the widget's state, and redraw it.
+ (setq custom-reset-standard-variables-list
+ (cons widget custom-reset-standard-variables-list)))
+ (when (or (get symbol 'saved-value) (get symbol 'saved-variable-comment))
+ (put symbol 'saved-value nil)
+ (put symbol 'saved-variable-comment nil)
+ (custom-save-all))
+ (widget-put widget :custom-state 'unknown)
+ ;; This call will possibly make the comment invisible
+ (custom-redraw widget))))
+
+(defun custom-variable-reset-standard (widget)
+ "Restore standard setting for the variable edited by WIDGET.
+This operation eliminates any saved setting for the variable,
+restoring it to the state of a variable that has never been customized.
+The value that was current before this operation
+becomes the backup value, so you can get it again."
+ (let (custom-reset-standard-variables-list)
+ (custom-variable-mark-to-reset-standard widget)))
(defun custom-variable-backup-value (widget)
"Back up the current value for WIDGET's variable.
:button-face 'custom-visibility
:pressed-face 'custom-visibility
:mouse-face 'highlight
- :pressed-face 'highlight)
+ :pressed-face 'highlight
+ :on-image nil
+ :off-image nil)
(defface custom-visibility
'((t :height 0.8 :inherit link))
(defun custom-face-edit-attribute-tag (widget)
- "Returns the first :tag property in WIDGET or one of its children."
+ "Return the first :tag property in WIDGET or one of its children."
(let ((tag (widget-get widget :tag)))
(or (and (not (equal tag "")) tag)
(let ((children (widget-get widget :children)))
:sibling-args (:help-echo "\
Windows NT/9X.")
w32)
- (const :format "MAC "
+ (const :format "NS "
:sibling-args (:help-echo "\
-Macintosh OS.")
- mac)
+GNUstep or Macintosh OS Cocoa interface.")
+ ns)
(const :format "DOS "
:sibling-args (:help-echo "\
Plain MS-DOS.")
;;; The `custom-face' Widget.
(defface custom-face-tag
- `((t (:weight bold :height 1.2 :inherit variable-pitch)))
+ `((t :inherit custom-variable-tag))
"Face used for face tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-face-tag-face 'face-alias 'custom-face-tag)
+(define-obsolete-face-alias 'custom-face-tag-face 'custom-face-tag "22.1")
(defcustom custom-face-default-form 'selected
"Default form of displaying face definition."
(define-widget 'custom-face 'custom
"Customize face."
- :sample-face 'custom-face-tag-face
+ :sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
:value-create 'custom-face-value-create
:custom-category 'face
:custom-form nil ; defaults to value of `custom-face-default-form'
:custom-set 'custom-face-set
- :custom-save 'custom-face-save
+ :custom-mark-to-save 'custom-face-mark-to-save
:custom-reset-current 'custom-redraw
:custom-reset-saved 'custom-face-reset-saved
:custom-reset-standard 'custom-face-reset-standard
+ :custom-mark-to-reset-standard 'custom-face-mark-to-reset-standard
:custom-standard-value 'custom-face-standard-value
+ :custom-state-set-and-redraw 'custom-face-state-set-and-redraw
:custom-menu 'custom-face-menu-create)
(define-widget 'custom-face-all 'editable-list
(insert " " tag "\n")
(widget-put widget :buttons buttons))
(t
+ ;; Visibility.
+ (push (widget-create-child-and-convert
+ widget 'custom-visibility
+ :help-echo "Hide or show this face."
+ :on "Hide"
+ :off "Show"
+ :on-image "down"
+ :off-image "right"
+ :action 'custom-toggle-parent
+ (not (eq state 'hidden)))
+ buttons)
+ (insert " ")
;; Create tag.
(insert tag)
(widget-specify-sample widget begin (point))
:sample-face symbol
:tag "sample")
buttons)
- ;; Visibility.
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'visibility
- :help-echo "Hide or show this face."
- :on "Hide Face"
- :off "Show Face"
- :action 'custom-toggle-parent
- (not (eq state 'hidden)))
- buttons)
;; Magic.
(insert "\n")
(let ((magic (widget-create-child-and-convert
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
+ (widget-put widget :documentation-indent 3)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
-(defun custom-face-save (widget)
- "Save in `.emacs' the face attributes in WIDGET."
+(defun custom-face-mark-to-save (widget)
+ "Mark for saving the face edited by WIDGET."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (custom-post-filter-face-spec (widget-value child)))
(put symbol 'customized-face nil)
(put symbol 'face-comment comment)
(put symbol 'customized-face-comment nil)
- (put symbol 'saved-face-comment comment)
- (custom-save-all)
- (custom-face-state-set widget)
- (custom-redraw-magic widget)))
+ (put symbol 'saved-face-comment comment)))
+
+(defsubst custom-face-state-set-and-redraw (widget)
+ "Set state of face widget WIDGET and redraw with current settings."
+ (custom-face-state-set widget)
+ (custom-redraw-magic widget))
+
+(defun custom-face-save (widget)
+ "Save the face edited by WIDGET."
+ (custom-face-mark-to-save widget)
+ (custom-save-all)
+ (custom-face-state-set-and-redraw widget))
;; For backward compatibility.
(define-obsolete-function-alias 'custom-face-save-command 'custom-face-save
(defun custom-face-standard-value (widget)
(get (widget-value widget) 'face-defface-spec))
-(defun custom-face-reset-standard (widget)
- "Restore WIDGET to the face's standard attribute values.
-This operation eliminates any saved attributes for the face,
-restoring it to the state of a face that has never been customized."
+(defun custom-face-mark-to-reset-standard (widget)
+ "Restore widget WIDGET to the face's standard attribute values.
+If `custom-reset-standard-faces-list' is nil, save, reset and
+redraw the widget immediately."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (get symbol 'face-defface-spec))
(custom-push-theme 'theme-face symbol 'user 'reset)
(face-spec-set symbol value t)
(custom-theme-recalc-face symbol)
- (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
- (put symbol 'saved-face nil)
- (put symbol 'saved-face-comment nil)
- (custom-save-all))
- (put symbol 'face-comment nil)
- (widget-value-set child
- (custom-pre-filter-face-spec
- (list (list t (custom-face-attributes-get
- symbol nil)))))
- ;; This call manages the comment visibility
- (widget-value-set comment-widget "")
- (custom-face-state-set widget)
- (custom-redraw-magic widget)))
+ (if (and custom-reset-standard-faces-list
+ (or (get symbol 'saved-face) (get symbol 'saved-face-comment)))
+ ;; Do this later.
+ (progn
+ (put symbol 'saved-face nil)
+ (put symbol 'saved-face-comment nil)
+ ;; Append this to `custom-reset-standard-faces-list' and have
+ ;; `custom-reset-standard-save-and-update' save setting to the
+ ;; file, update the widget's state, and redraw it.
+ (setq custom-reset-standard-faces-list
+ (cons widget custom-reset-standard-faces-list)))
+ (when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
+ (put symbol 'saved-face nil)
+ (put symbol 'saved-face-comment nil)
+ (custom-save-all))
+ (put symbol 'face-comment nil)
+ (widget-value-set child
+ (custom-pre-filter-face-spec
+ (list (list t (custom-face-attributes-get
+ symbol nil)))))
+ ;; This call manages the comment visibility
+ (widget-value-set comment-widget "")
+ (custom-face-state-set widget)
+ (custom-redraw-magic widget))))
+
+(defun custom-face-reset-standard (widget)
+ "Restore WIDGET to the face's standard attribute values.
+This operation eliminates any saved attributes for the face,
+restoring it to the state of a face that has never been customized."
+ (let (custom-reset-standard-faces-list)
+ (custom-face-mark-to-reset-standard widget)))
;;; The `face' Widget.
(t (:weight bold)))
"Face used for group tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1)
+(define-obsolete-face-alias 'custom-group-tag-face-1 'custom-group-tag-1 "22.1")
(defface custom-group-tag
`((((class color)
(t (:weight bold)))
"Face used for low level group tags."
:group 'custom-faces)
-;; backward-compatibility alias
-(put 'custom-group-tag-face 'face-alias 'custom-group-tag)
+(define-obsolete-face-alias 'custom-group-tag-face 'custom-group-tag "22.1")
(define-widget 'custom-group 'custom
"Customize group."
:action 'custom-group-action
:custom-category 'group
:custom-set 'custom-group-set
- :custom-save 'custom-group-save
+ :custom-mark-to-save 'custom-group-mark-to-save
:custom-reset-current 'custom-group-reset-current
:custom-reset-saved 'custom-group-reset-saved
:custom-reset-standard 'custom-group-reset-standard
+ :custom-mark-to-reset-standard 'custom-group-mark-to-reset-standard
+ :custom-state-set-and-redraw 'custom-group-state-set-and-redraw
:custom-menu 'custom-group-menu-create)
(defun custom-group-sample-face-get (widget)
(symbol (widget-value widget))
(members (custom-group-members symbol
(and (eq custom-buffer-style 'tree)
- custom-browse-only-groups))))
+ custom-browse-only-groups)))
+ (doc (widget-docstring widget)))
(cond ((and (eq custom-buffer-style 'tree)
(eq state 'hidden)
(or members (custom-unloaded-widget-p widget)))
(insert " " tag "\n")
(widget-put widget :buttons buttons)
(message "Creating group...")
- (let* ((members (custom-sort-items members
- custom-browse-sort-alphabetically
+ (let* ((members (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ custom-browse-sort-alphabetically)
custom-browse-order-groups))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
;; Nested style.
(t ;Visible.
+ ;; Draw a horizontal line (this works for both graphical
+ ;; and text displays):
+ (let ((p (point)))
+ (insert "\n")
+ (put-text-property p (1+ p) 'face '(:underline t))
+ (overlay-put (make-overlay p (1+ p))
+ 'before-string
+ (propertize "\n" 'face '(:underline t)
+ 'display '(space :align-to 999))))
+
;; Add parent groups references above the group.
- (if t ;;; This should test that the buffer
- ;;; was made to display a group.
- (when (eq level 1)
- (if (custom-add-parent-links widget
- "Parent groups:"
- "Parent group documentation:")
- (insert "\n"))))
- ;; Create level indicator.
+ (when (eq level 1)
+ (if (custom-add-parent-links widget "Parent groups:")
+ (insert "\n")))
(insert-char ?\ (* custom-buffer-indent (1- level)))
- (insert "/- ")
;; Create tag.
(let ((start (point)))
(insert tag " group: ")
(widget-specify-sample widget start (point)))
- (insert (widget-docstring widget))
+ (cond
+ ((not doc)
+ (insert " Group definition missing. "))
+ ((< (length doc) 50)
+ (insert doc)))
;; Create visibility indicator.
(unless (eq custom-buffer-style 'links)
(insert "--------")
(not (eq state 'hidden)))
buttons)
(insert " "))
- ;; Create more dashes.
- ;; Use 76 instead of 75 to compensate for the temporary "<"
- ;; added by `widget-insert'.
- (insert-char ?- (- 76 (current-column)
- (* custom-buffer-indent level)))
- (insert "\\\n")
+ (insert "\n")
;; Create magic button.
(let ((magic (widget-create-child-and-convert
widget 'custom-magic
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
- (widget-add-documentation-string-button
- widget :visibility-widget 'custom-visibility)
+ (when (and doc (>= (length doc) 50))
+ (widget-add-documentation-string-button
+ widget :visibility-widget 'custom-visibility))
;; Parent groups.
(if nil ;;; This should test that the buffer
?\ ))
;; Members.
(message "Creating group...")
- (let* ((members (custom-sort-items members
- custom-buffer-sort-alphabetically
- custom-buffer-order-groups))
+ (let* ((members (custom-sort-items
+ members
+ ;; Never sort the top-level custom group.
+ (unless (eq symbol 'emacs)
+ custom-buffer-sort-alphabetically)
+ custom-buffer-order-groups))
(prefixes (widget-get widget :custom-prefixes))
(custom-prefix-list (custom-prefix-add symbol prefixes))
- (length (length members))
+ (len (length members))
(count 0)
- (children (mapcar (lambda (entry)
- (widget-insert "\n")
- (message "\
-Creating group members... %2d%%"
- (/ (* 100.0 count) length))
- (setq count (1+ count))
- (prog1
- (widget-create-child-and-convert
- widget (nth 1 entry)
- :group widget
- :tag (custom-unlispify-tag-name
- (nth 0 entry))
- :custom-prefixes custom-prefix-list
- :custom-level (1+ level)
- :value (nth 0 entry))
- (unless (eq (preceding-char) ?\n)
- (widget-insert "\n"))))
- members)))
- (message "Creating group magic...")
+ (reporter (make-progress-reporter
+ "Creating group entries..." 0 len))
+ children)
+ (setq children
+ (mapcar
+ (lambda (entry)
+ (widget-insert "\n")
+ (progress-reporter-update reporter (setq count (1+ count)))
+ (let ((sym (nth 0 entry))
+ (type (nth 1 entry))
+ hidden-p)
+ (prog1
+ (widget-create-child-and-convert
+ widget type
+ :group widget
+ :tag (custom-unlispify-tag-name sym)
+ :custom-prefixes custom-prefix-list
+ :custom-level (1+ level)
+ :value sym)
+ (unless (eq (preceding-char) ?\n)
+ (widget-insert "\n")))))
+ members))
(mapc 'custom-magic-reset children)
- (message "Creating group state...")
(widget-put widget :children children)
(custom-group-state-update widget)
- (message "Creating group... done"))
+ (progress-reporter-done reporter))
;; End line
- (insert "\n")
- (insert-char ?\ (* custom-buffer-indent (1- level)))
- (insert "\\- " (widget-get widget :tag) " group end ")
- (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level)))
- (insert "/\n")))))
+ (let ((p (point)))
+ (insert "\n")
+ (put-text-property p (1+ p) 'face '(:underline t))
+ (overlay-put (make-overlay p (1+ p))
+ 'before-string
+ (propertize "\n" 'face '(:underline t)
+ 'display '(space :align-to 999))))))))
(defvar custom-group-menu
`(("Set for Current Session" custom-group-set
(when (eq (widget-get child :custom-state) 'modified)
(widget-apply child :custom-set))))
-(defun custom-group-save (widget)
- "Save all modified group members."
+(defun custom-group-mark-to-save (widget)
+ "Mark all modified group members for saving."
+ (dolist (child (widget-get widget :children))
+ (when (memq (widget-get child :custom-state) '(modified set))
+ (widget-apply child :custom-mark-to-save))))
+
+(defsubst custom-group-state-set-and-redraw (widget)
+ "Set state of group widget WIDGET and redraw with current settings."
(dolist (child (widget-get widget :children))
(when (memq (widget-get child :custom-state) '(modified set))
- (widget-apply child :custom-save))))
+ (widget-apply child :custom-state-set-and-redraw))))
+
+(defun custom-group-save (widget)
+ "Save all modified group members."
+ (custom-group-mark-to-save widget)
+ (custom-save-all)
+ (custom-group-state-set-and-redraw widget))
(defun custom-group-reset-current (widget)
"Reset all modified group members."
(defun custom-group-reset-standard (widget)
"Reset all modified, set, or saved group members."
+ (let ((custom-reset-standard-variables-list '(t))
+ (custom-reset-standard-faces-list '(t)))
+ (custom-group-mark-to-reset-standard widget)
+ (custom-reset-standard-save-and-update)))
+
+(defun custom-group-mark-to-reset-standard (widget)
+ "Mark to reset all modified, set, or saved group members."
(dolist (child (widget-get widget :children))
(when (memq (widget-get child :custom-state)
'(modified set saved))
- (widget-apply child :custom-reset-standard))))
+ (widget-apply child :custom-mark-to-reset-standard))))
(defun custom-group-state-update (widget)
"Update magic."
:doc
"Please read entire docstring below before setting \
this through Custom.
-Click om \"More\" \(or position point there and press RETURN)
+Click on \"More\" \(or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
(recentf-expand-file-name (custom-file)))
"\\'")
recentf-exclude)))
- (old-buffer (find-buffer-visiting filename)))
+ (old-buffer (find-buffer-visiting filename))
+ old-buffer-name)
+
(with-current-buffer (let ((find-file-visit-truename t))
(or old-buffer (find-file-noselect filename)))
+ ;; We'll save using file-precious-flag, so avoid destroying
+ ;; symlinks. (If we're not already visiting the buffer, this is
+ ;; handled by find-file-visit-truename, above.)
+ (when old-buffer
+ (setq old-buffer-name (buffer-file-name))
+ (set-visited-file-name (file-chase-links filename)))
+
(unless (eq major-mode 'emacs-lisp-mode)
(emacs-lisp-mode))
(let ((inhibit-read-only t))
(custom-save-faces))
(let ((file-precious-flag t))
(save-buffer))
- (unless old-buffer
+ (if old-buffer
+ (progn
+ (set-visited-file-name old-buffer-name)
+ (set-buffer-modified-p nil))
(kill-buffer (current-buffer))))))
;;;###autoload
;;; `custom-tool-bar-map' used to be set up here. This will fail to
;;; DTRT when `display-graphic-p' returns nil during compilation. Hence
-;;; we set this up lazily in `custom-mode'.
+;;; we set this up lazily in `Custom-mode'.
(defvar custom-tool-bar-map nil
"Keymap for toolbar in Custom mode.")
(parent (downcase (widget-get button :tag))))
(customize-group parent)))))
-(defcustom custom-mode-hook nil
+(defcustom Custom-mode-hook nil
"Hook called when entering Custom mode."
:type 'hook
- :group 'custom-buffer )
+ :group 'custom-buffer)
(defun custom-state-buffer-message (widget)
(if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified)
(message "To install your edits, invoke [State] and choose the Set operation")))
-(define-derived-mode custom-mode nil "Custom"
+(define-derived-mode Custom-mode nil "Custom"
"Major mode for editing customization buffers.
The following commands are available:
\\<widget-keymap>\
Move to next button, link or editable field. \\[widget-forward]
-Move to previous button, link or editable field. \\[advertised-widget-backward]
+Move to previous button, link or editable field. \\[widget-backward]
\\<custom-field-keymap>\
Complete content of editable text field. \\[widget-complete]
\\<custom-mode-map>\
Erase customizations; set options
and buffer text to the standard values. \\[Custom-reset-standard]
-Entry to this mode calls the value of `custom-mode-hook'
+Entry to this mode calls the value of `Custom-mode-hook'
if that value is non-nil."
(use-local-map custom-mode-map)
(easy-menu-add Custom-mode-menu)
- (when (display-graphic-p)
- (set (make-local-variable 'tool-bar-map)
- (or custom-tool-bar-map
- ;; Set up `custom-tool-bar-map'.
- (let ((map (make-sparse-keymap)))
- (mapc
- (lambda (arg)
- (tool-bar-local-item-from-menu
- (nth 1 arg) (nth 4 arg) map custom-mode-map))
- custom-commands)
- (setq custom-tool-bar-map map)))))
+ (set (make-local-variable 'tool-bar-map)
+ (or custom-tool-bar-map
+ ;; Set up `custom-tool-bar-map'.
+ (let ((map (make-sparse-keymap)))
+ (mapc
+ (lambda (arg)
+ (tool-bar-local-item-from-menu
+ (nth 1 arg) (nth 4 arg) map custom-mode-map))
+ custom-commands)
+ (setq custom-tool-bar-map map))))
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(make-local-variable 'widget-documentation-face)
(set (make-local-variable 'widget-link-suffix) ""))
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t))
+(put 'Custom-mode 'mode-class 'special)
+
+;; backward-compatibility
+(defun custom-mode ()
+ "Non-interactive variant of `Custom-mode'."
+ (Custom-mode))
+(make-obsolete 'custom-mode 'Custom-mode "23.1")
(put 'custom-mode 'mode-class 'special)
+(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
(dolist (regexp
'("^No user option defaults have been changed since Emacs "
HCoop / bpt / emacs.git / blobdiff