Subject: bug#39842: [PATCH] Use help-fns-short-filename in other describe- commands

From: Štěpán Němec <[email-masked]>
Date: Sat, 29 Feb 2020 22:47:36 +0100

On Sat, 29 Feb 2020 16:07:46 -0500
Stefan Monnier wrote:

> I.e. I think the better answer is that `describe-mode` should move to
> `help-fns.el`.

Patch updated to that effect attached.

Thank you,

  Štěpán

>From f9edbe36d6c56f7bf64ba687d525e48fd8762cde Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C5=A0t=C4=9Bp=C3=A1n=20N=C4=9Bmec?= <[email-masked]>
Date: Sat, 29 Feb 2020 19:43:53 +0100
Subject: [PATCH] Use help-fns-short-filename in other describe- commands

The commit

2015-01-16T22:52:15-05:[email-masked]
24b7f77581
(Improve handling of doc-strings and describe-function for cl-generic)

added 'help-fns-short-filename', which provides file name shortening
smarter than a simple 'file-name-nondirectory' call, but besides the
generic/eieio functions ('cl--generic-describe', 'cl--describe-class',
'eieio-help-constructor'), it is currently only used by
'describe-function' (via 'help-fns-function-description-header').

Make the other help commands use it, too.

(Other than the obvious consistency/maintenance argument, my immediate
motivation for this change is the possibility to customize the file
name abbreviation by advising the function.)

