[Emacs-diffs] master ddcd6e6: Improve Custom's treatment of obsolete options (bug#5742)

[Glenn Morris]

branch: master
commit ddcd6e63d1624c03a227c5ae4abca2443c28430d
Author: Glenn Morris <address@hidden>
Commit: Glenn Morris <address@hidden>

    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 4965adf..e0a00d4 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 f52f48e..04a890e 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