Move describe-face to the new help-fns machinery

* lisp/help-fns.el (describe-face): Move to here from faces.el and
split up (bug#36670).
(help-fns--face-custom-version-info):
(help-fns--face-attributes): Factored out into own functions.
(help-fns-describe-face-functions): New variable.

* lisp/emacs-lisp/subr-x.el (when-let): Add autoload cookie.

3 files changed, 133 insertions, 118 deletions

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index bb2bf3dd5fa..3da52418fe4 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -182,6 +182,7 @@ with an old syntax that accepted only one binding."
     (setq spec (list spec)))
   (list 'if-let* spec then (macroexp-progn else)))
 
+;;;###autoload
 (defmacro when-let (spec &rest body)
   "Bind variables according to SPEC and conditionally evaluate BODY.
 Evaluate each binding in turn, stopping if a binding value is nil.
diff --git a/lisp/faces.el b/lisp/faces.el
index efae101cd88..9c5ffe1e590 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1416,124 +1416,6 @@ argument, prompt for a regular expression using `read-regexp'."
 	(dolist (face (face-list))
 	  (copy-face face face frame disp-frame)))))
 
-(declare-function describe-variable-custom-version-info "help-fns"
-                  (variable &optional type))
-
-(defun describe-face (face &optional frame)
-  "Display the properties of face FACE on FRAME.
-Interactively, FACE defaults to the faces of the character after point
-and FRAME defaults to the selected frame.
-
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
-  (interactive (list (read-face-name "Describe face"
-                                     (or (face-at-point t) 'default)
-                                     t)))
-  (require 'help-fns)
-  (let* ((attrs '((:family . "Family")
-		  (:foundry . "Foundry")
-		  (:width . "Width")
-		  (:height . "Height")
-		  (:weight . "Weight")
-		  (:slant . "Slant")
-		  (:foreground . "Foreground")
-		  (:distant-foreground . "DistantForeground")
-		  (:background . "Background")
-		  (:underline . "Underline")
-		  (:overline . "Overline")
-		  (:strike-through . "Strike-through")
-		  (:box . "Box")
-		  (:inverse-video . "Inverse")
-		  (:stipple . "Stipple")
-		  (:font . "Font")
-		  (:fontset . "Fontset")
-		  (:inherit . "Inherit")))
-	(max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
-					attrs))))
-    (help-setup-xref (list #'describe-face face)
-		     (called-interactively-p 'interactive))
-    (unless face
-      (setq face 'default))
-    (if (not (listp face))
-	(setq face (list face)))
-    (with-help-window (help-buffer)
-      (with-current-buffer standard-output
-	(dolist (f face (buffer-string))
-	  (if (stringp f) (setq f (intern f)))
-	  ;; We may get called for anonymous faces (i.e., faces
-	  ;; expressed using prop-value plists).  Those can't be
-	  ;; usefully customized, so ignore them.
-	  (when (symbolp f)
-	    (insert "Face: " (symbol-name f))
-	    (if (not (facep f))
-		(insert "   undefined face.\n")
-	      (let ((customize-label "customize this face")
-		    file-name)
-		(insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
-		(princ (concat " (" customize-label ")\n"))
-		;; FIXME not sure how much of this belongs here, and
-		;; how much in `face-documentation'.  The latter is
-		;; not used much, but needs to return nil for
-		;; undocumented faces.
-		(let ((alias (get f 'face-alias))
-		      (face f)
-		      obsolete)
-		  (when alias
-		    (setq face alias)
-		    (insert
-		     (format-message
-                      "\n  %s is an alias for the face `%s'.\n%s"
-                      f alias
-                      (if (setq obsolete (get f 'obsolete-face))
-                          (format-message
-                           "  This face is obsolete%s; use `%s' instead.\n"
-                           (if (stringp obsolete)
-                               (format " since %s" obsolete)
-                             "")
-                           alias)
-                        ""))))
-		  (insert "\nDocumentation:\n"
-                          (substitute-command-keys
-                           (or (face-documentation face)
-                               "Not documented as a face."))
-			  "\n\n"))
-		(with-current-buffer standard-output
-		  (save-excursion
-		    (re-search-backward
-		     (concat "\\(" customize-label "\\)") nil t)
-		    (help-xref-button 1 'help-customize-face f)))
-		(setq file-name (find-lisp-object-file-name f 'defface))
-		(when file-name
-		  (princ (substitute-command-keys "Defined in `"))
-		  (princ (file-name-nondirectory file-name))
-		  (princ (substitute-command-keys "'"))
-		  ;; Make a hyperlink to the library.
-		  (save-excursion
-		    (re-search-backward
-                     (substitute-command-keys "`\\([^`']+\\)'") nil t)
-		    (help-xref-button 1 'help-face-def f file-name))
-		  (princ ".")
-		  (terpri)
-		  (terpri))
-		(dolist (a attrs)
-		  (let ((attr (face-attribute f (car a) frame)))
-		    (insert (make-string (- max-width (length (cdr a))) ?\s)
-			    (cdr a) ": " (format "%s" attr))
-		    (if (and (eq (car a) :inherit)
-			     (not (eq attr 'unspecified)))
-			;; Make a hyperlink to the parent face.
-			(save-excursion
-			  (re-search-backward ": \\([^:]+\\)" nil t)
-			  (help-xref-button 1 'help-face attr)))
-		    (insert "\n")))))
-	    (terpri)
-            (let ((version-info (describe-variable-custom-version-info
-                                 f 'face)))
-              (when version-info
-                (insert version-info)
-                (terpri)))))))))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Face specifications (defface).
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 90a35715204..3c0a72e2634 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -56,6 +56,13 @@ By convention they should indent their output by 2 spaces.
 Current buffer is the buffer in which we queried the variable,
 and the output should go to `standard-output'.")
 
+(defvar help-fns-describe-face-functions nil
+  "List of functions to run in help buffer in `describe-face'.
+The functions will be used (and take the same parameters) as
+described in `help-fns-describe-variable-functions', except that
+the functions are called with two parameters: The face and the
+frame.")
+
 ;; Functions
 
 (defvar help-definition-prefixes nil
@@ -1235,6 +1242,131 @@ variable.\n")))
 	      "  This variable's value is permanent \
 if it is given a local binding.\n"))))))
 
+
+;; Faces.
+
+;;;###autoload
+(defun describe-face (face &optional frame)
+  "Display the properties of face FACE on FRAME.
+Interactively, FACE defaults to the faces of the character after point
+and FRAME defaults to the selected frame.
+
+If the optional argument FRAME is given, report on face FACE in that frame.
+If FRAME is t, report on the defaults for face FACE (for new frames).
+If FRAME is omitted or nil, use the selected frame."
+  (interactive (list (read-face-name "Describe face"
+                                     (or (face-at-point t) 'default)
+                                     t)))
+  (help-setup-xref (list #'describe-face face)
+		   (called-interactively-p 'interactive))
+  (unless face
+    (setq face 'default))
+  (if (not (listp face))
+      (setq face (list face)))
+  (with-help-window (help-buffer)
+    (with-current-buffer standard-output
+      (dolist (f face (buffer-string))
+	(if (stringp f) (setq f (intern f)))
+	;; We may get called for anonymous faces (i.e., faces
+	;; expressed using prop-value plists).  Those can't be
+	;; usefully customized, so ignore them.
+	(when (symbolp f)
+	  (insert "Face: " (symbol-name f))
+	  (if (not (facep f))
+	      (insert "   undefined face.\n")
+	    (let ((customize-label "customize this face")
+		  file-name)
+	      (insert (concat " (" (propertize "sample" 'font-lock-face f) ")"))
+	      (princ (concat " (" customize-label ")\n"))
+	      ;; FIXME not sure how much of this belongs here, and
+	      ;; how much in `face-documentation'.  The latter is
+	      ;; not used much, but needs to return nil for
+	      ;; undocumented faces.
+	      (let ((alias (get f 'face-alias))
+		    (face f)
+		    obsolete)
+		(when alias
+		  (setq face alias)
+		  (insert
+		   (format-message
+                    "\n  %s is an alias for the face `%s'.\n%s"
+                    f alias
+                    (if (setq obsolete (get f 'obsolete-face))
+                        (format-message
+                         "  This face is obsolete%s; use `%s' instead.\n"
+                         (if (stringp obsolete)
+                             (format " since %s" obsolete)
+                           "")
+                         alias)
+                      ""))))
+		(insert "\nDocumentation:\n"
+                        (substitute-command-keys
+                         (or (face-documentation face)
+                             "Not documented as a face."))
+			"\n\n"))
+	      (with-current-buffer standard-output
+		(save-excursion
+		  (re-search-backward
+		   (concat "\\(" customize-label "\\)") nil t)
+		  (help-xref-button 1 'help-customize-face f)))
+	      (setq file-name (find-lisp-object-file-name f 'defface))
+	      (when file-name
+		(princ (substitute-command-keys "Defined in `"))
+		(princ (file-name-nondirectory file-name))
+		(princ (substitute-command-keys "'"))
+		;; Make a hyperlink to the library.
+		(save-excursion
+		  (re-search-backward
+                   (substitute-command-keys "`\\([^`']+\\)'") nil t)
+		  (help-xref-button 1 'help-face-def f file-name))
+		(princ ".")
+		(terpri)
+		(terpri))))
+	  (terpri)
+          (run-hook-with-args 'help-fns-describe-face-functions f frame))))))
+
+(add-hook 'help-fns-describe-face-functions
+          #'help-fns--face-custom-version-info)
+(defun help-fns--face-custom-version-info (face _frame)
+  (when-let ((version-info (describe-variable-custom-version-info face 'face)))
+    (insert version-info)
+    (terpri)))
+
+(add-hook 'help-fns-describe-face-functions #'help-fns--face-attributes)
+(defun help-fns--face-attributes (face frame)
+  (let* ((attrs '((:family . "Family")
+		  (:foundry . "Foundry")
+		  (:width . "Width")
+		  (:height . "Height")
+		  (:weight . "Weight")
+		  (:slant . "Slant")
+		  (:foreground . "Foreground")
+		  (:distant-foreground . "DistantForeground")
+		  (:background . "Background")
+		  (:underline . "Underline")
+		  (:overline . "Overline")
+		  (:strike-through . "Strike-through")
+		  (:box . "Box")
+		  (:inverse-video . "Inverse")
+		  (:stipple . "Stipple")
+		  (:font . "Font")
+		  (:fontset . "Fontset")
+		  (:inherit . "Inherit")))
+	 (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
+					 attrs))))
+    (dolist (a attrs)
+      (let ((attr (face-attribute face (car a) frame)))
+	(insert (make-string (- max-width (length (cdr a))) ?\s)
+		(cdr a) ": " (format "%s" attr))
+	(if (and (eq (car a) :inherit)
+		 (not (eq attr 'unspecified)))
+	    ;; Make a hyperlink to the parent face.
+	    (save-excursion
+	      (re-search-backward ": \\([^:]+\\)" nil t)
+	      (help-xref-button 1 'help-face attr)))
+	(insert "\n")))
+    (terpri)))
+
 (defvar help-xref-stack-item)
 
 ;;;###autoload