From ddcd6e63d1624c03a227c5ae4abca2443c28430d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 14 Dec 2017 20:22:08 -0500 Subject: [PATCH] Improve Custom's treatment of obsolete options (bug#5742) * lisp/cus-edit.el (custom-variable-obsolete): New face. (custom-variable-documentation): Include obsolescence information. (custom-variable-value-create): Use different face for obsolete items. (custom-face-documentation): New function. (custom-face): Use custom-face-documentation. * lisp/info-look.el (info-lookup-guess-custom-symbol): Add custom-variable-obsolete face. --- lisp/cus-edit.el | 63 +++++++++++++++++++++++++++++++++++++++++------ lisp/info-look.el | 3 ++- 2 files changed, 58 insertions(+), 8 deletions(-) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4965adfd56c..e0a00d4337f 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2431,6 +2431,18 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." ;;; The `custom-variable' Widget. +(defface custom-variable-obsolete + '((((class color) (background dark)) + :foreground "light blue") + (((min-colors 88) (class color) (background light)) + :foreground "blue1") + (((class color) (background light)) + :foreground "blue") + (t :slant italic)) + "Face used for obsolete variables." + :version "27.1" + :group 'custom-faces) + (defface custom-variable-tag `((((class color) (background dark)) :foreground "light blue" :weight bold) @@ -2456,8 +2468,9 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (defun custom-variable-documentation (variable) "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 t) +becomes buffer local when set, append a message to that effect. +Also append any obsolescence information." + (format "%s%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 @@ -2465,7 +2478,21 @@ becomes buffer local when set, append a message to that effect." "\n This variable automatically becomes buffer-local when set outside Custom. However, setting it through Custom sets the default value." - ""))) + "") + ;; This duplicates some code from describe-variable. + ;; TODO extract to separate utility function? + (let* ((obsolete (get variable 'byte-obsolete-variable)) + (use (car obsolete))) + (if obsolete + (concat "\n +This variable is obsolete" + (if (nth 2 obsolete) + (format " since %s" (nth 2 obsolete))) + (cond ((stringp use) (concat ";\n" use)) + (use (format-message ";\nuse `%s' instead." + (car obsolete))) + (t "."))) + "")))) (define-widget 'custom-variable 'custom "A widget for displaying a Custom variable. @@ -2549,7 +2576,8 @@ try matching its doc string against `custom-guess-doc-alist'." (state (or (widget-get widget :custom-state) (if (memq (custom-variable-state symbol value) (widget-get widget :hidden-states)) - 'hidden)))) + 'hidden))) + (obsolete (get symbol 'byte-obsolete-variable))) ;; If we don't know the state, see if we need to edit it in lisp form. (unless state @@ -2581,7 +2609,9 @@ try matching its doc string against `custom-guess-doc-alist'." (push (widget-create-child-and-convert widget 'item :format "%{%t%} " - :sample-face 'custom-variable-tag + :sample-face (if obsolete + 'custom-variable-obsolete + 'custom-variable-tag) :tag tag :parent widget) buttons)) @@ -2639,7 +2669,9 @@ try matching its doc string against `custom-guess-doc-alist'." :help-echo "Change value of this option." :mouse-down-action 'custom-tag-mouse-down-action :button-face 'custom-variable-button - :sample-face 'custom-variable-tag + :sample-face (if obsolete + 'custom-variable-obsolete + 'custom-variable-tag) tag) buttons) (push (widget-create-child-and-convert @@ -3322,6 +3354,23 @@ Only match frames that support the specified face attributes.") :group 'custom-buffer :version "20.3") +(defun custom-face-documentation (face) + "Return documentation of FACE for use in Custom buffer." + (format "%s%s" (face-documentation face) + ;; This duplicates some code from describe-face. + ;; TODO extract to separate utility function? + ;; In practice this does not get used, because M-x customize-face + ;; follows aliases. + (let ((alias (get face 'face-alias)) + (obsolete (get face 'obsolete-face))) + (if (and alias obsolete) + (format "\nThis face is obsolete%s; use `%s' instead.\n" + (if (stringp obsolete) + (format " since %s" obsolete) + "") + alias) + "")))) + (define-widget 'custom-face 'custom "Widget for customizing a face. The following properties have special meanings for this widget: @@ -3345,7 +3394,7 @@ The following properties have special meanings for this 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 + :documentation-property #'custom-face-documentation :value-create 'custom-face-value-create :action 'custom-face-action :custom-category 'face diff --git a/lisp/info-look.el b/lisp/info-look.el index f52f48edec2..04a890e2b7a 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -619,7 +619,8 @@ Return nil if there is nothing appropriate in the buffer near point." beg end) (cond ((and (memq (get-char-property (point) 'face) - '(custom-variable-tag custom-variable-tag-face)) + '(custom-variable-tag custom-variable-obsolete + custom-variable-tag-face)) (setq beg (previous-single-char-property-change (point) 'face nil (line-beginning-position))) (setq end (next-single-char-property-change -- 2.39.2