From f9edbe36d6c56f7bf64ba687d525e48fd8762cde Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=A0t=C4=9Bp=C3=A1n=20N=C4=9Bmec?= 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: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'. --- 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