;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
;;
-;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
("-function\\'" function)
("-functions\\'" (repeat function))
("-list\\'" (repeat sexp))
- ("-alist\\'" (repeat (cons sexp sexp))))
+ ("-alist\\'" (alist :key-type sexp :value-type sexp)))
"Alist of (MATCH TYPE).
MATCH should be a regexp matching the name of a symbol, and TYPE should
(message "Aborted")
nil))
-(defun Custom-set (&rest ignore)
+(defun Custom-set (&rest _ignore)
"Set the current value of all edited settings in the buffer."
(interactive)
(custom-command-apply
(widget-apply child :custom-set)))
"Set all values according to this buffer? "))
-(defun Custom-save (&rest ignore)
+(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."
(dolist (child custom-options)
(widget-apply child :custom-state-set-and-redraw))))
-(defun custom-reset (widget &optional event)
+(defun custom-reset (_widget &optional event)
"Select item from reset menu."
(let* ((completion-ignore-case t)
(answer (widget-choose "Reset settings"
(if answer
(funcall answer))))
-(defun Custom-reset-current (&rest ignore)
+(defun Custom-reset-current (&rest _ignore)
"Reset all edited settings in the buffer to show their current values."
(interactive)
(custom-command-apply
(widget-apply widget :custom-reset-current)))
"Reset all settings' buffer text to show current values? "))
-(defun Custom-reset-saved (&rest ignore)
+(defun Custom-reset-saved (&rest _ignore)
"Reset all edited or set settings in the buffer to their saved value.
This also shows the saved values in the buffer."
(interactive)
(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-face-state-set widget)
(custom-redraw-magic widget))))))
-(defun Custom-reset-standard (&rest ignore)
+(defun Custom-reset-standard (&rest _ignore)
"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,
If the variable has a `custom-type' property, it must be a widget and the
`:prompt-value' property of that widget will be used for reading the value.
+If the variable also has a `custom-get' property, that is used for finding
+the current value of the variable, otherwise `symbol-value' is used.
If optional COMMENT argument is non-nil, also prompt for a comment and return
it as the third element in the list."
(widget-prompt-value type
prompt
(if (boundp var)
- (symbol-value var))
+ (funcall
+ (or (get var 'custom-get) 'symbol-value)
+ var))
(not (boundp var))))
(t
(eval-minibuffer prompt))))))
(put variable 'saved-variable-comment comment)))
(put variable 'customized-value nil)
(put variable 'customized-variable-comment nil)
- (custom-save-all)
+ (if (custom-file t)
+ (custom-save-all)
+ (message "Setting `%s' temporarily since \"emacs -q\" would overwrite customizations"
+ variable)
+ (set variable value))
value)
+;; Some parts of Emacs might prompt the user to save customizations,
+;; during startup before customizations are loaded. This function
+;; handles this corner case by avoiding calling `custom-save-variable'
+;; too early, which could wipe out existing customizations.
+
+;;;###autoload
+(defun customize-push-and-save (list-var elts)
+ "Add ELTS to LIST-VAR and save for future sessions, safely.
+ELTS should be a list. This function adds each entry to the
+value of LIST-VAR using `add-to-list'.
+
+If Emacs is initialized, call `customize-save-variable' to save
+the resulting list value now. Otherwise, add an entry to
+`after-init-hook' to save it after initialization."
+ (dolist (entry elts)
+ (add-to-list list-var entry))
+ (if after-init-time
+ (let ((coding-system-for-read nil))
+ (customize-save-variable list-var (eval list-var)))
+ (add-hook 'after-init-hook
+ `(lambda ()
+ (customize-push-and-save ',list-var ',elts)))))
+
;;;###autoload
(defun customize ()
"Select a customization buffer which you can use to set user options.
(interactive (list (apropos-read-pattern "symbol") current-prefix-arg))
(require 'apropos)
(apropos-parse-pattern pattern)
- (let (found tests)
+ (let (found)
(mapatoms
`(lambda (symbol)
(when (string-match apropos-regexp (symbol-name symbol))
:type 'boolean
:group 'custom-buffer)
-(defun Custom-buffer-done (&rest ignore)
+(defun Custom-buffer-done (&rest _ignore)
"Exit current Custom buffer according to `custom-buffer-done-kill'."
(interactive)
(quit-window custom-buffer-done-kill))
'custom-button-pressed
'custom-button-pressed-unraised))))
-(defun custom-buffer-create-internal (options &optional description)
+(defun custom-buffer-create-internal (options &optional _description)
(Custom-mode)
(let ((init-file (or custom-file user-init-file)))
;; Insert verbose help at the top of the custom buffer.
'editable-field
:size 40 :help-echo echo
:action `(lambda (widget &optional event)
- (customize-apropos (widget-value widget))))))
+ (customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button
:tag " Search "
:help-echo echo :action
- (lambda (widget &optional event)
+ (lambda (widget &optional _event)
(customize-apropos (widget-value (widget-get widget :parent)))))
(widget-insert "\n")))
(if custom-buffer-verbose-help
(widget-insert "
Operate on all settings in this buffer:\n"))
- (let ((button (lambda (tag action active help icon label)
+ (let ((button (lambda (tag action active help _icon _label)
(widget-insert " ")
(if (eval active)
(widget-create 'push-button :tag tag
:format "%[[%t]%]"
:action 'custom-browse-visibility-action)
-(defun custom-browse-visibility-action (widget &rest ignore)
+(defun custom-browse-visibility-action (widget &rest _ignore)
(let ((custom-buffer-style 'tree))
(custom-toggle-parent widget)))
:tag-glyph "folder"
:action 'custom-browse-group-tag-action)
-(defun custom-browse-group-tag-action (widget &rest ignore)
+(defun custom-browse-group-tag-action (widget &rest _ignore)
(let ((parent (widget-get widget :parent)))
(customize-group-other-window (widget-value parent))))
:tag-glyph "option"
:action 'custom-browse-variable-tag-action)
-(defun custom-browse-variable-tag-action (widget &rest ignore)
+(defun custom-browse-variable-tag-action (widget &rest _ignore)
(let ((parent (widget-get widget :parent)))
(customize-variable-other-window (widget-value parent))))
:tag-glyph "face"
:action 'custom-browse-face-tag-action)
-(defun custom-browse-face-tag-action (widget &rest ignore)
+(defun custom-browse-face-tag-action (widget &rest _ignore)
(let ((parent (widget-get widget :parent)))
(customize-face-other-window (widget-value parent))))
;; We want simple widgets to be displayed by default, but complex
;; widgets to be hidden.
+;; This widget type is obsolete as of Emacs 24.1.
(widget-put (get 'item 'widget-type) :custom-show t)
(widget-put (get 'editable-field 'widget-type)
- :custom-show (lambda (widget value)
+ :custom-show (lambda (_widget value)
(let ((pp (pp-to-string value)))
(cond ((string-match "\n" pp)
nil)
:value-create 'custom-magic-value-create
:value-delete 'widget-children-value-delete)
-(defun widget-magic-mouse-down-action (widget &optional event)
+(defun widget-magic-mouse-down-action (widget &optional _event)
;; Non-nil unless hidden.
(not (eq (widget-get (widget-get (widget-get widget :parent) :parent)
:custom-state)
(defun custom-magic-reset (widget)
"Redraw the :custom-magic property of WIDGET."
(let ((magic (widget-get widget :custom-magic)))
- (widget-value-set magic (widget-value magic))))
+ (when magic
+ (widget-value-set magic (widget-value magic)))))
;;; The `custom' Widget.
:value-delete 'widget-children-value-delete
:value-get 'widget-value-value-get
:validate 'widget-children-validate
- :match (lambda (widget value) (symbolp value)))
+ :match (lambda (_widget value) (symbolp value)))
(defun custom-convert-widget (widget)
"Initialize :value and :tag from :args in WIDGET."
(setq widget nil)))))
(widget-setup))
+(make-obsolete 'custom-show "this widget type is no longer supported." "24.1")
(defun custom-show (widget value)
"Non-nil if WIDGET should be shown with VALUE by default."
(let ((show (widget-get widget :custom-show)))
(custom-redraw widget)
(widget-setup)))
-(defun custom-toggle-parent (widget &rest ignore)
+(defun custom-toggle-parent (widget &rest _ignore)
"Toggle visibility of parent of WIDGET."
(custom-toggle-hide (widget-get widget :parent)))
(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:\"."
:shown-value, if non-nil, should be a list whose `car' is the
variable value to display in place of the current value.
-:inhibit-magic, if non-nil, inhibits creating the magic
- custom-state widget."
+:custom-style describes the widget interface style; nil is the
+ default style, while `simple' means a simpler interface that
+ inhibits the magic custom-state widget."
:format "%v"
:help-echo "Set or reset this variable."
:documentation-property #'custom-variable-documentation
(get (or (get symbol 'custom-get) 'default-value))
(prefix (widget-get widget :custom-prefix))
(last (widget-get widget :custom-last))
+ (style (widget-get widget :custom-style))
(value (let ((shown-value (widget-get widget :shown-value)))
(cond (shown-value
(car shown-value))
(push (widget-create-child-and-convert
widget 'custom-visibility
:help-echo "Show the value of this option."
- :on-image "down"
+ :on-glyph "down"
:on "Hide"
- :off-image "right"
+ :off-glyph "right"
:off "Show Value"
- :action 'custom-toggle-parent
+ :action 'custom-toggle-hide-variable
nil)
buttons)
(insert " ")
:help-echo "Hide the value of this option."
:on "Hide"
:off "Show"
- :on-image "down"
- :off-image "right"
- :action 'custom-toggle-parent
+ :on-glyph "down"
+ :off-glyph "right"
+ :action 'custom-toggle-hide-variable
t)
buttons)
(insert " ")
:help-echo "Hide or show this option."
:on "Hide"
:off "Show"
- :on-image "down"
- :off-image "right"
- :action 'custom-toggle-parent
+ :on-glyph "down"
+ :off-glyph "right"
+ :action 'custom-toggle-hide-variable
t)
buttons)
(insert " ")
(unless (eq (preceding-char) ?\n)
(widget-insert "\n"))
;; Create the magic button.
- (unless (widget-get widget :inhibit-magic)
+ (unless (eq style 'simple)
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
(widget-put widget :custom-magic magic)
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-put widget :documentation-indent 3)
- (widget-add-documentation-string-button
- widget :visibility-widget 'custom-visibility)
+ (unless (and (eq style 'simple)
+ (eq state 'hidden))
+ (widget-add-documentation-string-button
+ widget :visibility-widget 'custom-visibility))
;; The comment field
(unless (eq state 'hidden)
(custom-add-parent-links widget))
(custom-add-see-also widget)))))
+(defun custom-toggle-hide-variable (visibility-widget &rest _ignore)
+ "Toggle the visibility of a `custom-variable' parent widget.
+By default, this signals an error if the parent has unsaved
+changes. If the parent has a `simple' :custom-style property,
+the present value is saved to its :shown-value property instead."
+ (let ((widget (widget-get visibility-widget :parent)))
+ (unless (eq (widget-type widget) 'custom-variable)
+ (error "Invalid widget type"))
+ (custom-load-widget widget)
+ (let ((state (widget-get widget :custom-state)))
+ (if (eq state 'hidden)
+ (widget-put widget :custom-state 'unknown)
+ ;; In normal interface, widget can't be hidden if modified.
+ (when (memq state '(invalid modified set))
+ (if (eq (widget-get widget :custom-style) 'simple)
+ (widget-put widget :shown-value
+ (list (widget-value
+ (car-safe
+ (widget-get widget :children)))))
+ (error "There are unsaved changes")))
+ (widget-put widget :documentation-shown nil)
+ (widget-put widget :custom-state 'hidden))
+ (custom-redraw widget)
+ (widget-setup))))
+
(defun custom-tag-action (widget &rest args)
"Pass :action to first child of WIDGET's parent."
(apply 'widget-apply (car (widget-get (widget-get widget :parent) :children))
:pressed-face 'custom-visibility
:mouse-face 'highlight
:pressed-face 'highlight
- :on-image nil
- :off-image nil)
+ :on-glyph nil
+ :off-glyph nil)
(defface custom-visibility
'((t :height 0.8 :inherit link))
:pressed-face 'custom-visibility
:mouse-face 'highlight
:on "Hide Unused Attributes" :off "Show All Attributes"
- :on-image nil :off-image nil
+ :on-glyph nil :off-glyph nil
:always-active t
:action 'custom-face-edit-value-visibility-action
show-all)
(widget-put widget :buttons buttons)
(widget-put widget :children (nreverse (widget-get widget :children)))))
-(defun custom-face-edit-value-visibility-action (widget &rest ignore)
+(defun custom-face-edit-value-visibility-action (widget &rest _ignore)
;; Toggle hiding of face attributes.
(let ((parent (widget-get widget :parent)))
(widget-put parent :show-all-attributes
(not (widget-get parent :show-all-attributes)))
(custom-redraw parent)))
-(defun custom-face-edit-fix-value (widget value)
+(defun custom-face-edit-fix-value (_widget value)
"Ignoring WIDGET, convert :bold and :italic in VALUE to new form.
Also change :reverse-video to :inverse-video."
(custom-fix-face-spec value))
Lisp sexp), or `mismatch' (should not happen); if nil, use
the return value of `custom-face-default-form'.
-:display-style, if non-nil, describes the style of display to
- use. If the value is `concise', a neater interface is shown.
+:custom-style describes the widget interface style; nil is the
+ default style, while `simple' means a simpler interface that
+ inhibits the magic custom-state widget.
:sample-indent, if non-nil, is the number of columns to which to
indent the face sample (an integer).
:shown-value, if non-nil, is the face spec to display as the value
- of the widget, instead of the current face spec.
-
-:inhibit-magic, if non-nil, inhibits creating the magic
- custom-state widget."
+ of the widget, instead of the current face spec."
:sample-face 'custom-face-tag
:help-echo "Set or reset this face."
:documentation-property #'face-doc-string
(setq spec `((t ,(face-attr-construct face (selected-frame))))))
(custom-pre-filter-face-spec spec)))
+(defun custom-toggle-hide-face (visibility-widget &rest _ignore)
+ "Toggle the visibility of a `custom-face' parent widget.
+By default, this signals an error if the parent has unsaved
+changes. If the parent has a `simple' :custom-style property,
+the present value is saved to its :shown-value property instead."
+ (let ((widget (widget-get visibility-widget :parent)))
+ (unless (eq (widget-type widget) 'custom-face)
+ (error "Invalid widget type"))
+ (custom-load-widget widget)
+ (let ((state (widget-get widget :custom-state)))
+ (if (eq state 'hidden)
+ (widget-put widget :custom-state 'unknown)
+ ;; In normal interface, widget can't be hidden if modified.
+ (when (memq state '(invalid modified set))
+ (if (eq (widget-get widget :custom-style) 'simple)
+ (widget-put widget :shown-value
+ (custom-face-widget-to-spec widget))
+ (error "There are unsaved changes")))
+ (widget-put widget :documentation-shown nil)
+ (widget-put widget :custom-state 'hidden))
+ (custom-redraw widget)
+ (widget-setup))))
+
(defun custom-face-value-create (widget)
"Create a list of the display specifications for WIDGET."
(let* ((buttons (widget-get widget :buttons))
(tag (or (widget-get widget :tag)
(prin1-to-string symbol)))
(hiddenp (eq (widget-get widget :custom-state) 'hidden))
- (style (widget-get widget :display-style))
+ (style (widget-get widget :custom-style))
children)
(if (eq custom-buffer-style 'tree)
widget 'custom-visibility
:help-echo "Hide or show this face."
:on "Hide" :off "Show"
- :on-image "down" :off-image "right"
- :action 'custom-toggle-parent
+ :on-glyph "down" :off-glyph "right"
+ :action 'custom-toggle-hide-face
(not hiddenp))
buttons)
;; Face name (tag).
(insert "\n")
;; Magic.
- (unless (widget-get widget :inhibit-magic)
+ (unless (eq (widget-get widget :custom-style) 'simple)
(let ((magic (widget-create-child-and-convert
widget 'custom-magic nil)))
(widget-put widget :custom-magic magic)
(widget-put widget :buttons buttons)
;; Insert documentation.
- (unless (and hiddenp (eq style 'concise))
+ (unless (and hiddenp (eq style 'simple))
(widget-put widget :documentation-indent 3)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
: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))
+ :match (lambda (_widget value) (facep value))
+ :completions (apply-partially #'completion-table-with-predicate
+ obarray #'facep 'strict)
:prompt-match 'facep
:prompt-history 'widget-face-prompt-value-history
:validate (lambda (widget)
(define-widget 'hook 'list
"An Emacs Lisp hook."
- :value-to-internal (lambda (widget value)
+ :value-to-internal (lambda (_widget value)
(if (and value (symbolp value))
(list value)
value))
:follow-link 'mouse-face
:action 'custom-group-link-action)
-(defun custom-group-link-action (widget &rest ignore)
+(defun custom-group-link-action (widget &rest _ignore)
(customize-group (widget-value widget)))
;;; The `custom-group' Widget.
(widget-insert "\n")
(progress-reporter-update reporter (setq count (1+ count)))
(let ((sym (nth 0 entry))
- (type (nth 1 entry))
- hidden-p)
+ (type (nth 1 entry)))
(prog1
(widget-create-child-and-convert
widget type
if only the first line of the docstring is shown."))
:group 'customize)
-(defun custom-file ()
+(defun custom-file (&optional no-error)
"Return the file name for saving customizations."
- (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))))
+ (let ((file
+ (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.
+ (if no-error
+ nil
+ (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (setq user-init-file default-init-file)))
+ user-init-file))))
+ (and file
+ (file-chase-links file))))
;; If recentf-mode is non-nil, this is defined.
(declare-function recentf-expand-file-name "recentf" (name))
(unless (eq major-mode 'emacs-lisp-mode)
(emacs-lisp-mode))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (print-length nil)
+ (print-level nil))
(custom-save-variables)
(custom-save-faces))
(let ((file-precious-flag t))
(setq pos (line-beginning-position))))
(goto-char pos)))))
+(defvar sort-fold-case) ; defined in sort.el
+
(defun custom-save-variables ()
"Save all customized variables in `custom-file'."
(save-excursion
:type 'integer
:group 'custom-menu)
-(defun custom-face-menu-create (widget symbol)
+(defun custom-face-menu-create (_widget symbol)
"Ignoring WIDGET, create a menu entry for customization face SYMBOL."
(vector (custom-unlispify-menu-entry symbol)
`(customize-face ',symbol)
t))
-(defun custom-variable-menu-create (widget symbol)
+(defun custom-variable-menu-create (_widget symbol)
"Ignoring WIDGET, create a menu entry for customization variable SYMBOL."
(let ((type (get symbol 'custom-type)))
(unless (listp type)
;; Add checkboxes to boolean variable entries.
(widget-put (get 'boolean 'widget-type)
- :custom-menu (lambda (widget symbol)
+ :custom-menu (lambda (_widget symbol)
(vector (custom-unlispify-menu-entry symbol)
`(customize-variable ',symbol)
':style 'toggle
':selected symbol)))
-(defun custom-group-menu-create (widget symbol)
+(defun custom-group-menu-create (_widget symbol)
"Ignoring WIDGET, create a menu entry for customization group SYMBOL."
`( ,(custom-unlispify-menu-entry symbol t)
:filter (lambda (&rest junk)
;;; The Custom Mode.
-(defun Custom-no-edit (pos &optional event)
+(defun Custom-no-edit (_pos &optional _event)
"Invoke button at POS, or refuse to allow editing of Custom buffer."
(interactive "@d")
(error "You can't edit this part of the Custom buffer"))
"Invoke button at POS, or refuse to allow editing of Custom buffer."
(interactive "@d")
(let ((button (get-char-property pos 'button)))
+ ;; If there is no button at point, then use the one at the start
+ ;; of the line, if it is a custom-group-link (bug#2298).
+ (or button
+ (if (setq button (get-char-property (line-beginning-position) 'button))
+ (or (eq (widget-type button) 'custom-group-link)
+ (setq button nil))))
(if button
(widget-apply-action button event)
(error "You can't edit this part of the Custom buffer"))))
(provide 'cus-edit)
-;; arch-tag: 64533aa4-1b1a-48c3-8812-f9dc718e8a6f
;;; cus-edit.el ends here