;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; compatibility.
;; You can see (and modify and save) this unevaluated value by selecting
-;; "Show initial Lisp expression" from the Lisp interface. This will
+;; "Show Saved Lisp Expression" from the Lisp interface. This will
;; give you the unevaluated saved value, if any, otherwise the
;; unevaluated standard value.
;; 6. rogue
;; There is no standard value. This means that the variable was
-;; not defined with defcustom. You can not create a Custom buffer
-;; for such variables using the normal interactive Custom commands.
-;; However, such Custom buffers can be created in other ways, for
-;; instance, by calling `customize-option' non-interactively.
+;; not defined with defcustom, nor handled in cus-start.el. Most
+;; standard interactive Custom commands do not let you create a
+;; Custom buffer containing such variables. However, such Custom
+;; buffers can be created, for instance, by calling
+;; `customize-apropos' with a prefix arg or by calling
+;; `customize-option' non-interactively.
;; 7. hidden
(require 'cus-face)
(require 'wid-edit)
(eval-when-compile
- (defvar custom-versions-load-alist)) ; from cus-load
+ (defvar custom-versions-load-alist) ; from cus-load
+ (defvar recentf-exclude)) ; from recentf.el
(condition-case nil
(require 'cus-load)
(defgroup lisp nil
"Lisp support, including Emacs Lisp."
+ :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'languages
:group 'development)
(defgroup c nil
"Support for the C language and related languages."
+ :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:link '(custom-manual "(ccmode)")
:group 'languages)
(defgroup tex nil
"Code related to the TeX formatter."
+ :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'wp)
(defgroup faces nil
:group 'development)
(defgroup minibuffer nil
- "Controling the behaviour of the minibuffer."
+ "Controling the behavior of the minibuffer."
:link '(custom-manual "(emacs)Minibuffer")
:group 'environment)
"Input from the menus."
:group 'environment)
+(defgroup dnd nil
+ "Handling data from drag and drop."
+ :group 'environment)
+
(defgroup auto-save nil
"Preventing accidential loss of data."
:group 'files)
:link '(custom-manual "(emacs)Windows")
:group 'environment)
-;;; Utilities.
+(defgroup mac nil
+ "Mac specific features."
+ :link '(custom-manual "(emacs)Mac OS")
+ :group 'environment
+ :version "22.1"
+ :prefix "mac-")
-(defun custom-quote (sexp)
- "Quote SEXP iff it is not self quoting."
- (if (or (memq sexp '(t nil))
- (keywordp sexp)
- (and (listp sexp)
- (memq (car sexp) '(lambda)))
- (stringp sexp)
- (numberp sexp)
- (vectorp sexp)
-;;; (and (fboundp 'characterp)
-;;; (characterp sexp))
- )
- sexp
- (list 'quote sexp)))
+;;; Utilities.
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
(defun custom-variable-prompt ()
"Prompt for a custom variable, defaulting to the variable at point.
Return a list suitable for use in `interactive'."
- (let ((v (variable-at-point))
- (enable-recursive-minibuffers t)
- val)
+ (let* ((v (variable-at-point))
+ (default (and (symbolp v) (custom-variable-p v) (symbol-name v)))
+ (enable-recursive-minibuffers t)
+ val)
(setq val (completing-read
- (if (and (symbolp v) (custom-variable-p v))
- (format "Customize option: (default %s) " v)
- "Customize option: ")
- obarray 'custom-variable-p t))
+ (if default (format "Customize variable (default %s): " default)
+ "Customize variable: ")
+ obarray 'custom-variable-p t nil nil default))
(list (if (equal val "")
(if (symbolp v) v nil)
(intern val)))))
This is used for guessing the type of variables not declared with
customize."
:type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
- :group 'customize)
+ :group 'custom-buffer)
(defcustom custom-guess-doc-alist
'(("\\`\\*?Non-nil " boolean))
This is used for guessing the type of variables not declared with
customize."
:type '(repeat (group (regexp :tag "Match") (sexp :tag "Type")))
- :group 'customize)
+ :group 'custom-buffer)
(defun custom-guess-type (symbol)
"Guess a widget suitable for editing the value of SYMBOL.
"Customization widgets in the current buffer.")
(defun Custom-set ()
- "Set changes in all modified options."
+ "Set the current value of all edited settings in the buffer."
(interactive)
(let ((children custom-options))
- (mapc (lambda (child)
- (when (eq (widget-get child :custom-state) 'modified)
- (widget-apply child :custom-set)))
- children)))
+ (if (or (and (= 1 (length children))
+ (memq (widget-type (car children))
+ '(custom-variable custom-face)))
+ (y-or-n-p "Set all values according to this buffer? "))
+ (mapc (lambda (child)
+ (when (eq (widget-get child :custom-state) 'modified)
+ (widget-apply child :custom-set)))
+ children)
+ (message "Aborted"))))
(defun Custom-save ()
- "Set all modified group members and save them."
+ "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."
(interactive)
(let ((children custom-options))
- (mapc (lambda (child)
- (when (memq (widget-get child :custom-state)
- '(modified set changed rogue))
- (widget-apply child :custom-save)))
- children))
- (custom-save-all))
+ (if (or (and (= 1 (length children))
+ (memq (widget-type (car children))
+ '(custom-variable custom-face)))
+ (yes-or-no-p "Save all settings in this buffer? "))
+ (progn
+ (mapc (lambda (child)
+ (when (memq (widget-get child :custom-state)
+ '(modified set changed rogue))
+ (widget-apply child :custom-save)))
+ children)
+ (custom-save-all))
+ (message "Aborted"))))
(defvar custom-reset-menu
- '(("Current" . Custom-reset-current)
- ("Saved" . Custom-reset-saved)
- ("Erase Customization (use standard settings)" . Custom-reset-standard))
+ '(("Undo Edits" . Custom-reset-current)
+ ("Reset to Saved" . Custom-reset-saved)
+ ("Erase Customization (use standard values)" . Custom-reset-standard))
"Alist of actions for the `Reset' button.
The key is a string containing the name of the action, the value is a
Lisp function taking the widget as an element which will be called
(defun custom-reset (event)
"Select item from reset menu."
(let* ((completion-ignore-case t)
- (answer (widget-choose "Reset to"
+ (answer (widget-choose "Reset settings"
custom-reset-menu
event)))
(if answer
(funcall answer))))
(defun Custom-reset-current (&rest ignore)
- "Reset all modified group members to their current value."
+ "Reset all edited settings in the buffer to show their current values."
(interactive)
(let ((children custom-options))
- (mapc (lambda (widget)
- (if (memq (widget-get widget :custom-state)
- '(modified changed))
- (widget-apply widget :custom-reset-current)))
- children)))
+ (if (or (and (= 1 (length children))
+ (memq (widget-type (car children))
+ '(custom-variable custom-face)))
+ (y-or-n-p "Reset all settings' buffer text to show current values? "))
+ (mapc (lambda (widget)
+ (if (memq (widget-get widget :custom-state)
+ '(modified changed))
+ (widget-apply widget :custom-reset-current)))
+ children)
+ (message "Aborted"))))
(defun Custom-reset-saved (&rest ignore)
- "Reset all modified or set group members to their saved value."
+ "Reset all edited or set settings in the buffer to their saved value.
+This also shows the saved values in the buffer."
(interactive)
(let ((children custom-options))
- (mapc (lambda (widget)
- (if (memq (widget-get widget :custom-state)
- '(modified set changed rogue))
- (widget-apply widget :custom-reset-saved)))
- children)))
+ (if (or (and (= 1 (length children))
+ (memq (widget-type (car children))
+ '(custom-variable custom-face)))
+ (y-or-n-p "Reset all settings (current values and buffer text) to saved values? "))
+ (mapc (lambda (widget)
+ (if (memq (widget-get widget :custom-state)
+ '(modified set changed rogue))
+ (widget-apply widget :custom-reset-saved)))
+ children)
+ (message "Aborted"))))
(defun Custom-reset-standard (&rest ignore)
"Erase all customization (either current or saved) for the group members.
-The immediate result is to restore them to their standard settings.
-This operation eliminates any saved settings for the group members,
+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)
(let ((children custom-options))
- (mapc (lambda (widget)
- (and (widget-apply widget :custom-standard-value)
- (if (memq (widget-get widget :custom-state)
+ (if (or (and (= 1 (length children))
+ (memq (widget-type (car children))
+ '(custom-variable custom-face)))
+ (yes-or-no-p "Erase all customizations for settings in this buffer? "))
+ (mapc (lambda (widget)
+ (and (if (widget-get widget :custom-standard-value)
+ (widget-apply widget :custom-standard-value)
+ t)
+ (memq (widget-get widget :custom-state)
'(modified set changed saved rogue))
- (widget-apply widget :custom-reset-standard))))
- children)))
+ (widget-apply widget :custom-reset-standard)))
+ children)
+ (message "Aborted"))))
;;; The Customize Commands
"Set customized value for %s to: "
current-prefix-arg))
(custom-load-symbol variable)
+ (custom-push-theme 'theme-value variable 'user 'set (custom-quote value))
(funcall (or (get variable 'custom-set) 'set-default) variable value)
(put variable 'customized-value (list (custom-quote value)))
(cond ((string= comment "")
current-prefix-arg))
(funcall (or (get variable 'custom-set) 'set-default) variable value)
(put variable 'saved-value (list (custom-quote value)))
- (custom-push-theme 'theme-value variable 'user 'set (list (custom-quote value)))
+ (custom-push-theme 'theme-value variable 'user 'set (custom-quote value))
(cond ((string= comment "")
(put variable 'variable-comment nil)
(put variable 'saved-variable-comment nil))
;;;###autoload
(defun customize-group (group)
"Customize GROUP, which must be a customization group."
- (interactive (list (let ((completion-ignore-case t))
- (completing-read "Customize group: (default emacs) "
- obarray
- (lambda (symbol)
- (or (get symbol 'custom-loads)
- (get symbol 'custom-group)))
- t))))
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Customize group (default emacs): "
+ obarray
+ (lambda (symbol)
+ (or (and (get symbol 'custom-loads)
+ (not (get symbol 'custom-autoload)))
+ (get symbol 'custom-group)))
+ t))))
(when (stringp group)
(if (string-equal "" group)
(setq group 'emacs)
;;;###autoload
(defun customize-group-other-window (group)
"Customize GROUP, which must be a customization group."
- (interactive (list (let ((completion-ignore-case t))
- (completing-read "Customize group: (default emacs) "
- obarray
- (lambda (symbol)
- (or (get symbol 'custom-loads)
- (get symbol 'custom-group)))
- t))))
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Customize group (default emacs): "
+ obarray
+ (lambda (symbol)
+ (or (and (get symbol 'custom-loads)
+ (not (get symbol 'custom-autoload)))
+ (get symbol 'custom-group)))
+ t))))
(when (stringp group)
(if (string-equal "" group)
(setq group 'emacs)
(defun customize-option (symbol)
"Customize SYMBOL, which must be a user option variable."
(interactive (custom-variable-prompt))
- (custom-buffer-create (list (list symbol 'custom-variable))
- (format "*Customize Option: %s*"
- (custom-unlispify-tag-name symbol))))
+ (let ((basevar (indirect-variable symbol)))
+ (custom-buffer-create (list (list basevar 'custom-variable))
+ (format "*Customize Option: %s*"
+ (custom-unlispify-tag-name basevar)))
+ (unless (eq symbol basevar)
+ (message "`%s' is an alias for `%s'" symbol basevar))))
;;;###autoload
(defalias 'customize-variable-other-window 'customize-option-other-window)
"Customize SYMBOL, which must be a user option variable.
Show the buffer in another window, but don't select it."
(interactive (custom-variable-prompt))
- (custom-buffer-create-other-window
- (list (list symbol 'custom-variable))
- (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol))))
+ (let ((basevar (indirect-variable symbol)))
+ (custom-buffer-create-other-window
+ (list (list basevar 'custom-variable))
+ (format "*Customize Option: %s*" (custom-unlispify-tag-name basevar)))
+ (unless (eq symbol basevar)
+ (message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "20.2"
+(defvar customize-changed-options-previous-release "21.1"
"Version for `customize-changed-options' to refer back to by default.")
+;; Packages will update this variable, so make it available.
+;;;###autoload
+(defvar customize-package-emacs-version-alist nil
+ "Alist mapping versions of Emacs to versions of a package.
+These package versions are listed in the :package-version
+keyword used in `defcustom', `defgroup', and `defface'. Its
+elements look like this:
+
+ (PACKAGE (PVERSION . EVERSION)...)
+
+For each PACKAGE, which is a symbol, there are one or more
+elements that contain a package version PVERSION with an
+associated Emacs version EVERSION. These versions are strings.
+For example, the MH-E package updates this alist with the
+following:
+
+ (add-to-list 'customize-package-emacs-version-alist
+ '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
+ (\"7.0\" . \"22.1\") (\"7.1\" . \"22.1\")
+ (\"7.2\" . \"22.1\") (\"7.3\" . \"22.1\")
+ (\"7.4\" . \"22.1\") (\"8.0\" . \"22.1\")))
+
+The value of PACKAGE needs to be unique and it needs to match the
+PACKAGE value appearing in the :package-version keyword. Since
+the user might see the value in a error message, a good choice is
+the official name of the package, such as MH-E or Gnus.")
+
+;;;###autoload
+(defalias 'customize-changed 'customize-changed-options)
+
;;;###autoload
(defun customize-changed-options (since-version)
- "Customize all user option variables changed in Emacs itself.
+ "Customize all settings whose meanings have changed in Emacs itself.
This includes new user option variables and faces, and new
-customization groups, as well as older options and faces whose default
-values have changed since the previous major Emacs release.
+customization groups, as well as older options and faces whose meanings
+or default values have changed since the previous major Emacs release.
-With argument SINCE-VERSION (a string), customize all user option
-variables that were added (or their meanings were changed) since that
-version."
+With argument SINCE-VERSION (a string), customize all settings
+that were added or redefined since that version."
- (interactive "sCustomize options changed, since version (default all versions): ")
+ (interactive
+ (list
+ (read-from-minibuffer
+ (format "Customize options changed, since version (default %s): "
+ customize-changed-options-previous-release))))
(if (equal since-version "")
(setq since-version nil)
(unless (condition-case nil
(let (found)
(mapatoms
(lambda (symbol)
- (let ((version (get symbol 'custom-version)))
+ (let* ((package-version (get symbol 'custom-package-version))
+ (version
+ (or (and package-version
+ (customize-package-emacs-version symbol
+ package-version))
+ (get symbol 'custom-version))))
(if version
(when (customize-version-lessp since-version version)
(if (or (get symbol 'custom-group)
(error "No user option defaults have been changed since Emacs %s"
since-version))))
+(defun customize-package-emacs-version (symbol package-version)
+ "Return Emacs version of SYMBOL.
+PACKAGE-VERSION has the form (PACKAGE . VERSION). The VERSION of
+PACKAGE is looked up in the associated list
+`customize-package-emacs-version-alist' to find the version of
+Emacs that is associated with it."
+ (let (package-versions emacs-version)
+ ;; Use message instead of error since we want user to be able to
+ ;; see the rest of the symbols even if a package author has
+ ;; botched things up.
+ (cond ((not (listp package-version))
+ (message "Invalid package-version value for %s" symbol))
+ ((setq package-versions (assq (car package-version)
+ customize-package-emacs-version-alist))
+ (setq emacs-version
+ (cdr (assoc (cdr package-version) package-versions)))
+ (unless emacs-version
+ (message "%s version %s not found in %s" symbol
+ (cdr package-version)
+ "customize-package-emacs-version-alist")))
+ (t
+ (message "Package %s neglected to update %s"
+ (car package-version)
+ "customize-package-emacs-version-alist")))
+ emacs-version))
+
(defun customize-version-lessp (version1 version2)
;; Why are the versions strings, and given that they are, why aren't
;; they converted to numbers and compared as such here? -- fx
;;;###autoload
(defun customize-face (&optional face)
"Customize FACE, which should be a face name or nil.
-If FACE is nil, customize all faces.
+If FACE is nil, customize all faces. If FACE is actually a
+face-alias, customize the face it is aliased to.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
face)
t nil)
"*Customize Faces*")
+ ;; If FACE is actually an alias, customize the face it is aliased to.
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
(unless (facep face)
(error "Invalid face %S" face))
(custom-buffer-create (list (list face 'custom-face))
;;;###autoload
(defun customize-face-other-window (&optional face)
"Show customization buffer for face FACE in other window.
+If FACE is actually a face-alias, customize the face it is aliased to.
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
face)
t nil)
"*Customize Faces*")
+ (if (get face 'face-alias)
+ (setq face (get face 'face-alias)))
(unless (facep face)
(error "Invalid face %S" face))
(custom-buffer-create-other-window
;;;###autoload
(defun customize-rogue ()
- "Customize all user variable modified outside customize."
+ "Customize all user variables modified outside customize."
(interactive)
(let ((found nil))
(mapatoms (lambda (symbol)
;;;###autoload
(defun customize-apropos (regexp &optional all)
- "Customize all user options matching REGEXP.
+ "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 options which are not
-user-settable, as well as faces and groups."
+If ALL 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)
(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)
- (if (memq all '(nil options))
- (user-variable-p symbol)
- (get symbol 'variable-documentation))))
+ (and (not (memq all '(nil options)))
+ (get symbol 'variable-documentation))))
(push (list symbol 'custom-variable) found)))))
(if (not found)
(error "No matches")
;;;###autoload
(defun customize-apropos-options (regexp &optional arg)
- "Customize all user options matching REGEXP.
-With prefix arg, include options which are not user-settable."
+ "Customize all loaded customizable options matching REGEXP.
+With prefix arg, include variables that are not customizable options
+\(but we recommend using `apropos-variable' instead)."
(interactive "sCustomize regexp: \nP")
(customize-apropos regexp (or arg 'options)))
;;;###autoload
(defun customize-apropos-faces (regexp)
- "Customize all user faces matching REGEXP."
+ "Customize all loaded faces matching REGEXP."
(interactive "sCustomize regexp: \n")
(customize-apropos regexp 'faces))
;;;###autoload
(defun customize-apropos-groups (regexp)
- "Customize all user groups matching REGEXP."
+ "Customize all loaded groups matching REGEXP."
(interactive "sCustomize regexp: \n")
(customize-apropos regexp 'groups))
(interactive)
(quit-window custom-buffer-done-kill))
+(defvar custom-button nil
+ "Face used for buttons in customization buffers.")
+
+(defvar custom-button-mouse nil
+ "Mouse face used for buttons in customization buffers.")
+
+(defvar custom-button-pressed nil
+ "Face used for pressed buttons in customization buffers.")
+
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
"If non-nil, indicate active buttons in a `raised-button' style.
Otherwise use brackets."
:type 'boolean
:version "21.1"
- :group 'custom-buffer)
+ :group 'custom-buffer
+ :set (lambda (variable value)
+ (custom-set-default variable value)
+ (setq custom-button
+ (if value 'custom-button 'custom-button-unraised))
+ (setq custom-button-mouse
+ (if value 'custom-button-mouse 'highlight))
+ (setq custom-button-pressed
+ (if value
+ 'custom-button-pressed
+ 'custom-button-pressed-unraised))))
(defun custom-buffer-create-internal (options &optional description)
(custom-mode)
(if description
(widget-insert description))
(widget-insert (format ".
-%s show active fields; type RET or click mouse-1
-on an active field to invoke its action. Editing an option value
-changes only the text in the buffer. Invoke the State button to set or
-save the option value. Saving an option normally edits your init file.
-Invoke "
+%s buttons; type RET or click mouse-1 to actuate one.
+Editing a setting changes only the text in the buffer.
+Use the setting's State button to set it or save changes in it.
+Saving a change normally works by editing your Emacs init file.
+See "
(if custom-raised-buttons
- "`Raised' buttons"
- "Square brackets")))
- (widget-create 'info-link
+ "`Raised' text indicates"
+ "Square brackets indicate")))
+ (widget-create 'custom-manual
:tag "Custom file"
"(emacs)Saving Customizations")
(widget-insert
- " for information on how to save in a different file.
-Invoke ")
- (widget-create 'info-link
+ " for information on how to save in a different file.\n
+See ")
+ (widget-create 'custom-manual
:tag "Help"
:help-echo "Read the online help."
"(emacs)Easy Customization")
- (widget-insert " for general information.\n\n")
- (widget-insert "Operate on everything in this buffer:\n "))
+ (widget-insert " for more information.\n\n")
+ (widget-insert "Operate on all settings in this buffer that \
+are not marked HIDDEN:\n "))
(widget-insert " "))
(widget-create 'push-button
:tag "Set for Current Session"
Make your editing in this buffer take effect for this session."
:action (lambda (widget &optional event)
(Custom-set)))
- (widget-insert " ")
- (widget-create 'push-button
- :tag "Save for Future Sessions"
- :help-echo "\
+ (if (not custom-buffer-verbose-help)
+ (progn
+ (widget-insert " ")
+ (widget-create 'custom-manual
+ :tag "Help"
+ :help-echo "Read the online help."
+ "(emacs)Easy Customization")))
+ (when (or custom-file user-init-file)
+ (widget-insert " ")
+ (widget-create 'push-button
+ :tag "Save for Future Sessions"
+ :help-echo "\
Make your editing in this buffer take effect for future Emacs sessions.
This updates your Emacs initialization file or creates a new one."
- :action (lambda (widget &optional event)
- (Custom-save)))
+ :action (lambda (widget &optional event)
+ (Custom-save))))
(if custom-reset-button-menu
(progn
(widget-insert " ")
(widget-create 'push-button
- :tag "Reset"
+ :tag "Reset buffer"
:help-echo "Show a menu with reset operations."
:mouse-down-action (lambda (&rest junk) t)
:action (lambda (widget &optional event)
(custom-reset event))))
(widget-insert "\n ")
(widget-create 'push-button
- :tag "Reset"
+ :tag "Undo Edits"
:help-echo "\
Reset all edited text in this buffer to reflect current values."
:action 'Custom-reset-current)
(widget-create 'push-button
:tag "Reset to Saved"
:help-echo "\
-Reset all values in this buffer to their saved settings."
+Reset all settings in this buffer to their saved values."
:action 'Custom-reset-saved)
(widget-insert " ")
- (widget-create 'push-button
- :tag "Erase Customization"
- :help-echo "\
-Un-customize all values in this buffer. They get their standard settings."
- :action 'Custom-reset-standard))
- (if (not custom-buffer-verbose-help)
- (progn
- (widget-insert " ")
- (widget-create 'info-link
- :tag "Help"
- :help-echo "Read the online help."
- "(emacs)Easy Customization")))
+ (when (or custom-file user-init-file)
+ (widget-create 'push-button
+ :tag "Erase Customization"
+ :help-echo "\
+Un-customize all settings in this buffer and save them with standard values."
+ :action 'Custom-reset-standard)))
(widget-insert " ")
(widget-create 'push-button
:tag "Finish"
(let ((name "*Customize Browser*"))
(pop-to-buffer (custom-get-fresh-buffer name)))
(custom-mode)
- (widget-insert "\
-Square brackets show active fields; type RET or click mouse-1
-on an active field to invoke its action.
-Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n")
+ (widget-insert (format "\
+%s buttons; type RET or click mouse-1
+on a button to invoke its action.
+Invoke [+] to expand a group, and [-] to collapse an expanded group.\n"
+ (if custom-raised-buttons
+ "`Raised' text indicates"
+ "Square brackets indicate")))
+
+
(if custom-browse-only-groups
(widget-insert "\
Invoke the [Group] button below to edit that item in another window.\n\n")
(let ((custom-buffer-style 'tree))
(custom-toggle-parent widget)))
-(define-widget 'custom-browse-group-tag 'push-button
+(define-widget 'custom-browse-group-tag 'custom-group-link
"Show parent in other window when activated."
:tag "Group"
:tag-glyph "folder"
(let ((parent (widget-get widget :parent)))
(customize-group-other-window (widget-value parent))))
-(define-widget 'custom-browse-variable-tag 'push-button
+(define-widget 'custom-browse-variable-tag 'custom-group-link
"Show parent in other window when activated."
:tag "Option"
:tag-glyph "option"
(let ((parent (widget-get widget :parent)))
(customize-variable-other-window (widget-value parent))))
-(define-widget 'custom-browse-face-tag 'push-button
+(define-widget 'custom-browse-face-tag 'custom-group-link
"Show parent in other window when activated."
:tag "Face"
:tag-glyph "face"
(define-widget 'custom-manual 'info-link
"Link to the manual entry for this customization option."
:help-echo "Read the manual entry for this option."
+ :button-face 'custom-link
+ :mouse-face 'highlight
+ :pressed-face 'highlight
:tag "Manual")
;;; The `custom-magic' Widget.
:group 'custom-faces
:group 'custom-buffer)
-(defface custom-invalid-face '((((class color))
- (:foreground "yellow" :background "red"))
- (t
- (:weight bold :slant italic :underline t)))
+(defface custom-invalid '((((class color))
+ (:foreground "yellow1" :background "red1"))
+ (t
+ (: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)
-(defface custom-rogue-face '((((class color))
- (:foreground "pink" :background "black"))
- (t
- (:underline t)))
+(defface custom-rogue '((((class color))
+ (:foreground "pink" :background "black"))
+ (t
+ (: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)
-(defface custom-modified-face '((((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic :bold)))
+(defface custom-modified '((((min-colors 88) (class color))
+ (:foreground "white" :background "blue1"))
+ (((class color))
+ (:foreground "white" :background "blue"))
+ (t
+ (:slant italic :bold)))
"Face used when the customize item has been modified."
:group 'custom-magic-faces)
-
-(defface custom-set-face '((((class color))
- (:foreground "blue" :background "white"))
- (t
- (:slant italic)))
+;; backward-compatibility alias
+(put 'custom-modified-face 'face-alias 'custom-modified)
+
+(defface custom-set '((((min-colors 88) (class color))
+ (:foreground "blue1" :background "white"))
+ (((class color))
+ (:foreground "blue" :background "white"))
+ (t
+ (:slant italic)))
"Face used when the customize item has been set."
:group 'custom-magic-faces)
-
-(defface custom-changed-face '((((class color))
- (:foreground "white" :background "blue"))
- (t
- (:slant italic)))
+;; backward-compatibility alias
+(put 'custom-set-face 'face-alias 'custom-set)
+
+(defface custom-changed '((((min-colors 88) (class color))
+ (:foreground "white" :background "blue1"))
+ (((class color))
+ (:foreground "white" :background "blue"))
+ (t
+ (: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)
+
+(defface custom-themed '((((min-colors 88) (class color))
+ (:foreground "white" :background "blue1"))
+ (((class color))
+ (:foreground "white" :background "blue"))
+ (t
+ (:slant italic)))
+ "Face used when the customize item has been set by a theme."
+ :group 'custom-magic-faces)
-(defface custom-saved-face '((t (:underline t)))
+(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)
(defconst custom-magic-alist
'((nil "#" underline "\
(hidden "-" default "\
HIDDEN, invoke \"Show\" in the previous line to show." "\
group now hidden, invoke \"Show\", above, to show contents.")
- (invalid "x" custom-invalid-face "\
+ (invalid "x" custom-invalid "\
INVALID, the displayed value cannot be set.")
- (modified "*" custom-modified-face "\
+ (modified "*" custom-modified "\
EDITED, shown value does not take effect until you set or save it." "\
something in this group has been edited but not set.")
- (set "+" custom-set-face "\
+ (set "+" custom-set "\
SET for current session only." "\
something in this group has been set but not saved.")
- (changed ":" custom-changed-face "\
+ (changed ":" custom-changed "\
CHANGED outside Customize; operating on it here may be unreliable." "\
something in this group has been changed outside customize.")
- (saved "!" custom-saved-face "\
+ (saved "!" custom-saved "\
SAVED and set." "\
something in this group has been set and saved.")
- (rogue "@" custom-rogue-face "\
-NO CUSTOMIZATION DATA; you should not see this." "\
+ (themed "o" custom-themed "\
+THEMED." "\
+visible group members are all at standard values.")
+ (rogue "@" custom-rogue "\
+NO CUSTOMIZATION DATA; not intended to be customized." "\
something in this group is not prepared for customization.")
(standard " " nil "\
STANDARD." "\
-visible group members are all at standard settings."))
+visible group members are all at standard values."))
"Alist of customize option states.
Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
(insert " (lisp)"))
((eq form 'mismatch)
(insert " (mismatch)")))
- (put-text-property start (point) 'face 'custom-state-face))
+ (put-text-property start (point) 'face 'custom-state))
(insert "\n"))
(when (and (eq category 'group)
(not (and (eq custom-buffer-style 'links)
;;; The `custom' Widget.
-(defface custom-button-face
+(defface custom-button
'((((type x w32 mac) (class color)) ; Like default modeline
(:box (:line-width 2 :style released-button)
:background "lightgrey" :foreground "black"))
(t
nil))
- "Face used for buttons in customization buffers."
+ "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)
-(defface custom-button-pressed-face
+(defface custom-button-mouse
+ '((((type x w32 mac) (class color))
+ (:box (:line-width 2 :style released-button)
+ :background "grey90" :foreground "black"))
+ (t
+ nil))
+ "Mouse face for custom buffer buttons if `custom-raised-buttons' is non-nil."
+ :version "22.1"
+ :group 'custom-faces)
+
+(defface custom-button-unraised
+ '((t :inherit underline))
+ "Face for custom buffer buttons if `custom-raised-buttons' is nil."
+ :version "22.1"
+ :group 'custom-faces)
+
+(setq custom-button
+ (if custom-raised-buttons 'custom-button 'custom-button-unraised))
+
+(setq custom-button-mouse
+ (if custom-raised-buttons 'custom-button-mouse 'highlight))
+
+(defface custom-button-pressed
'((((type x w32 mac) (class color))
(:box (:line-width 2 :style pressed-button)
:background "lightgrey" :foreground "black"))
(t
(:inverse-video t)))
- "Face used for buttons in customization buffers."
+ "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)
+
+(defface custom-button-pressed-unraised
+ '((default :inherit custom-button-unraised)
+ (((class color) (background light)) :foreground "magenta4")
+ (((class color) (background dark)) :foreground "violet"))
+ "Face for pressed custom buttons if `custom-raised-buttons' is nil."
+ :version "22.1"
+ :group 'custom-faces)
-(defface custom-documentation-face nil
+(setq custom-button-pressed
+ (if custom-raised-buttons
+ 'custom-button-pressed
+ 'custom-button-pressed-unraised))
+
+(defface custom-documentation '((t nil))
"Face used for documentation strings in customization buffers."
:group 'custom-faces)
-
-(defface custom-state-face '((((class color)
- (background dark))
- (:foreground "lime green"))
- (((class color)
- (background light))
- (:foreground "dark green"))
- (t nil))
+;; backward-compatibility alias
+(put 'custom-documentation-face 'face-alias 'custom-documentation)
+
+(defface custom-state '((((class color)
+ (background dark))
+ (:foreground "lime green"))
+ (((class color)
+ (background light))
+ (:foreground "dark green"))
+ (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)
+
+(defface custom-link
+ '((t :inherit link))
+ "Face for links in customization buffers."
+ :version "22.1"
+ :group 'custom-faces)
(define-widget 'custom 'default
"Customize a user option."
(insert prefix))
(insert "See also ")
(while links
- (push (widget-create-child-and-convert widget (car 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)
(defun custom-add-parent-links (widget &optional initial-string)
"Add \"Parent groups: ...\" to WIDGET if the group has parents.
-The value if non-nil if any parents were found.
+The value is non-nil if any parents were found.
If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
(let ((name (widget-value widget))
(type (widget-type widget))
(parents nil))
(insert (or initial-string "Parent groups:"))
(mapatoms (lambda (symbol)
- (let ((entry (assq name (get symbol 'custom-group))))
- (when (eq (nth 1 entry) type)
- (insert " ")
- (push (widget-create-child-and-convert
- widget 'custom-group-link
- :tag (custom-unlispify-tag-name symbol)
- symbol)
- buttons)
- (setq parents (cons symbol parents))))))
+ (when (member (list name type) (get symbol 'custom-group))
+ (insert " ")
+ (push (widget-create-child-and-convert
+ widget 'custom-group-link
+ :tag (custom-unlispify-tag-name symbol)
+ 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 (get (car parents) 'custom-links))
+ (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
(insert "\nParent documentation: ")
(while links
- (push (widget-create-child-and-convert widget (car 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)
;;; The `custom-comment' Widget.
;; like the editable field
-(defface custom-comment-face '((((class grayscale color)
- (background light))
- (:background "gray85"))
- (((class grayscale color)
- (background dark))
- (:background "dim gray"))
- (t
- (:slant italic)))
+(defface custom-comment '((((type tty))
+ :background "yellow3"
+ :foreground "black")
+ (((class grayscale color)
+ (background light))
+ :background "gray85")
+ (((class grayscale color)
+ (background dark))
+ :background "dim gray")
+ (t
+ :slant italic))
"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)
;; like font-lock-comment-face
-(defface custom-comment-tag-face
+(defface custom-comment-tag
'((((class color) (background dark)) (:foreground "gray80"))
(((class color) (background light)) (:foreground "blue4"))
(((class grayscale) (background light))
(t (:weight bold)))
"Face used for variables or faces comment tags"
:group 'custom-faces)
+;; backward-compatibility alias
+(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
(define-widget 'custom-comment 'string
"User comment."
;; When this was underlined blue, users confused it with a
;; Mosaic-style hyperlink...
-(defface custom-variable-tag-face
+(defface custom-variable-tag
`((((class color)
(background dark))
(:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
+ (((min-colors 88) (class color)
+ (background light))
+ (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
(((class color)
(background light))
(:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
(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)
-(defface custom-variable-button-face '((t (:underline t :weight bold)))
+(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)
(defcustom custom-variable-default-form 'edit
"Default form of displaying variable values."
(error nil))
'set
'changed))
- ((progn (setq tmp (get symbol 'saved-value))
+ ((progn (setq tmp (get symbol 'theme-value))
(setq temp (get symbol 'saved-variable-comment))
(or tmp temp))
(if (condition-case nil
- (and (equal value (eval (car tmp)))
- (equal comment temp))
+ (and (equal comment temp)
+ (equal value
+ (eval
+ (car (custom-variable-theme-value
+ symbol)))))
(error nil))
- 'saved
+ (cond
+ ((eq (caar tmp) 'user) 'saved)
+ ((eq (caar tmp) 'changed) 'changed)
+ (t 'themed))
'changed))
((setq tmp (get symbol 'standard-value))
(if (condition-case nil
(get (widget-value widget) 'standard-value))
(defvar custom-variable-menu
- '(("Set for Current Session" custom-variable-set
+ `(("Set for Current Session" custom-variable-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
- ("Save for Future Sessions" custom-variable-save
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set changed rogue))))
- ("Reset to Current" custom-redraw
+ ,@(when (or custom-file user-init-file)
+ '(("Save for Future Sessions" custom-variable-save
+ (lambda (widget)
+ (memq (widget-get widget :custom-state)
+ '(modified set changed rogue))))))
+ ("Undo Edits" custom-redraw
(lambda (widget)
(and (default-boundp (widget-value widget))
(memq (widget-get widget :custom-state) '(modified changed)))))
(get (widget-value widget) 'saved-variable-comment))
(memq (widget-get widget :custom-state)
'(modified set changed rogue)))))
- ("Erase Customization" custom-variable-reset-standard
- (lambda (widget)
- (and (get (widget-value widget) 'standard-value)
- (memq (widget-get widget :custom-state)
- '(modified set changed saved rogue)))))
- ("Use Backup Value" custom-variable-reset-backup
+ ,@(when (or custom-file user-init-file)
+ '(("Erase Customization" custom-variable-reset-standard
+ (lambda (widget)
+ (and (get (widget-value widget) 'standard-value)
+ (memq (widget-get widget :custom-state)
+ '(modified set changed saved rogue)))))))
+ ("Set to Backup Value" custom-variable-reset-backup
(lambda (widget)
(get (widget-value widget) 'backup-value)))
("---" ignore ignore)
("Add Comment" custom-comment-show custom-comment-invisible-p)
("---" ignore ignore)
- ("Don't show as Lisp expression" custom-variable-edit
+ ("Show Current Value" custom-variable-edit
(lambda (widget)
(eq (widget-get widget :custom-form) 'lisp)))
- ("Show initial Lisp expression" custom-variable-edit-lisp
+ ("Show Saved Lisp Expression" custom-variable-edit-lisp
(lambda (widget)
(eq (widget-get widget :custom-form) 'edit))))
"Alist of actions for the `custom-variable' widget.
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
(custom-variable-backup-value widget)
+ (custom-push-theme 'theme-value symbol 'user
+ 'set (custom-quote (widget-value child)))
(funcall set symbol (eval (setq val (widget-value child))))
(put symbol 'customized-value (list val))
(put symbol 'variable-comment comment)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
(custom-variable-backup-value widget)
+ (custom-push-theme 'theme-value symbol 'user
+ 'set (custom-quote (widget-value child)))
(funcall set symbol (setq val (widget-value child)))
(put symbol 'customized-value (list (custom-quote val)))
(put symbol 'variable-comment comment)
(custom-comment-hide comment-widget))
(put symbol 'saved-value (list (widget-value child)))
(custom-push-theme 'theme-value symbol 'user
- 'set (list (widget-value child)))
+ 'set (custom-quote (widget-value child)))
(funcall set symbol (eval (widget-value child)))
(put symbol 'variable-comment comment)
(put symbol 'saved-variable-comment comment))
(put symbol 'saved-value
(list (custom-quote (widget-value child))))
(custom-push-theme 'theme-value symbol 'user
- 'set (list (custom-quote (widget-value
- child))))
+ 'set (custom-quote (widget-value child)))
(funcall set symbol (widget-value child))
(put symbol 'variable-comment comment)
(put symbol 'saved-variable-comment comment)))
(defun custom-variable-reset-saved (widget)
"Restore the saved value for the variable being edited by WIDGET.
+This also updates the buffer to show that value.
The value that was current before this operation
becomes the backup value, so you can get it again."
(let* ((symbol (widget-value widget))
(cond ((or value comment)
(put symbol 'variable-comment comment)
(custom-variable-backup-value widget)
+ (custom-push-theme 'theme-value symbol 'user 'set (car-safe value))
(condition-case nil
(funcall set symbol (eval (car value)))
(error nil)))
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* ((symbol (widget-value widget))
- (set (or (get symbol 'custom-set) 'set-default)))
+ (let* ((symbol (widget-value widget)))
(if (get symbol 'standard-value)
- (progn
- (custom-variable-backup-value widget)
- (funcall set symbol (eval (car (get symbol 'standard-value)))))
+ (custom-variable-backup-value widget)
(error "No standard setting known for %S" symbol))
(put symbol 'variable-comment nil)
(put symbol 'customized-value nil)
(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)
- (custom-push-theme 'theme-value symbol 'user 'reset 'standard)
- ;; As a special optimizations we do not (explictly)
- ;; save resets to standard when no theme set the value.
- (if (null (cdr (get symbol 'theme-value)))
- (put symbol 'theme-value nil))
(put symbol 'saved-variable-comment nil)
(custom-save-all))
(widget-put widget :custom-state 'unknown)
(if value
(progn
(custom-variable-backup-value widget)
+ (custom-push-theme 'theme-value symbol 'user 'set value)
(condition-case nil
(funcall set symbol (car value))
(error nil)))
;;; The `custom-face' Widget.
-(defface custom-face-tag-face
+(defface custom-face-tag
`((t (:weight bold :height 1.2 :inherit variable-pitch)))
"Face used for face tags."
:group 'custom-faces)
+;; backward-compatibility alias
+(put 'custom-face-tag-face 'face-alias 'custom-face-tag)
(defcustom custom-face-default-form 'selected
"Default form of displaying face definition."
(message "Creating face editor...done"))))))
(defvar custom-face-menu
- '(("Set for Current Session" custom-face-set)
- ("Save for Future Sessions" custom-face-save-command)
+ `(("Set for Current Session" custom-face-set)
+ ,@(when (or custom-file user-init-file)
+ '(("Save for Future Sessions" custom-face-save)))
+ ("Undo Edits" custom-redraw
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified changed))))
("Reset to Saved" custom-face-reset-saved
(lambda (widget)
(or (get (widget-value widget) 'saved-face)
(get (widget-value widget) 'saved-face-comment))))
- ("Erase Customization" custom-face-reset-standard
- (lambda (widget)
- (get (widget-value widget) 'face-defface-spec)))
+ ,@(when (or custom-file user-init-file)
+ '(("Erase Customization" custom-face-reset-standard
+ (lambda (widget)
+ (get (widget-value widget) 'face-defface-spec)))))
("---" ignore ignore)
("Add Comment" custom-comment-show custom-comment-invisible-p)
("---" ignore ignore)
- ("Show all display specs" custom-face-edit-all
- (lambda (widget)
- (not (eq (widget-get widget :custom-form) 'all))))
- ("Just current attributes" custom-face-edit-selected
+ ("For Current Display" custom-face-edit-selected
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'selected))))
- ("Show as Lisp expression" custom-face-edit-lisp
+ ("For All Kinds of Displays" custom-face-edit-all
+ (lambda (widget)
+ (not (eq (widget-get widget :custom-form) 'all))))
+ ("Show Lisp Expression" custom-face-edit-lisp
(lambda (widget)
(not (eq (widget-get widget :custom-form) 'lisp)))))
"Alist of actions for the `custom-face' widget.
(setq temp (get symbol 'saved-face-comment))
(or tmp temp))
(if (equal temp comment)
- 'saved
+ (cond
+ ((eq 'user (caar (get symbol 'theme-face)))
+ 'saved)
+ ((eq 'changed (caar (get symbol 'theme-face)))
+ 'changed)
+ (t 'themed))
'changed))
((get symbol 'face-defface-spec)
(if (equal comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
(put symbol 'customized-face value)
+ (custom-push-theme 'theme-face symbol 'user 'set value)
(if (face-spec-choose value)
(face-spec-set symbol value)
;; face-set-spec ignores empty attribute lists, so just give it
(custom-face-state-set widget)
(custom-redraw-magic widget)))
-(defun custom-face-save-command (widget)
- "Save in `.emacs' the face attributes in WIDGET."
- (custom-face-save widget)
- (custom-save-all))
-
(defun custom-face-save (widget)
- "Prepare for saving WIDGET's face attributes, but don't write `.emacs'."
+ "Save in `.emacs' the face attributes in WIDGET."
(let* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(value (custom-post-filter-face-spec (widget-value child)))
(setq comment nil)
;; Make the comment invisible by hand if it's empty
(custom-comment-hide comment-widget))
+ (custom-push-theme 'theme-face symbol 'user 'set value)
(if (face-spec-choose value)
(face-spec-set symbol value)
;; face-set-spec ignores empty attribute lists, so just give it
(face-spec-set symbol '((t :foreground unspecified))))
(unless (eq (widget-get widget :custom-state) 'standard)
(put symbol 'saved-face value))
- (custom-push-theme 'theme-face symbol 'user 'set value)
(put symbol 'customized-face nil)
(put symbol 'face-comment comment)
(put symbol 'customized-face-comment nil)
(custom-face-state-set widget)
(custom-redraw-magic widget)))
+;; For backward compatibility.
+(define-obsolete-function-alias 'custom-face-save-command 'custom-face-save
+ "22.1")
+
(defun custom-face-reset-saved (widget)
"Restore WIDGET to the face's default attributes."
(let* ((symbol (widget-value widget))
(error "No saved value for this face"))
(put symbol 'customized-face nil)
(put symbol 'customized-face-comment nil)
+ (custom-push-theme 'theme-face symbol 'user 'set value)
(face-spec-set symbol value)
(put symbol 'face-comment comment)
(widget-value-set child value)
(get (widget-value widget) 'face-defface-spec))
(defun custom-face-reset-standard (widget)
- "Restore WIDGET to the face's standard settings.
-This operation eliminates any saved setting for the face,
+ "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* ((symbol (widget-value widget))
(child (car (widget-get widget :children)))
(error "No standard setting for this face"))
(put symbol 'customized-face nil)
(put symbol 'customized-face-comment nil)
+ (custom-push-theme 'theme-face symbol 'user 'reset)
+ (face-spec-set symbol value)
+ (custom-theme-recalc-face symbol)
(when (or (get symbol 'saved-face) (get symbol 'saved-face-comment))
(put symbol 'saved-face nil)
- (custom-push-theme 'theme-face symbol 'user 'reset 'standard)
- ;; Do not explictly save resets to standards without themes.
- (if (null (cdr (get symbol 'theme-face)))
- (put symbol 'theme-face nil))
(put symbol 'saved-face-comment nil)
(custom-save-all))
- (face-spec-set symbol value)
(put symbol 'face-comment nil)
- (widget-value-set child value)
+ (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)
(defvar widget-face-prompt-value-history nil
"History of input to `widget-face-prompt-value'.")
-(define-widget 'face 'restricted-sexp
- "A Lisp face name."
+(define-widget 'face 'symbol
+ "A Lisp face name (with sample)."
+ :format "%{%t%}: (%{sample%}) %v"
+ :tag "Face"
+ :value 'default
+ :sample-face-get 'widget-face-sample-face-get
+ :notify 'widget-face-notify
+ :match (lambda (widget value) (facep value))
:complete-function (lambda ()
(interactive)
(lisp-complete-symbol 'facep))
- :prompt-value 'widget-field-prompt-value
- :prompt-internal 'widget-symbol-prompt-internal
:prompt-match 'facep
:prompt-history 'widget-face-prompt-value-history
- :value-create 'widget-face-value-create
- :action 'widget-field-action
- :match-alternatives '(facep)
:validate (lambda (widget)
(unless (facep (widget-value widget))
- (widget-put widget :error (format "Invalid face: %S"
- (widget-value widget)))
- widget))
- :value 'ignore
- :tag "Function")
-
+ (widget-put widget
+ :error (format "Invalid face: %S"
+ (widget-value widget)))
+ widget)))
-;;; There is a bug here: the sample doesn't get redisplayed
-;;; in the new font when you specify one. Does anyone know how to
-;;; make that work? -- rms.
+(defun widget-face-sample-face-get (widget)
+ (let ((value (widget-value widget)))
+ (if (facep value)
+ value
+ 'default)))
-(defun widget-face-value-create (widget)
- "Create an editable face name field."
- (let ((buttons (widget-get widget :buttons))
- (symbol (widget-get widget :value)))
- ;; Sample.
- (push (widget-create-child-and-convert widget 'item
- :format "(%{%t%})"
- :sample-face symbol
- :tag "sample")
- buttons)
- (insert " ")
- ;; Update buttons.
- (widget-put widget :buttons buttons))
-
- (let ((size (widget-get widget :size))
- (value (widget-get widget :value))
- (from (point))
- ;; This is changed to a real overlay in `widget-setup'. We
- ;; need the end points to behave differently until
- ;; `widget-setup' is called.
- (overlay (cons (make-marker) (make-marker))))
- (widget-put widget :field-overlay overlay)
- (insert value)
- (and size
- (< (length value) size)
- (insert-char ?\ (- size (length value))))
- (unless (memq widget widget-field-list)
- (setq widget-field-new (cons widget widget-field-new)))
- (move-marker (cdr overlay) (point))
- (set-marker-insertion-type (cdr overlay) nil)
- (when (null size)
- (insert ?\n))
- (move-marker (car overlay) from)
- (set-marker-insertion-type (car overlay) t)))
+(defun widget-face-notify (widget child &optional event)
+ "Update the sample, and notify the parent."
+ (overlay-put (widget-get widget :sample-overlay)
+ 'face (widget-apply widget :sample-face-get))
+ (widget-default-notify widget child event))
;;; The `hook' Widget.
(define-widget 'custom-group-link 'link
"Show parent in other window when activated."
+ :button-face 'custom-link
+ :mouse-face 'highlight
+ :pressed-face 'highlight
:help-echo "Create customization buffer for this group."
:action 'custom-group-link-action)
;; Fixme: make it do so in Emacs.
"Face used for group tags.
The first member is used for level 1 groups, the second for level 2,
-and so forth. The remaining group tags are shown with
-`custom-group-tag-face'."
+and so forth. The remaining group tags are shown with `custom-group-tag'."
:type '(repeat face)
:group 'custom-faces)
-(defface custom-group-tag-face-1
+(defface custom-group-tag-1
`((((class color)
(background dark))
(:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
+ (((min-colors 88) (class color)
+ (background light))
+ (:foreground "red1" :weight bold :height 1.2 :inherit variable-pitch))
(((class color)
(background light))
(:foreground "red" :weight bold :height 1.2 :inherit variable-pitch))
(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)
-(defface custom-group-tag-face
+(defface custom-group-tag
`((((class color)
(background dark))
(:foreground "light blue" :weight bold :height 1.2))
+ (((min-colors 88) (class color)
+ (background light))
+ (:foreground "blue1" :weight bold :height 1.2))
(((class color)
(background light))
(:foreground "blue" :weight bold :height 1.2))
(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-widget 'custom-group 'custom
"Customize group."
(defun custom-group-sample-face-get (widget)
;; Use :sample-face.
(or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
- 'custom-group-tag-face))
+ 'custom-group-tag))
(define-widget 'custom-group-visibility 'visibility
"An indicator and manipulator for hidden group contents."
(insert "/\n")))))
(defvar custom-group-menu
- '(("Set for Current Session" custom-group-set
+ `(("Set for Current Session" custom-group-set
(lambda (widget)
(eq (widget-get widget :custom-state) 'modified)))
- ("Save for Future Sessions" custom-group-save
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set))))
- ("Reset to Current" custom-group-reset-current
+ ,@(when (or custom-file user-init-file)
+ '(("Save for Future Sessions" custom-group-save
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set))))))
+ ("Undo Edits" custom-group-reset-current
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified))))
("Reset to Saved" custom-group-reset-saved
(lambda (widget)
(memq (widget-get widget :custom-state) '(modified set))))
- ("Reset to standard setting" custom-group-reset-standard
- (lambda (widget)
- (memq (widget-get widget :custom-state) '(modified set saved)))))
+ ,@(when (or custom-file user-init-file)
+ '(("Erase Customization" custom-group-reset-standard
+ (lambda (widget)
+ (memq (widget-get widget :custom-state) '(modified set saved)))))))
"Alist of actions for the `custom-group' widget.
Each entry has the form (NAME ACTION FILTER) where NAME is the name of
the menu entry, ACTION is the function to call on the widget when the
(setq magics (cdr magics)))))
(widget-put widget :custom-state found)))
(custom-magic-reset widget))
+\f
+;;; Reading and writing the custom file.
-;;; The `custom-save-all' Function.
;;;###autoload
(defcustom custom-file nil
"File used for storing customization information.
(defun custom-file ()
"Return the file name for saving customizations."
- (or custom-file
- (let ((user-init-file user-init-file)
- (default-init-file
- (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
- (when (null user-init-file)
- (if (or (file-exists-p default-init-file)
- (and (eq system-type 'windows-nt)
- (file-exists-p "~/_emacs")))
- ;; Started with -q, i.e. the file containing
- ;; Custom settings hasn't been read. Saving
- ;; settings there would overwrite other settings.
- (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
- (setq user-init-file default-init-file))
- user-init-file)))
+ (file-chase-links
+ (or custom-file
+ (let ((user-init-file user-init-file)
+ (default-init-file
+ (if (eq system-type 'ms-dos) "~/_emacs" "~/.emacs")))
+ (when (null user-init-file)
+ (if (or (file-exists-p default-init-file)
+ (and (eq system-type 'windows-nt)
+ (file-exists-p "~/_emacs")))
+ ;; Started with -q, i.e. the file containing
+ ;; Custom settings hasn't been read. Saving
+ ;; settings there would overwrite other settings.
+ (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (setq user-init-file default-init-file))
+ user-init-file))))
+
+;;;###autoload
+(defun custom-save-all ()
+ "Save all customizations in `custom-file'."
+ (let* ((filename (custom-file))
+ (recentf-exclude (if recentf-mode
+ (cons (concat "\\`"
+ (regexp-quote (custom-file))
+ "\\'")
+ recentf-exclude)))
+ (old-buffer (find-buffer-visiting filename)))
+ (with-current-buffer (or old-buffer (find-file-noselect filename))
+ (let ((inhibit-read-only t))
+ (custom-save-variables)
+ (custom-save-faces))
+ (let ((file-precious-flag t))
+ (save-buffer))
+ (unless old-buffer
+ (kill-buffer (current-buffer))))))
+
+;;;###autoload
+(defun customize-save-customized ()
+ "Save all user options which have been set in this session."
+ (interactive)
+ (mapatoms (lambda (symbol)
+ (let ((face (get symbol 'customized-face))
+ (value (get symbol 'customized-value))
+ (face-comment (get symbol 'customized-face-comment))
+ (variable-comment
+ (get symbol 'customized-variable-comment)))
+ (when face
+ (put symbol 'saved-face face)
+ (custom-push-theme 'theme-face symbol 'user 'set value)
+ (put symbol 'customized-face nil))
+ (when value
+ (put symbol 'saved-value value)
+ (custom-push-theme 'theme-value symbol 'user 'set value)
+ (put symbol 'customized-value nil))
+ (when variable-comment
+ (put symbol 'saved-variable-comment variable-comment)
+ (put symbol 'customized-variable-comment nil))
+ (when face-comment
+ (put symbol 'saved-face-comment face-comment)
+ (put symbol 'customized-face-comment nil)))))
+ ;; We really should update all custom buffers here.
+ (custom-save-all))
+\f
+;; Editing the custom file contents in a buffer.
(defun custom-save-delete (symbol)
- "Visit `custom-file' and delete all calls to SYMBOL from it.
+ "Delete all calls to SYMBOL from the contents of the current buffer.
Leave point at the old location of the first such call,
-or (if there were none) at the end of the buffer."
- (let ((default-major-mode 'emacs-lisp-mode))
- (set-buffer (find-file-noselect (custom-file))))
+or (if there were none) at the end of the buffer.
+
+This function does not save the buffer."
(goto-char (point-min))
;; Skip all whitespace and comments.
(while (forward-comment 1))
(defun custom-save-variables ()
"Save all customized variables in `custom-file'."
(save-excursion
- (custom-save-delete 'custom-load-themes)
- (custom-save-delete 'custom-reset-variables)
(custom-save-delete 'custom-set-variables)
- (custom-save-loaded-themes)
- (custom-save-resets 'theme-value 'custom-reset-variables nil)
(let ((standard-output (current-buffer))
(saved-list (make-list 1 0))
sort-fold-case)
;; First create a sorted list of saved variables.
(mapatoms
(lambda (symbol)
- (if (get symbol 'saved-value)
+ (if (and (get symbol 'saved-value)
+ ;; ignore theme values
+ (or (null (get symbol 'theme-value))
+ (eq 'user (caar (get symbol 'theme-value)))))
(nconc saved-list (list symbol)))))
(setq saved-list (sort (cdr saved-list) 'string<))
(unless (bolp)
(when (and (symbolp request) (not (featurep request)))
(message "Unknown requested feature: %s" request)
(setq requests (delq request requests))))
- (when (or (and spec
- (eq (nth 0 spec) 'user)
- (eq (nth 1 spec) 'set))
+ (when (or (and spec (eq (car spec) 'user))
comment
(and (null spec) (get symbol 'saved-value)))
(unless (bolp)
(save-excursion
(custom-save-delete 'custom-reset-faces)
(custom-save-delete 'custom-set-faces)
- (custom-save-resets 'theme-face 'custom-reset-faces '(default))
(let ((standard-output (current-buffer))
(saved-list (make-list 1 0))
sort-fold-case)
;; First create a sorted list of saved faces.
(mapatoms
(lambda (symbol)
- (if (get symbol 'saved-face)
+ (if (and (get symbol 'saved-face)
+ (eq 'user (car (car-safe (get symbol 'theme-face)))))
(nconc saved-list (list symbol)))))
(setq saved-list (sort (cdr saved-list) 'string<))
;; The default face must be first, since it affects the others.
(and (not (custom-facep symbol))
(not (get symbol 'force-face))))))
(comment (get symbol 'saved-face-comment)))
- (when (or (and spec
- (eq (nth 0 spec) 'user)
- (eq (nth 1 spec) 'set))
+ (when (or (and spec (eq (nth 0 spec) 'user))
comment
(and (null spec) (get symbol 'saved-face)))
;; Don't print default face here.
(princ ")")
(unless (looking-at "\n")
(princ "\n")))))
-
-(defun custom-save-resets (property setter special)
- (let (started-writing ignored-special)
- ;; (custom-save-delete setter) Done by caller
- (let ((standard-output (current-buffer))
- (mapper `(lambda (object)
- (let ((spec (car-safe (get object (quote ,property)))))
- (when (and (not (memq object ignored-special))
- (eq (nth 0 spec) 'user)
- (eq (nth 1 spec) 'reset))
- ;; Do not write reset statements unless necessary.
- (unless started-writing
- (setq started-writing t)
- (unless (bolp)
- (princ "\n"))
- (princ "(")
- (princ (quote ,setter))
- (princ "\n '(")
- (prin1 object)
- (princ " ")
- (prin1 (nth 3 spec))
- (princ ")")))))))
- (mapc mapper special)
- (setq ignored-special special)
- (mapatoms mapper)
- (when started-writing
- (princ ")\n")))))
-
-(defun custom-save-loaded-themes ()
- (let ((themes (reverse (get 'user 'theme-loads-themes)))
- (standard-output (current-buffer)))
- (when themes
- (unless (bolp) (princ "\n"))
- (princ "(custom-load-themes")
- (mapc (lambda (theme)
- (princ "\n '")
- (prin1 theme)) themes)
- (princ " )\n"))))
-
-;;;###autoload
-(defun customize-save-customized ()
- "Save all user options which have been set in this session."
- (interactive)
- (mapatoms (lambda (symbol)
- (let ((face (get symbol 'customized-face))
- (value (get symbol 'customized-value))
- (face-comment (get symbol 'customized-face-comment))
- (variable-comment
- (get symbol 'customized-variable-comment)))
- (when face
- (put symbol 'saved-face face)
- (custom-push-theme 'theme-face symbol 'user 'set value)
- (put symbol 'customized-face nil))
- (when value
- (put symbol 'saved-value value)
- (custom-push-theme 'theme-value symbol 'user 'set value)
- (put symbol 'customized-value nil))
- (when variable-comment
- (put symbol 'saved-variable-comment variable-comment)
- (put symbol 'customized-variable-comment nil))
- (when face-comment
- (put symbol 'saved-face-comment face-comment)
- (put symbol 'customized-face-comment nil)))))
- ;; We really should update all custom buffers here.
- (custom-save-all))
-
-;;;###autoload
-(defun custom-save-all ()
- "Save all customizations in `custom-file'."
- (let ((inhibit-read-only t))
- (custom-save-variables)
- (custom-save-faces)
- (save-excursion
- (let ((default-major-mode nil))
- (set-buffer (find-file-noselect (custom-file))))
- (let ((file-precious-flag t))
- (save-buffer)))))
-
+\f
;;; The Customize Menu.
;;; Menu support
(suppress-keymap map)
(define-key map " " 'scroll-up)
(define-key map "\177" 'scroll-down)
+ (define-key map "\C-c\C-c" 'Custom-set)
(define-key map "\C-x\C-s" 'Custom-save)
(define-key map "q" 'Custom-buffer-done)
(define-key map "u" 'Custom-goto-parent)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
- (define-key map [mouse-1] 'Custom-move-and-invoke)
map)
"Keymap for `custom-mode'.")
-(defun Custom-move-and-invoke (event)
- "Move to where you click, and if it is an active field, invoke it."
- (interactive "e")
- (mouse-set-point event)
- (if (widget-event-point event)
- (let* ((pos (widget-event-point event))
- (button (get-char-property pos 'button)))
- (if button
- (widget-button-click event)))))
-
(easy-menu-define Custom-mode-menu
custom-mode-map
"Menu used in customization buffers."
,(customize-menu-create 'customize)
["Set" Custom-set t]
["Save" Custom-save t]
- ["Reset to Current" Custom-reset-current t]
+ ["Undo Edits" Custom-reset-current t]
["Reset to Saved" Custom-reset-saved t]
- ["Reset to Standard Settings" Custom-reset-standard t]
- ["Info" (Info-goto-node "(emacs)Easy Customization") t]))
+ ["Erase Customization" Custom-reset-standard t]
+ ["Info" (info "(emacs)Easy Customization") t]))
+
+(defvar custom-field-keymap
+ (let ((map (copy-keymap widget-field-keymap)))
+ (define-key map "\C-c\C-c" 'Custom-set)
+ (define-key map "\C-x\C-s" 'Custom-save)
+ map)
+ "Keymap used inside editable fields in customization buffers.")
+
+(widget-put (get 'editable-field 'widget-type) :keymap custom-field-keymap)
(defun Custom-goto-parent ()
"Go to the parent group listed at the top of this buffer.
The following commands are available:
-Move to next button or editable field. \\[widget-forward]
-Move to previous button or editable field. \\[widget-backward]
-\\<widget-field-keymap>\
+\\<widget-keymap>\
+Move to next button, link or editable field. \\[widget-forward]
+Move to previous button, link or editable field. \\[advertised-widget-backward]
+\\<custom-field-keymap>\
Complete content of editable text field. \\[widget-complete]
\\<custom-mode-map>\
-Invoke button under the mouse pointer. \\[Custom-move-and-invoke]
-Invoke button under point. \\[widget-button-press]
-Set all modifications. \\[Custom-set]
-Make all modifications default. \\[Custom-save]
-Reset all modified options. \\[Custom-reset-current]
-Reset all modified or set options. \\[Custom-reset-saved]
-Reset all options. \\[Custom-reset-standard]
+Invoke button under the mouse pointer. \\[widget-button-click]
+Invoke button under point. \\[widget-button-press]
+Set all options from current text. \\[Custom-set]
+Make values in current text permanent. \\[Custom-save]
+Make text match actual option values. \\[Custom-reset-current]
+Reset options to permanent settings. \\[Custom-reset-saved]
+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'
if that value is non-nil."
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(make-local-variable 'widget-documentation-face)
- (setq widget-documentation-face 'custom-documentation-face)
+ (setq widget-documentation-face 'custom-documentation)
(make-local-variable 'widget-button-face)
- (setq widget-button-face 'custom-button-face)
- (set (make-local-variable 'widget-button-pressed-face)
- 'custom-button-pressed-face)
- (set (make-local-variable 'widget-mouse-face)
- 'custom-button-pressed-face) ; buttons `depress' when moused
+ (setq widget-button-face custom-button)
+ (set (make-local-variable 'widget-button-pressed-face) custom-button-pressed)
+ (set (make-local-variable 'widget-mouse-face) custom-button-mouse)
+
;; When possible, use relief for buttons, not bracketing. This test
;; may not be optimal.
(when custom-raised-buttons
(set (make-local-variable 'widget-link-prefix) "")
(set (make-local-variable 'widget-link-suffix) ""))
(add-hook 'widget-edit-functions 'custom-state-buffer-message nil t)
- (run-hooks 'custom-mode-hook))
+ (run-mode-hooks 'custom-mode-hook))
(put 'custom-mode 'mode-class 'special)