X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bd358779861f265a7acff31ead40172735af693e..34dc21db6e57ebbad81a196002fcd3cc557f096e:/lisp/cus-edit.el diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d4966078e1..212e29069e 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1,9 +1,9 @@ -;;; 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 -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: help, faces ;; Package: emacs @@ -558,7 +558,7 @@ value unless you are sure you know what it does." (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)) @@ -629,7 +629,7 @@ if that fails, the doc string with `custom-guess-doc-alist'." (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 @@ -639,7 +639,7 @@ if that fails, the doc string with `custom-guess-doc-alist'." (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)) @@ -699,7 +699,7 @@ If `last', order groups after non-groups." (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." @@ -731,7 +731,7 @@ 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 @@ -1057,8 +1057,8 @@ the resulting list value now. Otherwise, add an entry to (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 () @@ -1415,14 +1415,15 @@ suggest to customize that face, if it's customizable." "*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. @@ -1431,25 +1432,28 @@ If TYPE is `groups', include only groups." (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*"))) @@ -1526,7 +1530,8 @@ not for everybody." 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)) @@ -1621,8 +1626,8 @@ or a regular expression.") (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 @@ -1832,7 +1837,7 @@ item in another window.\n\n")) (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) @@ -1930,7 +1935,7 @@ SAVED and set." "\ 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.") @@ -1960,6 +1965,8 @@ STATE is one of the following symbols: 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. @@ -1973,7 +1980,7 @@ GROUP-DESC is a string describing the state for groups. If this is 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.") @@ -2039,7 +2046,7 @@ and `face'." (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 @@ -2064,7 +2071,7 @@ and `face'." (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 @@ -2293,7 +2300,7 @@ Insert PREFIX first if non-nil." (indent (widget-get widget :indent))) (when links (when indent - (insert-char ?\ indent)) + (insert-char ?\s indent)) (when prefix (insert prefix)) (insert "See also ") @@ -3227,7 +3234,7 @@ OS/2 Presentation Manager.") pm) (const :format "W32 " :sibling-args (:help-echo "\ -Windows NT/9X.") +MS Windows.") w32) (const :format "NS " :sibling-args (:help-echo "\ @@ -3348,7 +3355,7 @@ The following properties have special meanings for this widget: "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 @@ -3473,7 +3480,7 @@ the present value is saved to its :shown-value property instead." (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. @@ -3947,7 +3954,7 @@ and so forth. The remaining group tags are shown with `custom-group-tag'." (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) @@ -4058,7 +4065,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups." :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 @@ -4098,7 +4105,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (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: ") @@ -4137,11 +4144,11 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (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 @@ -4326,7 +4333,7 @@ Note that both lines are necessary: the first line tells Custom to 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. @@ -4337,7 +4344,7 @@ option itself, into the file you specify, overwriting any `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." @@ -4346,7 +4353,7 @@ 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) @@ -4553,7 +4560,7 @@ This function does not save the buffer." (if (bolp) (princ " ")) (princ ")") - (unless (looking-at "\n") + (unless (looking-at-p "\n") (princ "\n"))))) (defun custom-save-faces () @@ -4608,7 +4615,7 @@ This function does not save the buffer." (if (bolp) (princ " ")) (princ ")") - (unless (looking-at "\n") + (unless (looking-at-p "\n") (princ "\n"))))) ;;; The Customize Menu. @@ -4759,22 +4766,22 @@ If several parents are listed, go to the first of them." (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") @@ -4802,17 +4809,17 @@ Entry to this mode calls the value of `Custom-mode-hook' 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)