Use help-fns-short-filename in other describe- commands

The commit

2015-01-16T22:52:15-05:00!monnier@iro.umontreal.ca
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'.

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 36c2a8b186dcdf066afccdda8d07c823c4fb596a..ad496166f509ed60884a20c632a4e73a1f96c9aa 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -968,7 +968,7 @@ it is displayed along with the global value."
                                    " 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 @@ If FRAME is omitted or nil, use the selected frame."
              (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 @@ keymap value."
                       " 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 @@ keymap value."
     ;; Cleanup.
     (when used-gentemp
       (makunbound keymap))))
-
+\f
+;;;###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)
 \f
 ;;; Replacements for old lib-src/ programs.  Don't seem especially useful.
 

diff --git a/lisp/help.el b/lisp/help.el
index 45cbaad4e8b634b8ca4b6219549d398cd38c317e..e40ed479e0db866d37313a042fd3fce1bc6c84c5 100644 (file)
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -879,114 +879,6 @@ current buffer."
             (princ ", which is ")
            (describe-function-1 defn)))))))
 \f
-(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)