From 8acedc71dc1344daac90a79378dad894dcd98bab Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Tue, 8 Oct 2024 15:58:49 -0700 Subject: [PATCH] [POC] Overload help-xref-following for non-default help buffers * lisp/help-mode.el (help-xref-following): Mention in doc that value may be the symbol of a major mode. (help-buffer): When the current buffer is in `fundamental-mode', check to see if the value of `help-xref-following' is the symbol of a major mode deriving from `help-mode' and `help-buffer-under-preparation' is non-nil. If so, return the current buffer. (help-xref-go-back, help-xref-go-forward): Use `help-do-xref' instead of `apply' to call methods. (help-do-xref): Bind `help-xref-following' to the value of `major-mode' instead of t. * test/lisp/help-mode-tests.el (help-mode-tests-help-buffer-current-buffer): Add case for `help-xref-following' being a major-mode rather than t. (Bug#73686) --- lisp/help-mode.el | 23 +++++++++++++++-------- test/lisp/help-mode-tests.el | 14 +++++++++++++- 2 files changed, 28 insertions(+), 9 deletions(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 4ee4f4156a1..f704098b2dc 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -516,19 +516,26 @@ help-setup-xref (setq help-xref-stack-item item))) (defvar help-xref-following nil - "Non-nil when following a help cross-reference.") + "Non-nil when following a help cross-reference. +May be the value of `major-mode' when an instigating button was clicked.") ;;;###autoload (defun help-buffer () "Return the name of a buffer for inserting help. -If `help-xref-following' is non-nil and the current buffer is -derived from `help-mode', this is the name of the current buffer. - +If `help-xref-following' is t and the current buffer is derived from +`help-mode', return the current buffer's name. As a special case, also +do so if these three conditions are met: `help-xref-following' is the +symbol of a major mode deriving from `help-mode', the current buffer is +in `fundamental-mode', and `help-buffer-under-preparation' is non-nil. Otherwise, return \"*Help*\", creating a buffer with that name if it does not already exist." (buffer-name ;for with-output-to-temp-buffer (if (and help-xref-following - (derived-mode-p 'help-mode)) + (if (or (eq help-xref-following t) + (not (and help-buffer-under-preparation + (eq major-mode 'fundamental-mode)))) + (derived-mode-p 'help-mode) ; current buffer + (provided-mode-derived-p help-xref-following '(help-mode)))) (current-buffer) (get-buffer-create "*Help*")))) @@ -792,7 +799,7 @@ help-xref-go-back position (car item) method (cadr item) args (cddr item)))) - (apply method args) + (help-do-xref nil method args) (with-current-buffer buffer (if (get-buffer-window buffer) (set-window-point (get-buffer-window buffer) position) @@ -812,7 +819,7 @@ help-xref-go-forward position (car item) method (cadr item) args (cddr item)))) - (apply method args) + (help-do-xref nil method args) (with-current-buffer buffer (if (get-buffer-window buffer) (set-window-point (get-buffer-window buffer) position) @@ -894,7 +901,7 @@ help-do-xref Things are set up properly so that the resulting help buffer has a proper [back] button." ;; There is a reference at point. Follow it. - (let ((help-xref-following t)) + (let ((help-xref-following major-mode)) (apply function (if (eq function 'info) (append args (list (generate-new-buffer-name "*info*"))) args)))) diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el index 2e64b12732e..968ed7da72e 100644 --- a/test/lisp/help-mode-tests.el +++ b/test/lisp/help-mode-tests.el @@ -39,7 +39,19 @@ help-mode-tests-help-buffer-current-buffer (help-mode) (let ((help-xref-following t)) (should (equal (buffer-name (current-buffer)) - (help-buffer)))))) + (help-buffer))))) + + ;; Returns the current `fundamental-mode' buffer when an xref button + ;; is clicked and the resulting action function, such as the various + ;; `describe-*' commands, binds `help-buffer-under-preparation' to + ;; something non-nil. + (should (eq major-mode 'fundamental-mode)) + (let ((help-xref-following 'help-mode) + (help-buffer-under-preparation t)) + (should (equal (buffer-name (current-buffer)) + (help-buffer))) + (with-current-buffer "*scratch*" + (should (equal "*Help*" (help-buffer)))))) (ert-deftest help-mode-tests-make-xrefs () (with-temp-buffer -- 2.46.2