;;; 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
(set-keymap-parent map widget-keymap)
(define-key map [remap self-insert-command] 'Custom-no-edit)
(define-key map "\^m" 'Custom-newline)
- (define-key map " " 'scroll-up)
- (define-key map "\177" 'scroll-down)
+ (define-key map " " 'scroll-up-command)
+ (define-key map "\177" 'scroll-down-command)
(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)
("-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
(const :tag "none" nil))
:group 'custom-menu)
-;;;###autoload (add-hook 'same-window-regexps (purecopy "\\`\\*Customiz.*\\*\\'"))
-
(defun custom-sort-items (items sort-alphabetically order-groups)
"Return a sorted copy of ITEMS.
ITEMS should be a `custom-group' property.
(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.
t)))
;;;###autoload
-(defun customize-group (&optional group)
- "Customize GROUP, which must be a customization group."
+(defun customize-group (&optional group other-window)
+ "Customize GROUP, which must be a customization group.
+If OTHER-WINDOW is non-nil, display in another window."
(interactive (list (customize-read-group)))
(when (stringp group)
(if (string-equal "" group)
(setq group (intern group))))
(let ((name (format "*Customize Group: %s*"
(custom-unlispify-tag-name group))))
- (if (get-buffer name)
- (pop-to-buffer name)
- (custom-buffer-create
- (list (list group 'custom-group))
- name
- (concat " for group "
- (custom-unlispify-tag-name group))))))
+ (cond
+ ((null (get-buffer name))
+ (funcall (if other-window
+ 'custom-buffer-create-other-window
+ 'custom-buffer-create)
+ (list (list group 'custom-group))
+ name
+ (concat " for group "
+ (custom-unlispify-tag-name group))))
+ (other-window
+ (switch-to-buffer-other-window name))
+ (t
+ (pop-to-buffer-same-window name)))))
;;;###autoload
(defun customize-group-other-window (&optional group)
"Customize GROUP, which must be a customization group, in another window."
(interactive (list (customize-read-group)))
- (let ((pop-up-windows t)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (customize-group group)))
+ (customize-group group t))
;;;###autoload
(defalias 'customize-variable 'customize-option)
(< minor1 minor2)))))
;;;###autoload
-(defun customize-face (&optional face)
+(defun customize-face (&optional face other-window)
"Customize FACE, which should be a face name or nil.
If FACE is nil, customize all faces. If FACE is actually a
face-alias, customize the face it is aliased to.
+If OTHER-WINDOW is non-nil, display in another window.
+
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
(interactive (list (read-face-name "Customize face" "all faces" t)))
(setq face (face-list)))
(if (and (listp face) (null (cdr face)))
(setq face (car face)))
- (if (listp face)
- (custom-buffer-create
- (custom-sort-items
- (mapcar (lambda (s) (list s 'custom-face)) 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))
- (format "*Customize Face: %s*"
- (custom-unlispify-tag-name face)))))
+ (let ((display-fun (if other-window
+ 'custom-buffer-create-other-window
+ 'custom-buffer-create)))
+ (if (listp face)
+ (funcall display-fun
+ (custom-sort-items
+ (mapcar (lambda (s) (list s 'custom-face)) 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))
+ (funcall display-fun
+ (list (list face 'custom-face))
+ (format "*Customize Face: %s*"
+ (custom-unlispify-tag-name face))))))
;;;###autoload
(defun customize-face-other-window (&optional face)
Interactively, when point is on text which has a face specified,
suggest to customize that face, if it's customizable."
(interactive (list (read-face-name "Customize face" "all faces" t)))
- (let ((pop-up-windows t)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (customize-face face)))
+ (customize-face face t))
(defalias 'customize-customized 'customize-unsaved)
(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))
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
- (pop-to-buffer (custom-get-fresh-buffer (or name "*Customization*")))
+ (pop-to-buffer-same-window (custom-get-fresh-buffer (or name "*Customization*")))
(custom-buffer-create-internal options description))
;;;###autoload
SYMBOL is a customization option, and WIDGET is a widget for editing
that option."
(unless name (setq name "*Customization*"))
- (let ((pop-up-windows t)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (pop-to-buffer (custom-get-fresh-buffer name))
- (custom-buffer-create-internal options description)))
+ (switch-to-buffer-other-window (custom-get-fresh-buffer name))
+ (custom-buffer-create-internal options description))
(defcustom custom-reset-button-menu nil
"If non-nil, only show a single reset button in customize buffers.
: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
(unless group
(setq group 'emacs))
(let ((name "*Customize Browser*"))
- (pop-to-buffer (custom-get-fresh-buffer name)))
+ (pop-to-buffer-same-window (custom-get-fresh-buffer name)))
(Custom-mode)
(widget-insert (format "\
%s buttons; type RET or click mouse-1
: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)
: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:\"."
(custom-add-parent-links widget))
(custom-add-see-also widget)))))
-(defun custom-toggle-hide-variable (visibility-widget &rest ignore)
+(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,
(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))
(setq spec `((t ,(face-attr-construct face (selected-frame))))))
(custom-pre-filter-face-spec spec)))
-(defun custom-toggle-hide-face (visibility-widget &rest ignore)
+(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,
: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))))
+ (if (null user-init-file)
+ ;; Started with -q, i.e. the file containing Custom settings
+ ;; hasn't been read. Saving settings there won't make much
+ ;; sense.
+ (if no-error
+ nil
+ (error "Saving settings from \"emacs -q\" would overwrite existing customizations"))
+ (file-chase-links (or custom-file user-init-file))))
;; If recentf-mode is non-nil, this is defined.
(declare-function recentf-expand-file-name "recentf" (name))
(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