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.

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