-;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
+;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2016 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
:group 'emacs)
(defgroup help nil
- "Support for on-line help systems."
+ "Support for Emacs help systems."
:group 'emacs)
(defgroup multimedia nil
(define-key map [remap self-insert-command] 'Custom-no-edit)
(define-key map "\^m" 'Custom-newline)
(define-key map " " 'scroll-up-command)
+ (define-key map [?\S-\ ] 'scroll-down-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)
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
You can get the original back from the result with:
- (mapconcat 'identity result \"\\|\")
+ (mapconcat \\='identity result \"\\|\")
IF REGEXP is not a string, return it unchanged."
(if (stringp regexp)
(setq prefixes nil)
(delete-region (point-min) (point)))
(setq prefixes (cdr prefixes))))))
- (subst-char-in-region (point-min) (point-max) ?- ?\ t)
+ (subst-char-in-region (point-min) (point-max) ?- ?\s t)
(capitalize-region (point-min) (point-max))
(unless no-suffix
(goto-char (point-max))
(while names
(setq current (car names)
names (cdr names))
- (when (string-match (nth 0 current) name)
+ (when (string-match-p (nth 0 current) name)
(setq found (nth 1 current)
names nil)))
(unless found
- (let ((doc (documentation-property symbol 'variable-documentation))
+ (let ((doc (documentation-property symbol 'variable-documentation t))
(docs custom-guess-doc-alist))
(when doc
(while docs
(setq current (car docs)
docs (cdr docs))
- (when (string-match (nth 0 current) doc)
+ (when (string-match-p (nth 0 current) doc)
(setq found (nth 1 current)
docs nil))))))
found))
(defun custom-sort-items (items sort-alphabetically order-groups)
"Return a sorted copy of ITEMS.
-ITEMS should be a `custom-group' property.
+ITEMS should be a list of `custom-group' properties.
If SORT-ALPHABETICALLY non-nil, sort alphabetically.
If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
groups after non-groups, if nil do not order groups at all."
(defvar custom-commands
'((" Apply " Custom-set t
- "Apply settings (for the current session only)"
+ "Apply settings (for the current session only)."
"index"
"Apply")
(" Apply and Save " Custom-save
"Call function FUN on all widgets in `custom-options'.
If there is more than one widget, ask user for confirmation using
the query string QUERY, using `y-or-n-p' if STRONG-QUERY is nil,
-and `yes-or-no-p' otherwise."
+and `yes-or-no-p' otherwise. Return non-nil if the functionality
+has been executed, nil otherwise."
(if (or (and (= 1 (length custom-options))
(memq (widget-type (car custom-options))
'(custom-variable custom-face)))
;; Bind these temporarily.
(let ((custom-reset-standard-variables-list '(t))
(custom-reset-standard-faces-list '(t)))
- (custom-command-apply
- (lambda (widget)
- (and (or (null (widget-get widget :custom-standard-value))
- (widget-apply widget :custom-standard-value))
- (memq (widget-get widget :custom-state)
- '(modified set changed saved rogue))
- (widget-apply widget :custom-mark-to-reset-standard)))
- "The settings will revert to their default values, in this
+ (if (custom-command-apply
+ (lambda (widget)
+ (and (or (null (widget-get widget :custom-standard-value))
+ (widget-apply widget :custom-standard-value))
+ (memq (widget-get widget :custom-state)
+ '(modified set changed saved rogue))
+ (widget-apply widget :custom-mark-to-reset-standard)))
+ "The settings will revert to their default values, in this
and future sessions. Really erase customizations? " t)
- (custom-reset-standard-save-and-update)))
+ (custom-reset-standard-save-and-update))))
;;; The Customize Commands
(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)))))
+ (lambda ()
+ (customize-push-and-save list-var elts)))))
;;;###autoload
(defun customize ()
For example, the MH-E package updates this alist as follows:
- (add-to-list 'customize-package-emacs-version-alist
- '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
+ (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\")))
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)))
+ (interactive (list (read-face-name "Customize face"
+ (or (face-at-point t t) "all faces") t)))
(if (member face '(nil ""))
(setq face (face-list)))
(if (and (listp face) (null (cdr 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)))
+ (interactive (list (read-face-name "Customize face"
+ (or (face-at-point t t) "all faces") t)))
(customize-face face t))
-(defalias 'customize-customized 'customize-unsaved)
-
-;;;###autoload
-(defun customize-unsaved ()
- "Customize all options and faces set in this session but not saved."
- (interactive)
+(defun custom-unsaved-options ()
+ "List of options and faces set in this session but not saved.
+Each entry is of the form (SYMBOL TYPE), where TYPE is one of the
+symbols `custom-face' or `custom-variable'."
(let ((found nil))
(mapatoms (lambda (symbol)
(and (or (get symbol 'customized-face)
(get symbol 'customized-variable-comment))
(boundp symbol)
(push (list symbol 'custom-variable) found))))
+ found))
+
+(defalias 'customize-customized 'customize-unsaved)
+
+;;;###autoload
+(defun customize-unsaved ()
+ "Customize all options and faces set in this session but not saved."
+ (interactive)
+ (let ((found (custom-unsaved-options)))
(if (not found)
(error "No user options are set but unsaved")
(custom-buffer-create (custom-sort-items found t nil)
"*Customize Saved*"))))
(declare-function apropos-parse-pattern "apropos" (pattern))
+(defvar apropos-regexp)
;;;###autoload
(defun customize-apropos (pattern &optional type)
"Customize loaded options, faces and groups matching PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
-search for matches for that word as a substring. If it is a list of words,
-search for matches for any two (or more) of those words.
+search for matches for that word as a substring. If it is a list of
+words, search for matches for any two (or more) of those words.
If TYPE is `options', include only options.
If TYPE is `faces', include only faces.
(require 'apropos)
(unless (memq type '(nil options faces groups))
(error "Invalid setting type %s" (symbol-name type)))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck!
(let (found)
(mapatoms
- `(lambda (symbol)
- (when (string-match apropos-regexp (symbol-name symbol))
- ,(if (memq type '(nil groups))
- '(if (get symbol 'custom-group)
- (push (list symbol 'custom-group) found)))
- ,(if (memq type '(nil faces))
- '(if (custom-facep symbol)
- (push (list symbol 'custom-face) found)))
- ,(if (memq type '(nil options))
- `(if (and (boundp symbol)
- (eq (indirect-variable symbol) symbol)
- (or (get symbol 'saved-value)
- (custom-variable-p symbol)))
- (push (list symbol 'custom-variable) found))))))
+ (lambda (symbol)
+ (when (string-match-p apropos-regexp (symbol-name symbol))
+ (if (memq type '(nil groups))
+ (if (get symbol 'custom-group)
+ (push (list symbol 'custom-group) found)))
+ (if (memq type '(nil faces))
+ (if (custom-facep symbol)
+ (push (list symbol 'custom-face) found)))
+ (if (memq type '(nil options))
+ (if (and (boundp symbol)
+ (eq (indirect-variable symbol) symbol)
+ (or (get symbol 'saved-value)
+ (custom-variable-p symbol)))
+ (push (list symbol 'custom-variable) found))))))
(unless found
- (error "No customizable %s matching %s" (symbol-name type) pattern))
+ (error "No customizable %s matching %s" (if (not type)
+ "group, face, or option"
+ (symbol-name type))
+ pattern))
(custom-buffer-create
(custom-sort-items found t custom-buffer-order-groups)
"*Customize Apropos*")))
(interactive (list (apropos-read-pattern "groups")))
(customize-apropos regexp 'groups))
+;;;###autoload
+(defun custom-prompt-customize-unsaved-options ()
+ "Prompt user to customize any unsaved customization options.
+Return non-nil if user chooses to customize, for use in
+`kill-emacs-query-functions'."
+ (not (and (custom-unsaved-options)
+ (yes-or-no-p "Some customized options have not been saved; Examine? ")
+ (customize-unsaved)
+ t)))
+
;;; Buffer.
(defcustom custom-buffer-style 'links
"Control the presentation style for customization buffers.
The value should be a symbol, one of:
-
-brackets: groups nest within each other with big horizontal brackets.
-links: groups have links to subgroups."
+`brackets': groups nest within each other with big horizontal brackets.
+`links': groups have links to subgroups.
+`tree': display groups as trees."
:type '(radio (const brackets)
- (const links))
+ (const links)
+ (const tree))
:group 'custom-buffer)
(defcustom custom-buffer-done-kill nil
Optional NAME is the name of the buffer.
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."
+that option.
+DESCRIPTION is unused."
(pop-to-buffer-same-window (custom-get-fresh-buffer (or name "*Customization*")))
(custom-buffer-create-internal options description))
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
- "If non-nil, indicate active buttons in a `raised-button' style.
+ "If non-nil, indicate active buttons in a raised-button style.
Otherwise use brackets."
:type 'boolean
:version "21.1"
(widget-create
'editable-field
:size 40 :help-echo echo
- :action `(lambda (widget &optional event)
- (customize-apropos (split-string (widget-value widget)))))))
+ :action (lambda (widget &optional _event)
+ (customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button
(mapcar (lambda (entry)
(prog2
(message "Creating customization items ...%2d%%"
- (/ (* 100.0 count) length))
+ (floor (* 100.0 count) length))
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(nth 0 entry))
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"
+ "Raised text indicates"
"Square brackets indicate")))
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
(let ((pp (pp-to-string value)))
- (cond ((string-match "\n" pp)
+ (cond ((string-match-p "\n" pp)
nil)
((> (length pp) 40)
nil)
something in this group has been set and saved.")
(themed "o" custom-themed "\
THEMED." "\
-visible group members are all at standard values.")
+visible group members are set by enabled themes.")
(rogue "@" custom-rogue "\
NO CUSTOMIZATION DATA; not intended to be customized." "\
something in this group is not prepared for customization.")
STATE is one of the following symbols:
-`nil'
+nil
For internal use, should never occur.
`unknown'
For internal use, should never occur.
This item is marked for saving.
`rogue'
This item has no customization information.
+`themed'
+ This item was set by an enabled Custom theme.
`standard'
This item is unchanged from the standard setting.
left out, ITEM-DESC will be used.
The string %c in either description will be replaced with the
-category of the item. These are `group'. `option', and `face'.
+category of the item. These are `group', `option', and `face'.
The list should be sorted most significant first.")
(when (and (eq category 'group)
(not (and (eq custom-buffer-style 'links)
(> (widget-get parent :custom-level) 1))))
- (insert-char ?\ (* custom-buffer-indent
+ (insert-char ?\s (* custom-buffer-indent
(widget-get parent :custom-level))))
(push (widget-create-child-and-convert
widget 'choice-item
(when (and (eq category 'group)
(not (and (eq custom-buffer-style 'links)
(> (widget-get parent :custom-level) 1))))
- (insert-char ?\ (* custom-buffer-indent
+ (insert-char ?\s (* custom-buffer-indent
(widget-get parent :custom-level))))
(when custom-magic-show-button
(when custom-magic-show
(indent (widget-get widget :indent)))
(when links
(when indent
- (insert-char ?\ indent))
+ (insert-char ?\s indent))
(when prefix
(insert prefix))
(insert "See also ")
"Return documentation of VARIABLE for use in Custom buffer.
Normally just return the docstring. But if VARIABLE automatically
becomes buffer local when set, append a message to that effect."
- (format "%s%s" (documentation-property variable 'variable-documentation)
+ (format "%s%s" (documentation-property variable 'variable-documentation t)
(if (and (local-variable-if-set-p variable)
(or (not (local-variable-p variable))
(with-temp-buffer
widget
(widget-get widget :default-face-attributes)))
entry)
- (unless (looking-back "^ *")
+ (unless (looking-back "^ *" (line-beginning-position))
(insert ?\n))
(insert-char ?\s (widget-get widget :extra-offset))
(if (or alist defaults show-all)
pm)
(const :format "W32 "
:sibling-args (:help-echo "\
-Windows NT/9X.")
+MS Windows.")
w32)
(const :format "NS "
:sibling-args (:help-echo "\
"Converted version of the `custom-face-all' widget.")
(defun custom-filter-face-spec (spec filter-index &optional default-filter)
- "Return a canonicalized version of SPEC using.
+ "Return a canonicalized version of SPEC.
FILTER-INDEX is the index in the entry for each attribute in
`custom-face-attributes' at which the appropriate filter function can be
found, and DEFAULT-FILTER is the filter to apply for attributes that
(widget-specify-sample widget opoint (point)))
(insert
(cond ((eq custom-buffer-style 'face) " ")
- ((string-match "face\\'" tag) ":")
+ ((string-match-p "face\\'" tag) ":")
(t " face: ")))
;; Face sample.
(defun custom-group-members (symbol groups-only)
"Return SYMBOL's custom group members.
-If GROUPS-ONLY non-nil, return only those members that are groups."
+If GROUPS-ONLY is non-nil, return only those members that are groups."
(if (not groups-only)
(get symbol 'custom-group)
(let (members)
;; (indent (widget-get widget :indent))
(prefix (widget-get widget :custom-prefix))
(buttons (widget-get widget :buttons))
- (tag (widget-get widget :tag))
+ (tag (substitute-command-keys (widget-get widget :tag)))
(symbol (widget-value widget))
(members (custom-group-members symbol
(and (eq custom-buffer-style 'tree)
custom-browse-only-groups)))
- (doc (widget-docstring widget)))
+ (doc (substitute-command-keys (widget-docstring widget))))
(cond ((and (eq custom-buffer-style 'tree)
(eq state 'hidden)
(or members (custom-unloaded-widget-p widget)))
:tag tag
symbol)
buttons)
- (insert-char ?\ (* custom-buffer-indent (1- level)))
+ (insert-char ?\s (* custom-buffer-indent (1- level)))
(insert "-- ")
(push (widget-create-child-and-convert
widget 'custom-group-visibility
(when (eq level 1)
(if (custom-add-parent-links widget "Parent groups:")
(insert "\n")))
- (insert-char ?\ (* custom-buffer-indent (1- level)))
+ (insert-char ?\s (* custom-buffer-indent (1- level)))
;; Create tag.
(let ((start (point)))
(insert tag " group: ")
(if nil ;;; This should test that the buffer
;;; was not made to display a group.
(when (eq level 1)
- (insert-char ?\ custom-buffer-indent)
+ (insert-char ?\s custom-buffer-indent)
(custom-add-parent-links widget)))
(custom-add-see-also widget
(make-string (* custom-buffer-indent level)
- ?\ ))
+ ?\s))
;; Members.
(message "Creating group...")
(let* ((members (custom-sort-items
save all customizations in this file, but does not load it.
When you change this variable outside Custom, look in the
-previous custom file \(usually your init file) for the
+previous custom file (usually your init file) for the
forms `(custom-set-variables ...)' and `(custom-set-faces ...)',
and copy them (whichever ones you find) to the new custom file.
This will preserve your existing customizations.
`custom-set-variables' and `custom-set-faces' forms already
present in that file. It will not delete any customizations from
the old custom file. You should do that manually if that is what you
-want. You also have to put something like `\(load \"CUSTOM-FILE\")
+want. You also have to put something like `(load \"CUSTOM-FILE\")
in your init file, where CUSTOM-FILE is the actual name of the
file. Otherwise, Emacs will not load the file when it starts up,
and hence will not set `custom-file' to that file either."
:doc
"Please read entire docstring below before setting \
this through Custom.
-Click on \"More\" \(or position point there and press RETURN)
+Click on \"More\" (or position point there and press RETURN)
if only the first line of the docstring is shown."))
:group 'customize)
(defun custom-file (&optional no-error)
"Return the file name for saving customizations."
- (if (null user-init-file)
+ (if (or (null user-init-file)
+ (and (null custom-file) init-file-had-error))
;; Started with -q, i.e. the file containing Custom settings
;; hasn't been read. Saving settings there won't make much
;; sense.
old-buffer-name)
(with-current-buffer (let ((find-file-visit-truename t))
- (or old-buffer (find-file-noselect filename)))
+ (or old-buffer
+ (let ((delay-mode-hooks t))
+ (find-file-noselect filename))))
;; We'll save using file-precious-flag, so avoid destroying
;; symlinks. (If we're not already visiting the buffer, this is
;; handled by find-file-visit-truename, above.)
(set-visited-file-name (file-chase-links filename)))
(unless (eq major-mode 'emacs-lisp-mode)
- (emacs-lisp-mode))
+ (delay-mode-hooks (emacs-lisp-mode)))
(let ((inhibit-read-only t)
(print-length nil)
(print-level nil))
(princ " '(")
(prin1 symbol)
(princ " ")
- (prin1 (car value))
+ (let ((val (prin1-to-string (car value))))
+ (if (< (length val) 60)
+ (insert val)
+ (newline-and-indent)
+ (let ((beginning-of-val (point)))
+ (insert val)
+ (save-excursion
+ (goto-char beginning-of-val)
+ (indent-pp-sexp 1)))))
(when (or now requests comment)
(princ " ")
(prin1 now)
(if (bolp)
(princ " "))
(princ ")")
- (unless (looking-at "\n")
+ (unless (looking-at-p "\n")
(princ "\n")))))
(defun custom-save-faces ()
(if (bolp)
(princ " "))
(princ ")")
- (unless (looking-at "\n")
+ (unless (looking-at-p "\n")
(princ "\n")))))
\f
;;; The Customize Menu.
(message "To install your edits, invoke [State] and choose the Set operation")))
(defun custom--initialize-widget-variables ()
- (set (make-local-variable 'widget-documentation-face) 'custom-documentation)
- (set (make-local-variable '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)
+ (setq-local widget-documentation-face 'custom-documentation)
+ (setq-local widget-button-face custom-button)
+ (setq-local widget-button-pressed-face custom-button-pressed)
+ (setq-local widget-mouse-face custom-button-mouse)
;; We need this because of the "More" button on docstrings.
;; Otherwise clicking on "More" can push point offscreen, which
;; causes the window to recenter on point, which pushes the
;; newly-revealed docstring offscreen; which is annoying. -- cyd.
- (set (make-local-variable 'widget-button-click-moves-point) t)
+ (setq-local widget-button-click-moves-point t)
;; When possible, use relief for buttons, not bracketing. This test
;; may not be optimal.
(when custom-raised-buttons
- (set (make-local-variable 'widget-push-button-prefix) "")
- (set (make-local-variable 'widget-push-button-suffix) "")
- (set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) ""))
+ (setq-local widget-push-button-prefix "")
+ (setq-local widget-push-button-suffix "")
+ (setq-local widget-link-prefix "")
+ (setq-local widget-link-suffix ""))
(setq show-trailing-whitespace nil))
(define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1")
if that value is non-nil."
(use-local-map custom-mode-map)
(easy-menu-add Custom-mode-menu)
- (set (make-local-variable 'tool-bar-map)
- (or custom-tool-bar-map
- ;; Set up `custom-tool-bar-map'.
- (let ((map (make-sparse-keymap)))
- (mapc
- (lambda (arg)
- (tool-bar-local-item-from-menu
- (nth 1 arg) (nth 4 arg) map custom-mode-map
- :label (nth 5 arg)))
- custom-commands)
- (setq custom-tool-bar-map map))))
+ (setq-local tool-bar-map
+ (or custom-tool-bar-map
+ ;; Set up `custom-tool-bar-map'.
+ (let ((map (make-sparse-keymap)))
+ (mapc
+ (lambda (arg)
+ (tool-bar-local-item-from-menu
+ (nth 1 arg) (nth 4 arg) map custom-mode-map
+ :label (nth 5 arg)))
+ custom-commands)
+ (setq custom-tool-bar-map map))))
(make-local-variable 'custom-options)
(make-local-variable 'custom-local-buffer)
(custom--initialize-widget-variables)