-;;; 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-2014 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
(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)
(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
(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
(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 ()
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)
"*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*")))
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))
(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
(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.")
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 ")
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)
: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)
(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)