* lisp/help.el (describe-mode): Move to help-fns.el.  The command was
already depending on 'find-lisp-object-file-name' defined there.
* lisp/help-fns.el (describe-variable) (describe-face) (describe-keymap)
(describe-mode): Use 'help-fns-short-filename'.
---
 lisp/help-fns.el | 116 +++++++++++++++++++++++++++++++++++++++++++++--
 lisp/help.el     | 108 -------------------------------------------
 2 files changed, 112 insertions(+), 112 deletions(-)

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 36c2a8b186..ad496166f5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -968,7 +968,7 @@ describe-variable
                                    " is a variable defined in `%s'.\n"
                                    (if (eq file-name 'C-source)
                                        "C source code"
-                                     (file-name-nondirectory file-name))))
+                                     (help-fns-short-filename file-name))))
 		           (with-current-buffer standard-output
 		             (save-excursion
 			       (re-search-backward (substitute-command-keys
@@ -1350,7 +1350,7 @@ describe-face
 	      (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 (help-fns-short-filename file-name))
 		(princ (substitute-command-keys "'"))
 		;; Make a hyperlink to the library.
 		(save-excursion
@@ -1642,7 +1642,7 @@ describe-keymap
                       " defined in `%s'.\n\n"
                       (if (eq file-name 'C-source)
                           "C source code"
-                        (file-name-nondirectory file-name))))
+                        (help-fns-short-filename file-name))))
               (save-excursion
                 (re-search-backward (substitute-command-keys
                                      "`\\([^`']+\\)'")
@@ -1658,7 +1658,115 @@ describe-keymap
     ;; Cleanup.
     (when used-gentemp
       (makunbound keymap))))
-
+
+;;;###autoload
+(defun describe-mode (&optional buffer)
+  "Display documentation of current major mode and minor modes.
+A brief summary of the minor modes comes first, followed by the
+major mode description.  This is followed by detailed
+descriptions of the minor modes, each on a separate page.
+
+For this to work correctly for a minor mode, the mode's indicator
+variable \(listed in `minor-mode-alist') must also be a function
+whose documentation describes the minor mode.
+
+If called from Lisp with a non-nil BUFFER argument, display
+documentation for the major and minor modes of that buffer."
+  (interactive "@")
+  (unless buffer (setq buffer (current-buffer)))
+  (help-setup-xref (list #'describe-mode buffer)
+		   (called-interactively-p 'interactive))
+  ;; For the sake of help-do-xref and help-xref-go-back,
+  ;; don't switch buffers before calling `help-buffer'.
+  (with-help-window (help-buffer)
+    (with-current-buffer buffer
+      (let (minor-modes)
+	;; Older packages do not register in minor-mode-list but only in
+	;; minor-mode-alist.
+	(dolist (x minor-mode-alist)
+	  (setq x (car x))
+	  (unless (memq x minor-mode-list)
+	    (push x minor-mode-list)))
+	;; Find enabled minor mode we will want to mention.
+	(dolist (mode minor-mode-list)
+	  ;; Document a minor mode if it is listed in minor-mode-alist,
+	  ;; non-nil, and has a function definition.
+	  (let ((fmode (or (get mode :minor-mode-function) mode)))
+	    (and (boundp mode) (symbol-value mode)
+		 (fboundp fmode)
+		 (let ((pretty-minor-mode
+			(if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+					  (symbol-name fmode))
+			    (capitalize
+			     (substring (symbol-name fmode)
+					0 (match-beginning 0)))
+			  fmode)))
+		   (push (list fmode pretty-minor-mode
+			       (format-mode-line (assq mode minor-mode-alist)))
+			 minor-modes)))))
+	;; Narrowing is not a minor mode, but its indicator is part of
+	;; mode-line-modes.
+	(when (buffer-narrowed-p)
+	  (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
+	(setq minor-modes
+	      (sort minor-modes
+		    (lambda (a b) (string-lessp (cadr a) (cadr b)))))
+	(when minor-modes
+	  (princ "Enabled minor modes:\n")
+	  (make-local-variable 'help-button-cache)
+	  (with-current-buffer standard-output
+	    (dolist (mode minor-modes)
+	      (let ((mode-function (nth 0 mode))
+		    (pretty-minor-mode (nth 1 mode))
+		    (indicator (nth 2 mode)))
+		(save-excursion
+		  (goto-char (point-max))
+		  (princ "\n\f\n")
+		  (push (point-marker) help-button-cache)
+		  ;; Document the minor modes fully.
+                  (insert-text-button
+                   pretty-minor-mode 'type 'help-function
+                   'help-args (list mode-function)
+                   'button '(t))
+		  (princ (format " minor mode (%s):\n"
+				 (if (zerop (length indicator))
+				     "no indicator"
+				   (format "indicator%s"
+					   indicator))))
+		  (princ (help-split-fundoc (documentation mode-function)
+                                            nil 'doc)))
+		(insert-button pretty-minor-mode
+			       'action (car help-button-cache)
+			       'follow-link t
+			       'help-echo "mouse-2, RET: show full information")
+		(newline)))
+	    (forward-line -1)
+	    (fill-paragraph nil)
+	    (forward-line 1))
+
+	  (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
+	;; Document the major mode.
+	(let ((mode mode-name))
+	  (with-current-buffer standard-output
+            (let ((start (point)))
+              (insert (format-mode-line mode nil nil buffer))
+              (add-text-properties start (point) '(face bold)))))
+	(princ " mode")
+	(let* ((mode major-mode)
+	       (file-name (find-lisp-object-file-name mode nil)))
+	  (when file-name
+	    (princ (format-message " defined in `%s'"
+                                   (help-fns-short-filename file-name)))
+	    ;; Make a hyperlink to the library.
+	    (with-current-buffer standard-output
+	      (save-excursion
+		(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+                                    nil t)
+		(help-xref-button 1 'help-function-def mode file-name)))))
+	(princ ":\n")
+	(princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
+  ;; For the sake of IELM and maybe others
+  nil)
 
 ;;; Replacements for old lib-src/ programs.  Don't seem especially useful.
 
diff --git a/lisp/help.el b/lisp/help.el
index 45cbaad4e8..e40ed479e0 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -879,114 +879,6 @@ describe-key
             (princ ", which is ")
 	    (describe-function-1 defn)))))))
 
-(defun describe-mode (&optional buffer)
-  "Display documentation of current major mode and minor modes.
-A brief summary of the minor modes comes first, followed by the
-major mode description.  This is followed by detailed
-descriptions of the minor modes, each on a separate page.
-
-For this to work correctly for a minor mode, the mode's indicator
-variable \(listed in `minor-mode-alist') must also be a function
-whose documentation describes the minor mode.
-
-If called from Lisp with a non-nil BUFFER argument, display
-documentation for the major and minor modes of that buffer."
-  (interactive "@")
-  (unless buffer (setq buffer (current-buffer)))
-  (help-setup-xref (list #'describe-mode buffer)
-		   (called-interactively-p 'interactive))
-  ;; For the sake of help-do-xref and help-xref-go-back,
-  ;; don't switch buffers before calling `help-buffer'.
-  (with-help-window (help-buffer)
-    (with-current-buffer buffer
-      (let (minor-modes)
-	;; Older packages do not register in minor-mode-list but only in
-	;; minor-mode-alist.
-	(dolist (x minor-mode-alist)
-	  (setq x (car x))
-	  (unless (memq x minor-mode-list)
-	    (push x minor-mode-list)))
-	;; Find enabled minor mode we will want to mention.
-	(dolist (mode minor-mode-list)
-	  ;; Document a minor mode if it is listed in minor-mode-alist,
-	  ;; non-nil, and has a function definition.
-	  (let ((fmode (or (get mode :minor-mode-function) mode)))
-	    (and (boundp mode) (symbol-value mode)
-		 (fboundp fmode)
-		 (let ((pretty-minor-mode
-			(if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
-					  (symbol-name fmode))
-			    (capitalize
-			     (substring (symbol-name fmode)
-					0 (match-beginning 0)))
-			  fmode)))
-		   (push (list fmode pretty-minor-mode
-			       (format-mode-line (assq mode minor-mode-alist)))
-			 minor-modes)))))
-	;; Narrowing is not a minor mode, but its indicator is part of
-	;; mode-line-modes.
-	(when (buffer-narrowed-p)
-	  (push '(narrow-to-region "Narrow" " Narrow") minor-modes))
-	(setq minor-modes
-	      (sort minor-modes
-		    (lambda (a b) (string-lessp (cadr a) (cadr b)))))
-	(when minor-modes
-	  (princ "Enabled minor modes:\n")
-	  (make-local-variable 'help-button-cache)
-	  (with-current-buffer standard-output
-	    (dolist (mode minor-modes)
-	      (let ((mode-function (nth 0 mode))
-		    (pretty-minor-mode (nth 1 mode))
-		    (indicator (nth 2 mode)))
-		(save-excursion
-		  (goto-char (point-max))
-		  (princ "\n\f\n")
-		  (push (point-marker) help-button-cache)
-		  ;; Document the minor modes fully.
-                  (insert-text-button
-                   pretty-minor-mode 'type 'help-function
-                   'help-args (list mode-function)
-                   'button '(t))
-		  (princ (format " minor mode (%s):\n"
-				 (if (zerop (length indicator))
-				     "no indicator"
-				   (format "indicator%s"
-					   indicator))))
-		  (princ (help-split-fundoc (documentation mode-function)
-                                            nil 'doc)))
-		(insert-button pretty-minor-mode
-			       'action (car help-button-cache)
-			       'follow-link t
-			       'help-echo "mouse-2, RET: show full information")
-		(newline)))
-	    (forward-line -1)
-	    (fill-paragraph nil)
-	    (forward-line 1))
-
-	  (princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
-	;; Document the major mode.
-	(let ((mode mode-name))
-	  (with-current-buffer standard-output
-            (let ((start (point)))
-              (insert (format-mode-line mode nil nil buffer))
-              (add-text-properties start (point) '(face bold)))))
-	(princ " mode")
-	(let* ((mode major-mode)
-	       (file-name (find-lisp-object-file-name mode nil)))
-	  (when file-name
-	    (princ (format-message " defined in `%s'"
-                                   (file-name-nondirectory file-name)))
-	    ;; Make a hyperlink to the library.
-	    (with-current-buffer standard-output
-	      (save-excursion
-		(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
-                                    nil t)
-		(help-xref-button 1 'help-function-def mode file-name)))))
-	(princ ":\n")
-	(princ (help-split-fundoc (documentation major-mode) nil 'doc)))))
-  ;; For the sake of IELM and maybe others
-  nil)
-
 (defun search-forward-help-for-help ()
   "Search forward \"help window\"."
   (interactive)
-- 
2.25.1