From 1650339b51ebea70a8454835145afd01c7400c80 Mon Sep 17 00:00:00 2001 From: Arthur Miller Date: Wed, 28 Jun 2023 21:43:30 +0200 Subject: [PATCH] Use help- and Info-mode commands from any buffer Allow commands that act on help-mode and Info-mode to be called from other buffers than just help and Info buffer. * lisp/help-mode.el (help-link): New symbol used to establish a connection between a buffer and a help buffer. * lisp/help-mode.el (help-window): New function used to find a help window to act on. * lisp/help-mode.el (help-view-source): * lisp/help-mode.el (help-goto-info): * lisp/help-mode.el (help-go-back): * lisp/help-mode.el (help-go-forward): * lisp/help-mode.el (help-goto-next-page): * lisp/help-mode.el (help-goto-previous-page): * lisp/help-mode.el (help-goto-lispref-info): * lisp/help-mode.el (help-customize): Help-mode commands adapted to be called from any buffer. * lisp/help-mode.el (help-quit-window): * lisp/help-mode.el (help-revert-buffer): * lisp/help-mode.el (help-describe-mode): * lisp/help-mode.el (help-beginning-of-buffer): * lisp/help-mode.el (help-end-of-buffer): * lisp/help-mode.el (help-scroll-up-command): * lisp/help-mode.el (help-scroll-down-command): * lisp/help-mode.el (help-forward-button): * lisp/help-mode.el (help-backward-button): * lisp/help-mode.el (help-button-describe): * lisp/help-mode.el (help-push-button): New commands. Do what they wrapped counterparts without 'help-' prefix do, but specifically in help buffer. * lisp/help-mode.el (help-mode-map): * lisp/help-mode.el (help-mode-menu): Update bindings to reflect the new commands for previously generic commands. * lisp/info.el (Info-virtual-file-p): * lisp/info.el (Info-menu): * lisp/info.el (Info-next): * lisp/info.el (Info-prev): * lisp/info.el (Info-up): * lisp/info.el (Info-history): * lisp/info.el (Info-history-back): * lisp/info.el (Info-history-forward): * lisp/info.el (Info-directory): * lisp/info.el (Info-toc-insert): * lisp/info.el (Info-toc): * lisp/info.el (Info-extract-menu-item): * lisp/info.el (Info-nth-menu-item): * lisp/info.el (Info-top-node): * lisp/info.el (Info-final-node): * lisp/info.el (Info-forward-node): * lisp/info.el (Info-backward-node): * lisp/info.el (Info-next-menu-item): * lisp/info.el (Info-last-menu-item): * lisp/info.el (Info-next-preorder): * lisp/info.el (Info-last-preorder): * lisp/info.el (Info-scroll-up): * lisp/info.el (Info-scroll-down): * lisp/info.el (Info-mouse-scroll-up): * lisp/info.el (Info-next-reference): * lisp/info.el (Info-prev-reference): * lisp/info.el (Info-index): * lisp/info.el (Info-index-next): * lisp/info.el (Info-find-index-name): * lisp/info.el (Info-virtual-index): * lisp/info.el (Info-apropos): * lisp/info.el (Info-finder): * lisp/info.el (Info-undefined): * lisp/info.el (Info-follow-nearest-node): * lisp/info.el (Info-summary): * lisp/info.el (Info-copy-current-node-name): Info-mode commands adapted to be called from any buffer. * lisp/info.el (Info-describe-mode): * lisp/info.el (Info-quit-window): * lisp/info.el (Info-beginning-of-buffer): * lisp/info.el (Info-end-of-buffer): New commands. Do what they wrapped counterparts without 'Info-' prefix do, but specifically in Info buffer. * lisp/info.el (Info-link): New symbol used to establish a connection between a buffer and an Info buffer. * lisp/info.el (Info-mode-map): * lisp/info.el (Info-mode-menu): Update bindings to reflect the new commands for previously generic commands. * lisp/window.el (window-list-by-mode): * lisp/window.el (get-window-from-user): * lisp/window.el (get-numbered-window): New functions. Used internally as help functions for find-window-for-help. * lisp/window.el (find-window-for-help): New function. Used to obtain a window for Info- or help-mode. --- lisp/help-mode.el | 209 +++++-- lisp/info.el | 1317 +++++++++++++++++++++++++-------------------- lisp/window.el | 67 +++ 3 files changed, 961 insertions(+), 632 deletions(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index bf64d032b65..2a637c9805c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -47,7 +47,21 @@ help-mode-map "s" #'help-view-source "I" #'help-goto-lispref-info "i" #'help-goto-info - "c" #'help-customize) + "c" #'help-customize + "g" #'help-revert-buffer + "q" #'help-quit-window + "<" #'help-beginning-of-buffer + ">" #'help-end-of-buffer + "h" #'help-describe-mode + "?" #'help-describe-mode + "DEL" #'help-scroll-down-command + "SPC" #'help-scroll-down-command + "S-SPC" #'help-scroll-up-command + "RET" #'help-push-button + "TAB" #'help-forward-button + "C-M-i" #'help-backward-button + "" #'help-backward-button + "ESC TAB" #'help-backward-button) (easy-menu-define help-mode-menu help-mode-map "Menu for Help mode." @@ -60,9 +74,9 @@ help-mode-menu ["Next Topic" help-go-forward :help "Go back to next topic in this help buffer" :active help-xref-forward-stack] - ["Move to Previous Button" backward-button + ["Move to Previous Button" help-backward-button :help "Move to the Previous Button in the help buffer"] - ["Move to Next Button" forward-button + ["Move to Next Button" help-forward-button :help "Move to the Next Button in the help buffer"] ["View Source" help-view-source :help "Go to the source file for the current help item"] @@ -134,6 +148,9 @@ help-xref-stack-forward-item The format is (FUNCTION ARGS...).") (put 'help-xref-stack-forward-item 'permanent-local t) +(defvar-local help-link nil + "A connection to a help-mode buffer from another buffer.") + (setq-default help-xref-stack nil help-xref-stack-item nil) (setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil) @@ -151,6 +168,48 @@ help-mode-hook :type 'hook :group 'help) +;; help function to help choose a help window to act on: +(defun help-window (&optional only-selected-frame) + "Return a help window from the list of all windows. + +If the current buffer is already a help buffer return selected +window, else find a help window from the list of visible help buffers. +When ONLY-SELECTED-FRAME is true, consider window list only on +selected frame. + +When invoked with a numeric prefix N return a help window named *help*. +When called with a non-numeric prefix, C-u C-u, create a connection to a help +window that will be used as the default for further choice in case of multiple +help windows. If the connection is set, C-u prefix can bes used to act on +another help window but the connected one." + (let* ((all-frames (not only-selected-frame)) + window) + (cond ((equal current-prefix-arg '(16)) ; always ask + (setq help-link nil + current-prefix-arg nil + window (find-window-for-help 'help-mode all-frames)) + (when window (setq help-link window))) + ((equal current-prefix-arg '(4)) ; do in other help window + (setq current-prefix-arg nil + window (find-window-for-help + 'help-mode all-frames + (unless (eq major-mode 'help-mode) help-link)))) + ((and (not current-prefix-arg) (eq major-mode 'help-mode)) + (setq window (selected-window))) + (t + (setq window (if (and help-link + (window-live-p help-link) + (not (numberp current-prefix-arg))) + help-link + (find-window-for-help 'help-mode all-frames))))) + (unless window + (user-error + (if (numberp current-prefix-arg) + (format "No help buffer named *help*<%s> found." + current-prefix-arg) + "There are no visible help buffers."))) + window)) + ;; Button types used by help (define-button-type 'help-xref @@ -763,7 +822,73 @@ help-xref-on-pp ;;;###autoload (define-obsolete-function-alias 'help-xref-interned #'describe-symbol "25.1") + +;; commands from special-mode wrapped to work on help-mode only +(defun help-quit-window () + "As `quit-window' but works only on *Help* buffer." + (interactive) + (with-selected-window (help-window) + (quit-window nil (selected-window)))) + +(defun help-describe-mode () + "As `describe-mode' but for *Help* buffer only." + (interactive) + (with-selected-window (help-window) + (with-current-buffer (window-buffer) + (describe-mode)))) + +(defun help-beginning-of-buffer () + "As `help-beginning-of-buffer' but for *Help* buffer only." + (interactive) + (with-selected-window (help-window) + (goto-char (point-min)))) + +(defun help-end-of-buffer () + "As `help-end-of-buffer' but for *Help* buffer only." + (interactive) + (with-selected-window (help-window) + (goto-char (point-max)))) + +;; from files.el, for completeness and to eliminate potential confusion +(defun help-revert-buffer () + "As `revert-buffer', but act on help buffer specifically." + (interactive) + (with-selected-window (help-window) + (call-interactively #'revert-buffer))) + +;; Commands from button.el wrapped to work on help-mode only +(defun help-forward-button () + (interactive) + (with-selected-window (help-window) + (forward-button 1))) + +(defun help-backward-button () + (interactive) + (with-selected-window (help-window) + (backward-button 1))) + +(defun help-button-describe () + (interactive) + (with-selected-window (help-window) + (button-describe))) +(defun help-push-button () + (interactive) + (with-selected-window (help-window) + (push-button))) + +;; Commands from window.el wrapped to work on help-mode only +(defun help-scroll-up-command (&optional arg) + "As `scroll-up-command' but works only on *Help* buffer." + (interactive "^P") + (with-selected-window (help-window) + (scroll-up-command arg))) + +(defun help-scroll-down-command (&optional arg) + "As `scroll-down-command' but works only on *Help* buffer." + (interactive "^P") + (with-selected-window (help-window) + (scroll-down-command arg))) ;; Navigation/hyperlinking with xrefs @@ -810,25 +935,28 @@ help-xref-go-forward (defun help-go-back () "Go back to previous topic in this help buffer." (interactive) - (if help-xref-stack - (help-xref-go-back (current-buffer)) - (user-error "No previous help buffer"))) + (with-selected-window (help-window) + (if help-xref-stack + (help-xref-go-back (current-buffer)) + (user-error "No previous help buffer")))) (defun help-go-forward () "Go to the next topic in this help buffer." (interactive) - (if help-xref-forward-stack - (help-xref-go-forward (current-buffer)) - (user-error "No next help buffer"))) + (with-selected-window (help-window) + (if help-xref-forward-stack + (help-xref-go-forward (current-buffer)) + (user-error "No next help buffer")))) (defun help-goto-next-page () "Go to the next page (if any) in the current buffer. The help buffers are divided into \"pages\" by the ^L character." (interactive nil help-mode) - (push-mark) - (forward-page) - (unless (eobp) - (forward-line 1))) + (with-selected-window (help-window) + (push-mark) + (forward-page) + (unless (eobp) + (forward-line 1)))) (defun help-goto-previous-page () "Go to the previous page (if any) in the current buffer. @@ -836,47 +964,52 @@ help-goto-previous-page The help buffers are divided into \"pages\" by the ^L character." (interactive nil help-mode) - (push-mark) - (backward-page (if (looking-back "\f\n" (- (point) 5)) 2 1)) - (unless (bobp) - (forward-line 1))) + (with-selected-window (help-window) + (push-mark) + (backward-page (if (looking-back "\f\n" (- (point) 5)) 2 1)) + (unless (bobp) + (forward-line 1)))) (defun help-view-source () "View the source of the current help item." (interactive nil help-mode) - (unless (plist-get help-mode--current-data :file) - (error "Source file for the current help item is not defined")) - (help-function-def--button-function - (plist-get help-mode--current-data :symbol) - (plist-get help-mode--current-data :file) - (plist-get help-mode--current-data :type))) + (with-selected-window (help-window) + (unless (plist-get help-mode--current-data :file) + (error "Source file for the current help item is not defined")) + (help-function-def--button-function + (plist-get help-mode--current-data :symbol) + (plist-get help-mode--current-data :file) + (plist-get help-mode--current-data :type)))) (defun help-goto-info () "View the *info* node of the current help item." (interactive nil help-mode) - (unless help-mode--current-data - (error "No symbol to look up in the current buffer")) - (info-lookup-symbol (plist-get help-mode--current-data :symbol) - 'emacs-lisp-mode - help-window-keep-selected)) + (with-selected-window (help-window) + (unless help-mode--current-data + (error "No symbol to look up in the current buffer")) + (info-lookup-symbol (plist-get help-mode--current-data :symbol) + 'emacs-lisp-mode + help-window-keep-selected))) (defun help-goto-lispref-info () "View the Emacs Lisp manual *info* node of the current help item." (interactive nil help-mode) - (unless help-mode--current-data - (error "No symbol to look up in the current buffer")) - (info-lookup-symbol (plist-get help-mode--current-data :symbol) - 'emacs-lisp-only)) + (with-selected-window (help-window) + (unless help-mode--current-data + (error "No symbol to look up in the current buffer")) + (info-lookup-symbol (plist-get help-mode--current-data :symbol) + 'emacs-lisp-only))) (defun help-customize () "Customize variable or face whose doc string is shown in the current buffer." (interactive nil help-mode) - (let ((sym (plist-get help-mode--current-data :symbol))) - (unless (or (boundp sym) (facep sym)) - (user-error "No variable or face to customize")) - (cond - ((boundp sym) (customize-variable sym)) - ((facep sym) (customize-face sym))))) + (with-selected-window (help-window) + (let ((sym (plist-get help-mode--current-data :symbol))) + (unless (or (boundp sym) (facep sym)) + (user-error "No variable or face to customize")) + (cond + ((boundp sym) (customize-variable sym)) + ((facep sym) (customize-face sym)))))) (defun help-do-xref (_pos function args) "Call the help cross-reference function FUNCTION with args ARGS. diff --git a/lisp/info.el b/lisp/info.el index 035dff66e75..d32ffb64172 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -400,6 +400,54 @@ Info-virtual-nodes (defvar-local Info-current-node-virtual nil "Non-nil if the current Info node is virtual.") +(defvar-local Info-link nil + "A connection to an Info-mode buffer.") + +(defun info-window (&optional only-selected-frame) + "Return an info window from the list of all windows. + +If the current buffer is already an info buffer return selected +window, else find an info window from the list of visible info buffers. +When ONLY-SELECTED-FRAME is true, consider window list only on +selected frame. + +When invoked with a numeric prefix N return info window named *info*. +When called with a non-numeric prefix, C-u C-u, create a connection to an Info +window that will be used as the default for further choice in case of multiple +info windows. If the connection is set, C-u prefix can bes used to acto on other +info window but the connected one. + +This function memoizes its result in symbols value slot. The last +result is not preserved between function calls." + (let* ((all-frames (not only-selected-frame)) + window) + (cond ((equal current-prefix-arg '(16)) ; always ask + (setq Info-link nil + current-prefix-arg nil + window (find-window-for-help 'Info-mode all-frames)) + (when window (setq Info-link window))) + ((equal current-prefix-arg '(4)) ; do in other info window + (setq current-prefix-arg nil + window (find-window-for-help + 'Info-mode all-frames + (unless (eq major-mode 'Info-mode) + Info-link)))) + ((and (not current-prefix-arg) (eq major-mode 'Info-mode)) + (setq window (selected-window))) + (t + (setq window (if (and Info-link + (window-live-p Info-link) + (not (numberp current-prefix-arg))) + Info-link + (find-window-for-help 'Info-mode all-frames))))) + (unless window + (user-error + (if (numberp current-prefix-arg) + (format "No info buffer named *info*<%s> found." + current-prefix-arg) + "There are no visible info buffers."))) + window)) + (defun Info-virtual-file-p (filename) "Check if Info file FILENAME is virtual." (Info-virtual-fun 'find-file filename nil)) @@ -787,7 +835,7 @@ info-setup (if (and (zerop (buffer-size)) (null Info-history)) ;; If we just created the Info buffer, go to the directory. - (Info-directory)))) + (Info-directory (selected-window))))) ;;;###autoload (defun info-emacs-manual () @@ -831,12 +879,12 @@ info-standalone ;; The return value is the value of point at the beginning of matching ;; REGEXP, if the function succeeds, nil otherwise. (defun Info-node-at-bob-matching (regexp) - (and (bobp) ; are we at beginning of buffer? - (looking-at "\^_") ; does it begin with node delimiter? + (and (bobp) ; are we at beginning of buffer? + (looking-at "\^_") ; does it begin with node delimiter? (let (beg) (forward-line 1) (setq beg (point)) - (forward-line 1) ; does the line after delimiter match REGEXP? + (forward-line 1) ; does the line after delimiter match REGEXP? (re-search-backward regexp beg t)))) (defun Info-find-file (filename &optional noerror no-pop-to-dir) @@ -2269,89 +2317,84 @@ Info-following-node-name (and (looking-at (Info-following-node-name-re)) (match-string-no-properties 1))) -(defun Info-next () +(defun Info-next (&optional window) "Go to the \"next\" node, staying on the same hierarchical level. This command doesn't descend into sub-nodes, like \\\\[Info-forward-node] does." (interactive nil Info-mode) - ;; In case another window is currently selected - (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (with-selected-window (or window (info-window)) (Info-goto-node (Info-extract-pointer "next")))) -(defun Info-prev () +(defun Info-prev (&optional window) "Go to the \"previous\" node, staying on the same hierarchical level. This command doesn't go up to the parent node, like \\\\[Info-backward-node] does." (interactive nil Info-mode) - ;; In case another window is currently selected - (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (with-selected-window (or window (info-window)) (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))) -(defun Info-up (&optional same-file) +(defun Info-up (&optional same-file window) "Go to the superior node of this node. If SAME-FILE is non-nil, do not move to a different Info file." (interactive nil Info-mode) - ;; In case another window is currently selected - (save-window-excursion - (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) + (with-selected-window (or window (info-window)) (let ((old-node Info-current-node) - (old-file Info-current-file) - (node (Info-extract-pointer "up")) p) + (old-file Info-current-file) + (node (Info-extract-pointer "up")) p) (and same-file - (string-match "^(" node) - (error "Up node is in another Info file")) + (string-match "^(" node) + (error "Up node is in another Info file")) (Info-goto-node node) (setq p (point)) (goto-char (point-min)) (if (and (stringp old-file) - (search-forward "\n* Menu:" nil t) - (re-search-forward - (if (string-equal old-node "Top") - (concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")") - (concat "\n\\* +\\(" (regexp-quote old-node) - ":\\|[^:]+: +" (regexp-quote old-node) "\\)")) - nil t)) - (progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2))) - (goto-char p) - (Info-restore-point Info-history)))) - ;; If scroll-conservatively is non-zero and less than 101, display - ;; as much of the superior node above the target line as possible. - (when (< 0 scroll-conservatively 101) - (recenter))) + (search-forward "\n* Menu:" nil t) + (re-search-forward + (if (string-equal old-node "Top") + (concat "\n\\*[^:]+: +(" (file-name-nondirectory old-file) ")") + (concat "\n\\* +\\(" (regexp-quote old-node) + ":\\|[^:]+: +" (regexp-quote old-node) "\\)")) + nil t)) + (progn (beginning-of-line) (if (looking-at "^\\* ") (forward-char 2))) + (goto-char p) + (Info-restore-point Info-history))) + ;; If scroll-conservatively is non-zero and less than 101, display + ;; as much of the superior node above the target line as possible. + (when (< 0 scroll-conservatively 101) (recenter)))) (defun Info-history-back () "Go back in the history to the last node visited." (interactive nil Info-mode) - (or Info-history - (user-error "This is the first Info node you looked at")) - (let ((history-forward - (cons (list Info-current-file Info-current-node (point)) - Info-history-forward)) - filename nodename opoint) - (setq filename (car (car Info-history))) - (setq nodename (car (cdr (car Info-history)))) - (setq opoint (car (cdr (cdr (car Info-history))))) - (setq Info-history (cdr Info-history)) - (Info-find-node filename nodename) - (setq Info-history (cdr Info-history)) - (setq Info-history-forward history-forward) - (goto-char opoint))) + (with-selected-window (info-window) + (or Info-history + (user-error "This is the first Info node you looked at")) + (let ((history-forward + (cons (list Info-current-file Info-current-node (point)) + Info-history-forward)) + filename nodename opoint) + (setq filename (car (car Info-history))) + (setq nodename (car (cdr (car Info-history)))) + (setq opoint (car (cdr (cdr (car Info-history))))) + (setq Info-history (cdr Info-history)) + (Info-find-node filename nodename) + (setq Info-history (cdr Info-history)) + (setq Info-history-forward history-forward) + (goto-char opoint)))) (defalias 'Info-last 'Info-history-back) (defun Info-history-forward () "Go forward in the history of visited nodes." (interactive nil Info-mode) - (or Info-history-forward - (user-error "This is the last Info node you looked at")) - (let ((history-forward (cdr Info-history-forward)) - filename nodename opoint) - (setq filename (car (car Info-history-forward))) - (setq nodename (car (cdr (car Info-history-forward)))) - (setq opoint (car (cdr (cdr (car Info-history-forward))))) - (Info-find-node filename nodename) - (setq Info-history-forward history-forward) - (goto-char opoint))) + (with-selected-window (info-window) + (or Info-history-forward + (user-error "This is the last Info node you looked at")) + (let ((history-forward (cdr Info-history-forward)) + filename nodename opoint) + (setq filename (car (car Info-history-forward))) + (setq nodename (car (cdr (car Info-history-forward)))) + (setq opoint (car (cdr (cdr (car Info-history-forward))))) + (Info-find-node filename nodename) + (setq Info-history-forward history-forward) + (goto-char opoint)))) (add-to-list 'Info-virtual-files '("\\`dir\\'" @@ -2374,10 +2417,11 @@ Info-directory-find-node (Info-insert-dir)) ;;;###autoload -(defun Info-directory () +(defun Info-directory (&optional window) "Go to the Info directory node." (interactive) - (Info-find-node "dir" "top")) + (with-selected-window (or window (info-window)) + (Info-find-node "dir" "top"))) (add-to-list 'Info-virtual-files '("\\`\\*History\\*\\'" @@ -2416,9 +2460,10 @@ Info-history-find-node (defun Info-history () "Go to a node with a menu of visited nodes." (interactive nil Info-mode) - (Info-find-node "*History*" "Top") - (Info-next-reference) - (Info-next-reference)) + (with-selected-window (info-window) + (Info-find-node "*History*" "Top") + (Info-next-reference) + (Info-next-reference))) (add-to-list 'Info-virtual-nodes '("\\`\\*TOC\\*\\'" @@ -2453,12 +2498,13 @@ Info-toc "Go to a node with table of contents of the current Info file. Table of contents is created from the tree structure of menus." (interactive nil Info-mode) - (Info-find-node Info-current-file "*TOC*") - (let ((prev-node (nth 1 (car Info-history))) p) - (goto-char (point-min)) - (if (setq p (search-forward (concat "*Note " prev-node ":") nil t)) - (setq p (- p (length prev-node) 2))) - (goto-char (or p (point-min))))) + (with-selected-window (info-window) + (Info-find-node Info-current-file "*TOC*") + (let ((prev-node (nth 1 (car Info-history))) p) + (goto-char (point-min)) + (if (setq p (search-forward (concat "*Note " prev-node ":") nil t)) + (setq p (- p (length prev-node) 2))) + (goto-char (or p (point-min)))))) (defun Info-toc-insert (nodes node-list level curr-file) "Insert table of contents with references to nodes." @@ -2568,7 +2614,7 @@ Info-toc-nodes (cdr (assoc filename Info-toc-nodes))))) -(defun Info-follow-reference (footnotename &optional fork) +(defun Info-follow-reference (footnotename &optional fork window) "Follow cross reference named FOOTNOTENAME to the node it refers to. FOOTNOTENAME may be an abbreviation of the reference name. If FORK is non-nil (interactively with a prefix arg), show the node in @@ -2577,91 +2623,96 @@ Info-follow-reference (interactive (let ((completion-ignore-case t) (case-fold-search t) + (window (info-window)) completions default alt-default (start-point (point)) str i bol eol) - (save-excursion - ;; Store end and beginning of line. - (setq eol (line-end-position) - bol (line-beginning-position)) - (goto-char (point-min)) - (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t) - (setq str (match-string-no-properties 1)) - ;; See if this one should be the default. - (and (null default) - (<= (match-beginning 0) start-point) - (<= start-point (point)) - (setq default t)) - ;; See if this one should be the alternate default. - (and (null alt-default) - (and (<= bol (match-beginning 0)) - (<= (point) eol)) - (setq alt-default t)) - (setq i 0) - (while (setq i (string-match "[ \n\t]+" str i)) - (setq str (concat (substring str 0 i) " " - (substring str (match-end 0)))) - (setq i (1+ i))) - ;; Record as a completion and perhaps as default. - (if (eq default t) (setq default str)) - (if (eq alt-default t) (setq alt-default str)) - ;; Don't add this string if it's a duplicate. - (or (assoc-string str completions t) - (push str completions))) - (setq completions (nreverse completions))) - ;; If no good default was found, try an alternate. - (or default - (setq default alt-default)) - ;; If only one cross-reference found, then make it default. - (if (eq (length completions) 1) - (setq default (car completions))) - (if completions - (let ((input (completing-read (format-prompt "Follow reference named" - default) - completions nil t))) - (list (if (equal input "") - default input) - current-prefix-arg)) - (user-error "No cross-references in this node"))) - Info-mode) - - (unless footnotename - (error "No reference was specified")) - - (let (target i (str (concat "\\*note " (regexp-quote footnotename))) - (case-fold-search t)) - (while (setq i (string-search " " str i)) - (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i)))) - (setq i (+ i 6))) - (save-excursion - ;; Move point to the beginning of reference if point is on reference - (or (looking-at "\\*note[ \n\t]+") - (and (looking-back "\\*note[ \n\t]+" - (save-excursion (skip-chars-backward " \n\t") - (line-beginning-position))) - (goto-char (match-beginning 0))) - (if (and (save-excursion - (goto-char (+ (point) 5)) ; skip a possible *note - (re-search-backward "\\*note[ \n\t]+" nil t) - (looking-at str)) - (<= (point) (match-end 0))) - (goto-char (match-beginning 0)))) - ;; Go to the reference closest to point - (let ((next-ref (save-excursion (and (re-search-forward str nil t) - (+ (match-beginning 0) 5)))) - (prev-ref (save-excursion (and (re-search-backward str nil t) - (+ (match-beginning 0) 5))))) - (goto-char (cond ((and next-ref prev-ref) - (if (< (abs (- next-ref (point))) - (abs (- prev-ref (point)))) - next-ref prev-ref)) - ((or next-ref prev-ref)) - ((user-error "No cross-reference named %s" - footnotename)))) - (setq target (Info-extract-menu-node-name t)))) - (while (setq i (string-match "[ \t\n]+" target i)) - (setq target (concat (substring target 0 i) " " - (substring target (match-end 0)))) - (setq i (+ i 1))) - (Info-goto-node target fork))) + (with-current-buffer (window-buffer window) + (save-excursion + ;; Store end and beginning of line. + (setq eol (line-end-position) + bol (line-beginning-position)) + (goto-char (point-min)) + (while (re-search-forward "\\*note[ \n\t]+\\([^:]*\\):" nil t) + (setq str (match-string-no-properties 1)) + ;; See if this one should be the default. + (and (null default) + (<= (match-beginning 0) start-point) + (<= start-point (point)) + (setq default t)) + ;; See if this one should be the alternate default. + (and (null alt-default) + (and (<= bol (match-beginning 0)) + (<= (point) eol)) + (setq alt-default t)) + (setq i 0) + (while (setq i (string-match "[ \n\t]+" str i)) + (setq str (concat (substring str 0 i) " " + (substring str (match-end 0)))) + (setq i (1+ i))) + ;; Record as a completion and perhaps as default. + (if (eq default t) (setq default str)) + (if (eq alt-default t) (setq alt-default str)) + ;; Don't add this string if it's a duplicate. + (or (assoc-string str completions t) + (push str completions))) + (setq completions (nreverse completions))) + ;; If no good default was found, try an alternate. + (or default + (setq default alt-default)) + ;; If only one cross-reference found, then make it default. + (if (eq (length completions) 1) + (setq default (car completions))) + (if completions + (let ((input (completing-read (format-prompt "Follow reference named" + default) + completions nil t))) + (list (if (equal input "") + default input) + current-prefix-arg)) + (user-error "No cross-references in this node"))) + (list Info-mode window))) + (let ((window (if (called-interactively-p 'any) + (get 'Info-follow-reference :selected-window) + (info-window)))) + (with-selected-window window + (unless footnotename + (error "No reference was specified")) + (let (target i (str (concat "\\*note " (regexp-quote footnotename))) + (case-fold-search t)) + (while (setq i (string-search " " str i)) + (setq str (concat (substring str 0 i) + "[ \t\n]+" (substring str (1+ i)))) + (setq i (+ i 6))) + (save-excursion + ;; Move point to the beginning of reference if point is on reference + (or (looking-at "\\*note[ \n\t]+") + (and (looking-back "\\*note[ \n\t]+" + (save-excursion (skip-chars-backward " \n\t") + (line-beginning-position))) + (goto-char (match-beginning 0))) + (if (and (save-excursion + (goto-char (+ (point) 5)) ; skip a possible *note + (re-search-backward "\\*note[ \n\t]+" nil t) + (looking-at str)) + (<= (point) (match-end 0))) + (goto-char (match-beginning 0)))) + ;; Go to the reference closest to point + (let ((next-ref (save-excursion (and (re-search-forward str nil t) + (+ (match-beginning 0) 5)))) + (prev-ref (save-excursion (and (re-search-backward str nil t) + (+ (match-beginning 0) 5))))) + (goto-char (cond ((and next-ref prev-ref) + (if (< (abs (- next-ref (point))) + (abs (- prev-ref (point)))) + next-ref prev-ref)) + ((or next-ref prev-ref)) + ((user-error "No cross-reference named %s" + footnotename)))) + (setq target (Info-extract-menu-node-name t)))) + (while (setq i (string-match "[ \t\n]+" target i)) + (setq target (concat (substring target 0 i) " " + (substring target (match-end 0)))) + (setq i (+ i 1))) + (Info-goto-node target fork))))) (defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*" ;; We allow newline because this is also used in Info-follow-reference, @@ -2788,8 +2839,7 @@ Info-complete-menu-item Info-complete-nodes))) (complete-with-action action completions string predicate)))))))) - -(defun Info-menu (menu-item &optional fork) +(defun Info-menu (menu-item &optional fork window) "Go to the node pointed to by the menu item named (or abbreviated) MENU-ITEM. The menu item should one of those listed in the current node's menu. Completion is allowed, and the default menu item is the one point is on. @@ -2798,38 +2848,39 @@ Info-menu new buffer." (interactive (let (;; If point is within a menu item, use that item as the default - (default nil) - (p (point)) - beg - (case-fold-search t)) - (save-excursion - (goto-char (point-min)) - (if (not (search-forward "\n* menu:" nil t)) - (user-error "No menu in this node")) - (setq beg (point)) - (and (< (point) p) - (save-excursion - (goto-char p) - (end-of-line) - (if (re-search-backward (concat "\n\\* +\\(" - Info-menu-entry-name-re - "\\):") - beg t) - (setq default (match-string-no-properties 1)))))) - (let ((item nil)) - (while (null item) - (setq item (let ((completion-ignore-case t) - (Info-complete-menu-buffer (current-buffer))) - (completing-read (format-prompt "Menu item" default) - #'Info-complete-menu-item nil t nil nil - default)))) - (list item current-prefix-arg))) + (default nil) + (p (point)) + beg + (case-fold-search t) + (window (info-window))) + (with-current-buffer (window-buffer window) + (save-excursion + (goto-char (point-min)) + (if (not (search-forward "\n* menu:" nil t)) + (user-error "No menu in this node")) + (setq beg (point)) + (and (< (point) p) + (save-excursion + (goto-char p) + (end-of-line) + (if (re-search-backward (concat "\n\\* +\\(" + Info-menu-entry-name-re + "\\):") + beg t) + (setq default (match-string-no-properties 1)))))) + (let ((item nil)) + (while (null item) + (setq item (let ((completion-ignore-case t) + (Info-complete-menu-buffer (current-buffer))) + (completing-read (format-prompt "Menu item" default) + #'Info-complete-menu-item nil t nil nil + default)))) + (list item current-prefix-arg window)))) Info-mode) - ;; there is a problem here in that if several menu items have the same - ;; name you can only go to the node of the first with this command. - (Info-goto-node (Info-extract-menu-item menu-item) - (and fork - (if (stringp fork) fork menu-item)))) + (with-selected-window (or window (info-window)) + (Info-goto-node (Info-extract-menu-item menu-item) + (and fork + (if (stringp fork) fork menu-item))))) (defun Info-extract-menu-item (menu-item) (setq menu-item (regexp-quote menu-item)) @@ -2869,32 +2920,35 @@ Info-nth-menu-item "Go to the node of the Nth menu item. N is the digit argument used to invoke this command." (interactive nil Info-mode) - (Info-goto-node - (Info-extract-menu-counting - (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0)))) + (with-selected-window (info-window) + (Info-goto-node + (Info-extract-menu-counting + (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))) (defun Info-top-node () "Go to the Top node of this file." (interactive nil Info-mode) - (Info-goto-node "Top")) + (with-selected-window (info-window) + (Info-goto-node "Top"))) (defun Info-final-node () "Go to the final node in this file." (interactive nil Info-mode) - (Info-goto-node "Top") - (let ((Info-history nil) - (case-fold-search t)) - ;; Go to the last node in the menu of Top. But don't delve into - ;; detailed node listings. - (Info-goto-node (Info-extract-menu-counting nil t)) - ;; If the last node in the menu is not last in pointer structure, - ;; move forward (but not down- or upward - see bug#1116) until we - ;; can't go any farther. - (while (Info-forward-node t t t) nil) - ;; Then keep moving down to last subnode, unless we reach an index. - (while (and (not (Info-index-node)) - (save-excursion (search-forward "\n* Menu:" nil t))) - (Info-goto-node (Info-extract-menu-counting nil))))) + (with-selected-window (info-window) + (Info-goto-node "Top") + (let ((Info-history nil) + (case-fold-search t)) + ;; Go to the last node in the menu of Top. But don't delve into + ;; detailed node listings. + (Info-goto-node (Info-extract-menu-counting nil t)) + ;; If the last node in the menu is not last in pointer structure, + ;; move forward (but not down- or upward - see bug#1116) until we + ;; can't go any farther. + (while (Info-forward-node t t t) nil) + ;; Then keep moving down to last subnode, unless we reach an index. + (while (and (not (Info-index-node)) + (save-excursion (search-forward "\n* Menu:" nil t))) + (Info-goto-node (Info-extract-menu-counting nil)))))) (defun Info-forward-node (&optional not-down not-up no-error) "Go forward one node, considering all nodes as forming one sequence. @@ -2905,160 +2959,166 @@ Info-forward-node NOT-UP non-nil means don't go to parent nodes, and NO-ERROR non-nil means don't signal a user-error if there's no node to go to." (interactive nil Info-mode) - (goto-char (point-min)) - (forward-line 1) - (let ((case-fold-search t)) - ;; three possibilities, in order of priority: - ;; 1. next node is in a menu in this node (but not in an index) - ;; 2. next node is next at same level - ;; 3. next node is up and next - (cond ((and (not not-down) - (save-excursion (search-forward "\n* menu:" nil t)) - (not (Info-index-node))) - (Info-goto-node (Info-extract-menu-counting 1)) - t) - ((save-excursion (search-backward "next:" nil t)) - (Info-next) - t) - ((and (not not-up) - (save-excursion (search-backward "up:" nil t)) - ;; Use string-equal, not equal, to ignore text props. - (not (string-equal (downcase (Info-extract-pointer "up")) - "top"))) - (let ((old-node Info-current-node)) - (Info-up) - (let ((old-history Info-history) - success) - (unwind-protect - (setq success (Info-forward-node t nil no-error)) - (or success (Info-goto-node old-node))) - (if Info-history-skip-intermediate-nodes - (setq Info-history old-history))))) - (no-error nil) - (t (user-error "No pointer forward from this node"))))) + (with-selected-window (info-window) + (goto-char (point-min)) + (forward-line 1) + (let ((case-fold-search t)) + ;; three possibilities, in order of priority: + ;; 1. next node is in a menu in this node (but not in an index) + ;; 2. next node is next at same level + ;; 3. next node is up and next + (cond ((and (not not-down) + (save-excursion (search-forward "\n* menu:" nil t)) + (not (Info-index-node))) + (Info-goto-node (Info-extract-menu-counting 1)) + t) + ((save-excursion (search-backward "next:" nil t)) + (Info-next (selected-window)) + t) + ((and (not not-up) + (save-excursion (search-backward "up:" nil t)) + ;; Use string-equal, not equal, to ignore text props. + (not (string-equal (downcase (Info-extract-pointer "up")) + "top"))) + (let ((old-node Info-current-node)) + (Info-up nil (selected-window)) + (let ((old-history Info-history) + success) + (unwind-protect + (setq success (Info-forward-node t nil no-error)) + (or success (Info-goto-node old-node))) + (if Info-history-skip-intermediate-nodes + (setq Info-history old-history))))) + (no-error nil) + (t (user-error "No pointer forward from this node")))))) (defun Info-backward-node () "Go backward one node, considering all nodes as forming one sequence. If the current node has a \"previous\" node, go to it, descending into its last sub-node, if any; otherwise go \"up\" to the parent node." (interactive nil Info-mode) - (let ((prevnode (Info-extract-pointer "prev[ious]*" t)) - (upnode (Info-extract-pointer "up" t)) - (case-fold-search t)) - (cond ((and upnode (string-search "(" upnode)) - (user-error "First node in file")) - ((and upnode (or (null prevnode) - ;; Use string-equal, not equal, - ;; to ignore text properties. - (string-equal (downcase prevnode) - (downcase upnode)))) - (Info-up)) - (prevnode - ;; If we move back at the same level, - ;; go down to find the last subnode*. - (Info-prev) - (let ((old-history Info-history)) - (while (and (not (Info-index-node)) - (save-excursion (search-forward "\n* Menu:" nil t))) - (Info-goto-node (Info-extract-menu-counting nil))) - (if Info-history-skip-intermediate-nodes - (setq Info-history old-history)))) - (t - (user-error "No pointer backward from this node"))))) + (with-selected-window (info-window) + (let ((prevnode (Info-extract-pointer "prev[ious]*" t)) + (upnode (Info-extract-pointer "up" t)) + (case-fold-search t)) + (cond ((and upnode (string-search "(" upnode)) + (user-error "First node in file")) + ((and upnode (or (null prevnode) + ;; Use string-equal, not equal, + ;; to ignore text properties. + (string-equal (downcase prevnode) + (downcase upnode)))) + (Info-up nil (selected-window))) + (prevnode + ;; If we move back at the same level, + ;; go down to find the last subnode*. + (Info-prev (selected-window)) + (let ((old-history Info-history)) + (while (and (not (Info-index-node)) + (save-excursion (search-forward "\n* Menu:" nil t))) + (Info-goto-node (Info-extract-menu-counting nil))) + (if Info-history-skip-intermediate-nodes + (setq Info-history old-history)))) + (t + (user-error "No pointer backward from this node")))))) (define-obsolete-function-alias 'Info-exit #'quit-window "27.1") -(defun Info-next-menu-item () +(defun Info-next-menu-item (&optional window) "Go to the node of the next menu item." (interactive nil Info-mode) - ;; Bind this in case the user sets it to nil. - (let* ((case-fold-search t) - (node - (save-excursion - (forward-line -1) - (search-forward "\n* menu:" nil t) - (and (search-forward "\n* " nil t) - (Info-extract-menu-node-name))))) - (if node (Info-goto-node node) - (user-error "No more items in menu")))) + (with-selected-window (or window (info-window)) + ;; Bind this in case the user sets it to nil. + (let* ((case-fold-search t) + (node + (save-excursion + (forward-line -1) + (search-forward "\n* menu:" nil t) + (and (search-forward "\n* " nil t) + (Info-extract-menu-node-name))))) + (if node (Info-goto-node node) + (user-error "No more items in menu"))))) (defun Info-last-menu-item () "Go to the node of the previous menu item." (interactive nil Info-mode) - (save-excursion - (forward-line 1) - ;; Bind this in case the user sets it to nil. - (let* ((case-fold-search t) - (beg (save-excursion - (and (search-backward "\n* menu:" nil t) - (point))))) - (or (and beg (search-backward "\n* " beg t)) - (user-error "No previous items in menu"))) - (Info-goto-node (save-excursion - (goto-char (match-end 0)) - (Info-extract-menu-node-name))))) + (with-selected-window (info-window) + (save-excursion + (forward-line 1) + ;; Bind this in case the user sets it to nil. + (let* ((case-fold-search t) + (beg (save-excursion + (and (search-backward "\n* menu:" nil t) + (point))))) + (or (and beg (search-backward "\n* " beg t)) + (user-error "No previous items in menu"))) + (Info-goto-node (save-excursion + (goto-char (match-end 0)) + (Info-extract-menu-node-name)))))) (defmacro Info-no-error (&rest body) `(condition-case nil (progn ,@body t) (error nil))) -(defun Info-next-preorder () +(defun Info-next-preorder (&optional window) "Go to the next subnode or the next node, or go up a level." (interactive nil Info-mode) - (cond ((Info-no-error (Info-next-menu-item))) - ((Info-no-error (Info-next))) - ((Info-no-error (Info-up t)) - ;; Since we have already gone thru all the items in this menu, - ;; go up to the end of this node. - (goto-char (point-max)) - ;; Since logically we are done with the node with that menu, - ;; move on from it. But don't add intermediate nodes - ;; to the history on recursive calls. - (let ((old-history Info-history)) - (Info-next-preorder) - (if Info-history-skip-intermediate-nodes - (setq Info-history old-history)))) - (t - (user-error "No more nodes")))) - -(defun Info-last-preorder () + (with-selected-window (or window (info-window)) + (cond ((Info-no-error (Info-next-menu-item (selected-window)))) + ((Info-no-error (Info-next (selected-window)))) + ((Info-no-error (Info-up t)) + ;; Since we have already gone thru all the items in this menu, + ;; go up to the end of this node. + (goto-char (point-max)) + ;; Since logically we are done with the node with that menu, + ;; move on from it. But don't add intermediate nodes + ;; to the history on recursive calls. + (let ((old-history Info-history)) + (Info-next-preorder (selected-window)) + (if Info-history-skip-intermediate-nodes + (setq Info-history old-history)))) + (t + (user-error "No more nodes"))))) + +(defun Info-last-preorder (&optional window) "Go to the last node, popping up a level if there is none." (interactive nil Info-mode) - (cond ((and Info-scroll-prefer-subnodes - (Info-no-error - (Info-last-menu-item) - ;; If we go down a menu item, go to the end of the node - ;; so we can scroll back through it. - (goto-char (point-max)))) - ;; Keep going down, as long as there are nested menu nodes. - (let ((old-history Info-history)) - (while (Info-no-error - (Info-last-menu-item) - ;; If we go down a menu item, go to the end of the node - ;; so we can scroll back through it. - (goto-char (point-max)))) - (if Info-history-skip-intermediate-nodes - (setq Info-history old-history))) - (recenter -1)) - ((and (Info-no-error (Info-extract-pointer "prev")) - (not (equal (Info-extract-pointer "up") - (Info-extract-pointer "prev")))) - (Info-no-error (Info-prev)) - (goto-char (point-max)) - (let ((old-history Info-history)) - (while (Info-no-error - (Info-last-menu-item) - ;; If we go down a menu item, go to the end of the node - ;; so we can scroll back through it. - (goto-char (point-max)))) - (if Info-history-skip-intermediate-nodes - (setq Info-history old-history))) - (recenter -1)) - ((Info-no-error (Info-up t)) - (goto-char (point-min)) - (let ((case-fold-search t)) - (or (search-forward "\n* Menu:" nil t) - (goto-char (point-max))))) - (t (user-error "No previous nodes")))) + (with-selected-window (or window (info-window)) + (cond ((and Info-scroll-prefer-subnodes + (Info-no-error + (Info-last-menu-item) + ;; If we go down a menu item, go to the end of the node + ;; so we can scroll back through it. + (goto-char (point-max)))) + ;; Keep going down, as long as there are nested menu nodes. + (let ((old-history Info-history)) + (while (Info-no-error + (Info-last-menu-item) + ;; If we go down a menu item, go to the end of the node + ;; so we can scroll back through it. + (goto-char (point-max)))) + (if Info-history-skip-intermediate-nodes + (setq Info-history old-history))) + (recenter -1)) + ((and (Info-no-error (Info-extract-pointer "prev")) + (not (equal (Info-extract-pointer "up") + (Info-extract-pointer "prev")))) + (Info-no-error (Info-prev (selected-window))) + (goto-char (point-max)) + (let ((old-history Info-history)) + (while (Info-no-error + (Info-last-menu-item) + ;; If we go down a menu item, go to the end of the node + ;; so we can scroll back through it. + (goto-char (point-max)))) + (if Info-history-skip-intermediate-nodes + (setq Info-history old-history))) + (recenter -1)) + ((Info-no-error (Info-up t)) + (goto-char (point-min)) + (let ((case-fold-search t)) + (or (search-forward "\n* Menu:" nil t) + (goto-char (point-max))))) + (t (user-error "No previous nodes"))))) (defun Info-scroll-up () "Scroll one screenful forward in Info, considering all nodes as one sequence. @@ -3073,25 +3133,25 @@ Info-scroll-up the menu of a node, it moves to subnode indicated by the following menu item. (That case won't normally result from this command, but can happen in other ways.)" - (interactive nil Info-mode) - (if (or (< (window-start) (point-min)) - (> (window-start) (point-max))) - (set-window-start (selected-window) (point))) - (let* ((case-fold-search t) - (virtual-end (save-excursion - (goto-char (point-min)) - (if (and Info-scroll-prefer-subnodes - (search-forward "\n* Menu:" nil t)) - (point) - (point-max))))) - (if (or (< virtual-end (window-start)) - (pos-visible-in-window-p virtual-end)) - (cond - (Info-scroll-prefer-subnodes (Info-next-preorder)) - ((Info-no-error (Info-goto-node (Info-extract-menu-counting 1)))) - (t (Info-next-preorder))) - (scroll-up)))) + (with-selected-window (info-window) + (if (or (< (window-start) (point-min)) + (> (window-start) (point-max))) + (set-window-start (selected-window) (point))) + (let* ((case-fold-search t) + (virtual-end (save-excursion + (goto-char (point-min)) + (if (and Info-scroll-prefer-subnodes + (search-forward "\n* Menu:" nil t)) + (point) + (point-max))))) + (if (or (< virtual-end (window-start)) + (pos-visible-in-window-p virtual-end)) + (cond + (Info-scroll-prefer-subnodes (Info-next-preorder (selected-window))) + ((Info-no-error (Info-goto-node (Info-extract-menu-counting 1)))) + (t (Info-next-preorder (selected-window)))) + (scroll-up))))) (defun Info-mouse-scroll-up (e) "Scroll one screenful forward in Info, using the mouse. @@ -3109,21 +3169,22 @@ Info-scroll-down beginning of a node, that goes to the previous node or back up to the parent node." (interactive nil Info-mode) - (if (or (< (window-start) (point-min)) - (> (window-start) (point-max))) - (set-window-start (selected-window) (point))) - (let* ((case-fold-search t) - (current-point (point)) - (virtual-end - (and Info-scroll-prefer-subnodes - (save-excursion - (setq current-point (line-beginning-position)) - (goto-char (point-min)) - (search-forward "\n* Menu:" current-point t))))) - (if (or virtual-end - (pos-visible-in-window-p (point-min) nil t)) - (Info-last-preorder) - (scroll-down)))) + (with-selected-window (info-window) + (if (or (< (window-start) (point-min)) + (> (window-start) (point-max))) + (set-window-start (selected-window) (point))) + (let* ((case-fold-search t) + (current-point (point)) + (virtual-end + (and Info-scroll-prefer-subnodes + (save-excursion + (setq current-point (line-beginning-position)) + (goto-char (point-min)) + (search-forward "\n* Menu:" current-point t))))) + (if (or virtual-end + (pos-visible-in-window-p (point-min) nil t)) + (Info-last-preorder (selected-window)) + (scroll-down))))) (defun Info-mouse-scroll-down (e) "Scroll one screenful backward in Info, using the mouse. @@ -3170,60 +3231,62 @@ Info-prev-reference-or-link (goto-char plink)) (if pxref (goto-char (or (match-beginning 1) (match-beginning 0))))))) -(defun Info-next-reference (&optional recur count) +(defun Info-next-reference (&optional recur count window) "Move cursor to the next cross-reference or menu item in the node. If COUNT is non-nil (interactively with a prefix arg), jump over COUNT cross-references." (interactive "i\np" Info-mode) - (unless count - (setq count 1)) - (if (< count 0) - (Info-prev-reference recur (- count)) - (while (unless (zerop count) (setq count (1- count))) - (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://") - (old-pt (point)) - (case-fold-search t)) - (or (eobp) (forward-char 1)) - (or (Info-next-reference-or-link pat 'link) - (progn - (goto-char (point-min)) - (or (Info-next-reference-or-link pat 'link) - (progn - (goto-char old-pt) - (user-error "No cross references in this node"))))) - (if (looking-at "\\* Menu:") - (if recur - (user-error "No cross references in this node") - (Info-next-reference t)) - (if (looking-at "^\\* ") - (forward-char 2))))))) - -(defun Info-prev-reference (&optional recur count) + (with-selected-window (or window (info-window)) + (unless count + (setq count 1)) + (if (< count 0) + (Info-prev-reference recur (- count) (selected-window)) + (while (unless (zerop count) (setq count (1- count))) + (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://") + (old-pt (point)) + (case-fold-search t)) + (or (eobp) (forward-char 1)) + (or (Info-next-reference-or-link pat 'link) + (progn + (goto-char (point-min)) + (or (Info-next-reference-or-link pat 'link) + (progn + (goto-char old-pt) + (user-error "No cross references in this node"))))) + (if (looking-at "\\* Menu:") + (if recur + (user-error "No cross references in this node") + (Info-next-reference t nil (selected-window))) + (if (looking-at "^\\* ") + (forward-char 2)))))))) + +(defun Info-prev-reference (&optional recur count window) "Move cursor to the previous cross-reference or menu item in the node. If COUNT is non-nil (interactively with a prefix arg), jump over COUNT cross-references." (interactive "i\np" Info-mode) - (unless count - (setq count 1)) - (if (< count 0) - (Info-next-reference recur (- count)) - (while (unless (zerop count) (setq count (1- count))) - (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://") - (old-pt (point)) - (case-fold-search t)) - (or (Info-prev-reference-or-link pat 'link) - (progn - (goto-char (point-max)) - (or (Info-prev-reference-or-link pat 'link) - (progn - (goto-char old-pt) - (user-error "No cross references in this node"))))) - (if (looking-at "\\* Menu:") - (if recur - (user-error "No cross references in this node") - (Info-prev-reference t)) - (if (looking-at "^\\* ") - (forward-char 2))))))) + (with-selected-window (or window (info-window)) + (unless count + (setq count 1)) + (if (< count 0) + (Info-next-reference recur (- count) (selected-window)) + (while (unless (zerop count) (setq count (1- count))) + (let ((pat "\\*note[ \n\t]+\\([^:]+\\):\\|^\\* .*:\\|[hf]t?tps?://") + (old-pt (point)) + (case-fold-search t)) + (or (Info-prev-reference-or-link pat 'link) + (progn + (goto-char (point-max)) + (or (Info-prev-reference-or-link pat 'link) + (progn + (goto-char old-pt) + (user-error "No cross references in this node"))))) + (if (looking-at "\\* Menu:") + (if recur + (user-error "No cross references in this node") + (Info-prev-reference t nil (selected-window))) + (if (looking-at "^\\* ") + (forward-char 2)))))))) (defun Info-index-nodes (&optional file) "Return a list of names of all index nodes in Info FILE. @@ -3337,72 +3400,80 @@ info--ensure-not-in-directory-node "type \\[Info-menu] to select a manual"))))) ;;;###autoload -(defun Info-index (topic) +(defun Info-index (topic &optional window) "Look up a string TOPIC in the index for this manual and go to that entry. If there are no exact matches to the specified topic, this chooses the first match which is a case-insensitive substring of a topic. Use the \\\\[Info-index-next] command to see the other matches. Give an empty topic name to go to the Index node itself." (interactive - (list - (let ((completion-ignore-case t) - (Info-complete-menu-buffer (clone-buffer)) - (Info-complete-nodes (Info-index-nodes)) - (Info-history-list nil)) - (info--ensure-not-in-directory-node) - (unwind-protect - (with-current-buffer Info-complete-menu-buffer - (Info-goto-index) - (completing-read "Index topic: " #'Info-complete-menu-item)) - (kill-buffer Info-complete-menu-buffer))))) - (info--ensure-not-in-directory-node) - ;; Strip leading colon in topic; index format does not allow them. - (if (and (stringp topic) - (> (length topic) 0) - (= (aref topic 0) ?:)) - (setq topic (substring topic 1))) - (let ((orignode Info-current-node) - (pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" - (regexp-quote topic))) - node (nodes (Info-index-nodes)) - (ohist-list Info-history-list) - (case-fold-search t)) - (Info-goto-index) - (or (equal topic "") - (let ((matches nil) - (exact nil) - ;; We bind Info-history to nil for internal node-switches so - ;; that we don't put junk in the history. In the first - ;; Info-goto-index call, above, we do update the history - ;; because that is what the user's previous node choice into it. - (Info-history nil) - found) - (while - (progn - (goto-char (point-min)) - (while (re-search-forward pattern nil t) - (let ((entry (match-string-no-properties 1)) - (nodename (match-string-no-properties 3)) - (line (string-to-number (concat "0" (match-string 4))))) - (add-text-properties - (- (match-beginning 2) (match-beginning 1)) - (- (match-end 2) (match-beginning 1)) - '(face info-index-match) entry) - (push (list entry nodename Info-current-node line) matches))) - (setq nodes (cdr nodes) node (car nodes))) - (Info-goto-node node)) - (or matches - (progn - (Info-goto-node orignode) - (user-error "No `%s' in index" topic))) - ;; Here it is a feature that assoc is case-sensitive. - (while (setq found (assoc topic matches)) - (setq exact (cons found exact) - matches (delq found matches))) - (setq Info-history-list ohist-list) - (setq Info-index-alternatives (nconc exact (nreverse matches)) - Info--current-index-alternative 0) - (Info-index-next 0))))) + (let ((frame-to-prompt-in (selected-frame)) + (window (info-window))) + (with-selected-window window + (list + (let ((completion-ignore-case t) + (Info-complete-menu-buffer (clone-buffer)) + (Info-complete-nodes (Info-index-nodes)) + (Info-history-list nil)) + (info--ensure-not-in-directory-node) + (unwind-protect + (with-current-buffer Info-complete-menu-buffer + (Info-goto-index) + (with-selected-frame frame-to-prompt-in + (completing-read "Index topic: " + #'Info-complete-menu-item))) + (kill-buffer Info-complete-menu-buffer))) + window))) + Info-mode) + (with-selected-window (or window (info-window)) + (info--ensure-not-in-directory-node) + ;; Strip leading colon in topic; index format does not allow them. + (if (and (stringp topic) + (> (length topic) 0) + (= (aref topic 0) ?:)) + (setq topic (substring topic 1))) + (let ((orignode Info-current-node) + (pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" + (regexp-quote topic))) + node (nodes (Info-index-nodes)) + (ohist-list Info-history-list) + (case-fold-search t)) + (Info-goto-index) + (or (equal topic "") + (let ((matches nil) + (exact nil) + ;; We bind Info-history to nil for internal node-switches so + ;; that we don't put junk in the history. In the first + ;; Info-goto-index call, above, we do update the history + ;; because that is what the user's previous node choice into it. + (Info-history nil) + found) + (while + (progn + (goto-char (point-min)) + (while (re-search-forward pattern nil t) + (let ((entry (match-string-no-properties 1)) + (nodename (match-string-no-properties 3)) + (line (string-to-number (concat "0" (match-string 4))))) + (add-text-properties + (- (match-beginning 2) (match-beginning 1)) + (- (match-end 2) (match-beginning 1)) + '(face info-index-match) entry) + (push (list entry nodename Info-current-node line) matches))) + (setq nodes (cdr nodes) node (car nodes))) + (Info-goto-node node)) + (or matches + (progn + (Info-goto-node orignode) + (user-error "No `%s' in index" topic))) + ;; Here it is a feature that assoc is case-sensitive. + (while (setq found (assoc topic matches)) + (setq exact (cons found exact) + matches (delq found matches))) + (setq Info-history-list ohist-list) + (setq Info-index-alternatives (nconc exact (nreverse matches)) + Info--current-index-alternative 0) + (Info-index-next 0)))))) (defun Info-index-next (num) "Go to the next matching index item from the last \\\\[Info-index] command. @@ -3411,45 +3482,46 @@ Info-index-next Also see the `Info-warn-on-index-alternatives-wrap' user option." (interactive "p" Info-mode) - (unless Info-index-alternatives - (user-error "No previous `i' command")) - (let ((index (+ Info--current-index-alternative num)) - (total (length Info-index-alternatives)) - (next-key (key-description (where-is-internal - 'Info-index-next overriding-local-map t)))) - (if (and Info-warn-on-index-alternatives-wrap - (> total 1) - (cond - ((< index 0) - (setq Info--current-index-alternative (- total 2)) - (message - "No previous matches, use `%s' to continue from end of list" - next-key) - t) - ((>= index total) - (setq Info--current-index-alternative -1) - (message - "No previous matches, use `%s' to continue from start of list" - next-key) - t))) - () ; Do nothing - (setq index (mod index total) - Info--current-index-alternative index) - (let ((entry (nth index Info-index-alternatives))) - (Info-goto-node (nth 1 entry)) - (if (> (nth 3 entry) 0) - ;; Forward 2 lines less because `Info-find-node-2' initially - ;; puts point to the 2nd line. - (forward-line (- (nth 3 entry) 2)) - (forward-line 3) ; don't search in headers - (Info-find-index-name (car entry))) - (message "Found `%s' in %s. %s" - (car entry) - (nth 2 entry) - (if (> total 1) - (format-message - "(%s total; use `%s' for next)" total next-key) - "(Only match)")))))) + (with-selected-window (info-window) + (unless Info-index-alternatives + (user-error "No previous `i' command")) + (let ((index (+ Info--current-index-alternative num)) + (total (length Info-index-alternatives)) + (next-key (key-description (where-is-internal + 'Info-index-next overriding-local-map t)))) + (if (and Info-warn-on-index-alternatives-wrap + (> total 1) + (cond + ((< index 0) + (setq Info--current-index-alternative (- total 2)) + (message + "No previous matches, use `%s' to continue from end of list" + next-key) + t) + ((>= index total) + (setq Info--current-index-alternative -1) + (message + "No previous matches, use `%s' to continue from start of list" + next-key) + t))) + () ; Do nothing + (setq index (mod index total) + Info--current-index-alternative index) + (let ((entry (nth index Info-index-alternatives))) + (Info-goto-node (nth 1 entry)) + (if (> (nth 3 entry) 0) + ;; Forward 2 lines less because `Info-find-node-2' initially + ;; puts point to the 2nd line. + (forward-line (- (nth 3 entry) 2)) + (forward-line 3) ; don't search in headers + (Info-find-index-name (car entry))) + (message "Found `%s' in %s. %s" + (car entry) + (nth 2 entry) + (if (> total 1) + (format-message + "(%s total; use `%s' for next)" total next-key) + "(Only match)"))))))) (defun Info-find-index-name (name) "Move point to the place within the current node where NAME is defined." @@ -3526,40 +3598,47 @@ Info-virtual-index-find-node (format "*Index for ¡®%s¡¯*::" (cdr (nth 0 nodeinfo))) (cdr (nth 0 nodeinfo))))))))) -(defun Info-virtual-index (topic) +(defun Info-virtual-index (topic &optional window) "Show a node with all lines in the index containing a string TOPIC. Like `Info-index' but displays a node with index search results. Give an empty topic name to go to the node with links to previous search results." ;; `interactive' is a copy from `Info-index' (interactive - (list - (let ((completion-ignore-case t) - (Info-complete-menu-buffer (clone-buffer)) - (Info-complete-nodes (Info-index-nodes)) - (Info-history-list nil)) - (info--ensure-not-in-directory-node) - (unwind-protect - (with-current-buffer Info-complete-menu-buffer - (Info-goto-index) - (completing-read "Index topic: " #'Info-complete-menu-item)) - (kill-buffer Info-complete-menu-buffer)))) + (let ((frame-to-prompt-in (selected-frame)) + (window (info-window))) + (with-selected-window window + (list + (let ((completion-ignore-case t) + (Info-complete-menu-buffer (clone-buffer)) + (Info-complete-nodes (Info-index-nodes)) + (Info-history-list nil)) + (info--ensure-not-in-directory-node) + (unwind-protect + (with-current-buffer Info-complete-menu-buffer + (Info-goto-index) + (with-selected-frame frame-to-prompt-in + (completing-read "Index topic: " + #'Info-complete-menu-item))) + (kill-buffer Info-complete-menu-buffer))) + window))) Info-mode) (if (equal topic "") (Info-find-node Info-current-file "*Index*") - (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes) - (let ((orignode Info-current-node) - (ohist-list Info-history-list)) - ;; Reuse `Info-index' to set `Info-index-alternatives'. - (Info-index topic) - (push (cons (cons Info-current-file topic) Info-index-alternatives) - Info-virtual-index-nodes) - ;; Clean up unnecessary side-effects of `Info-index'. - (setq Info-history-list ohist-list) - (Info-goto-node orignode) - (message ""))) - (Info-find-node Info-current-file - (format "*Index for ¡®%s¡¯*" topic)))) + (with-selected-window (or window (info-window)) + (unless (assoc (cons Info-current-file topic) Info-virtual-index-nodes) + (let ((orignode Info-current-node) + (ohist-list Info-history-list)) + ;; Reuse `Info-index' to set `Info-index-alternatives'. + (Info-index topic) + (push (cons (cons Info-current-file topic) Info-index-alternatives) + Info-virtual-index-nodes) + ;; Clean up unnecessary side-effects of `Info-index'. + (setq Info-history-list ohist-list) + (Info-goto-node orignode) + (message ""))) + (Info-find-node Info-current-file + (format "*Index for ¡®%s¡¯*" topic))))) (add-to-list 'Info-virtual-files '("\\`\\*Apropos\\*\\'" @@ -3694,20 +3773,25 @@ info-apropos "Search indices of all known Info files on your system for STRING. If REGEXP (interactively, the prefix), use a regexp match. -Display a menu of the possible matches." +Display a menu of the possible matches in selected window. If given +numeric prefix argument display results in window *info*. With +non-numeric argument prompt user for info buffer to display results in." (interactive "sIndex apropos: \nP") - (if (equal string "") - (Info-find-node Info-apropos-file "Top") - (let ((nodes Info-apropos-nodes) - nodename) - (while (and nodes (not (equal string (nth 1 (car nodes))))) - (setq nodes (cdr nodes))) - (if nodes - (Info-find-node Info-apropos-file (car (car nodes)) nil nil t) - (setq nodename (format "Index for ¡®%s¡¯" string)) - (push (list nodename string (Info-apropos-matches string regexp)) - Info-apropos-nodes) - (Info-find-node Info-apropos-file nodename))))) + (with-selected-window (if current-prefix-arg + (info-window) + (selected-window)) + (if (equal string "") + (Info-find-node Info-apropos-file "Top") + (let ((nodes Info-apropos-nodes) + nodename) + (while (and nodes (not (equal string (nth 1 (car nodes))))) + (setq nodes (cdr nodes))) + (if nodes + (Info-find-node Info-apropos-file (car (car nodes)) nil nil t) + (setq nodename (format "Index for ¡®%s¡¯" string)) + (push (list nodename string (Info-apropos-matches string regexp)) + Info-apropos-nodes) + (Info-find-node Info-apropos-file nodename)))))) (add-to-list 'Info-virtual-files '("\\`\\*Finder.*\\*\\'" @@ -3834,25 +3918,33 @@ Info-finder-find-node (insert "Can¡¯t find package description.\n\n")))))) ;;;###autoload -(defun info-finder (&optional keywords) +(defun info-finder (&optional keywords window) "Display descriptions of the keywords in the Finder virtual manual. -In interactive use, a prefix argument directs this command to read +In interactive use, a non-numeric prefix argument directs this command to read a list of keywords separated by comma. After that, it displays a node -with a list of packages that contain all specified keywords." +with a list of packages that contain all specified keywords. Numeric +prefix argument will choose window with name *info* if such window +exists otherwise it will prompt the user to choose a window." (interactive - (when current-prefix-arg - (require 'finder) - (list - (completing-read-multiple - "Keywords (separated by comma): " - (mapcar #'symbol-name (mapcar #'car (append finder-known-keywords - (finder-unknown-keywords)))) - nil t)))) + (let ((window (info-window))) + (when (and current-prefix-arg + (not (numberp current-prefix-arg))) + (require 'finder) + (let ((current-prefix-arg nil)) + (with-current-buffer (window-buffer window) + (list + (completing-read-multiple + "Keywords (separated by comma): " + (mapcar #'symbol-name (mapcar #'car (append finder-known-keywords + (finder-unknown-keywords)))) + nil t) + window)))))) + (setq current-prefix-arg nil) (require 'finder) - (if keywords - (Info-find-node Info-finder-file (mapconcat 'identity keywords ", ")) - (Info-find-node Info-finder-file "Top"))) - + (with-selected-window (or window (info-window)) + (if keywords + (Info-find-node Info-finder-file (mapconcat 'identity keywords ", ")) + (Info-find-node Info-finder-file "Top")))) (defun Info-undefined () "Make command be undefined in Info." @@ -3937,7 +4029,7 @@ Info-mouse-follow-nearest-node (mouse-set-point click) (and (not (Info-follow-nearest-node)) (save-excursion (forward-line 1) (eobp)) - (Info-next-preorder))) + (Info-next-preorder (selected-window)))) (defun Info-follow-nearest-node (&optional fork) "Follow a node reference near point. @@ -4030,15 +4122,15 @@ Info-mouse-follow-link (Info-goto-node link-args)) ;; These special values of the `link-args' property are used ;; for navigation; see `Info-fontify-node'. - ((eq link-args 'prev) (Info-prev)) - ((eq link-args 'next) (Info-next)) - ((eq link-args 'up) (Info-up))))) + ((eq link-args 'prev) (Info-prev (selected-window))) + ((eq link-args 'next) (Info-next (selected-window))) + ((eq link-args 'up) (Info-up (selected-window)))))) (defvar Info-mode-map (let ((map (make-keymap))) (suppress-keymap map) - (define-key map "." 'beginning-of-buffer) + (define-key map "." 'Info-beginning-of-buffer) (define-key map " " 'Info-scroll-up) (define-key map [?\S-\ ] 'Info-scroll-down) (define-key map "\C-m" 'Info-follow-nearest-node) @@ -4060,10 +4152,10 @@ Info-mode-map (define-key map "[" 'Info-backward-node) (define-key map "<" 'Info-top-node) (define-key map ">" 'Info-final-node) - (define-key map "b" 'beginning-of-buffer) + (define-key map "b" 'Info-beginning-of-buffer) (put 'beginning-of-buffer :advertised-binding "b") (define-key map "d" 'Info-directory) - (define-key map "e" 'end-of-buffer) + (define-key map "e" 'Info-end-of-buffer) (define-key map "f" 'Info-follow-reference) (define-key map "g" 'Info-goto-node) (define-key map "G" 'Info-goto-node-web) @@ -4071,7 +4163,7 @@ Info-mode-map ;; This is for compatibility with standalone info (>~ version 5.2). ;; Though for some time, standalone info had H and h reversed. ;; See . - (define-key map "H" 'describe-mode) + (define-key map "H" 'Info-describe-mode) (define-key map "i" 'Info-index) (define-key map "I" 'Info-virtual-index) (define-key map "l" 'Info-history-back) @@ -4079,7 +4171,7 @@ Info-mode-map (define-key map "m" 'Info-menu) (define-key map "n" 'Info-next) (define-key map "p" 'Info-prev) - (define-key map "q" 'quit-window) + (define-key map "q" 'Info-quit-window) (define-key map "r" 'Info-history-forward) (define-key map "s" 'Info-search) (define-key map "S" 'Info-search-case-sensitively) @@ -4104,7 +4196,6 @@ Info-mode-map map) "Keymap containing Info commands.") - (defun Info-check-pointer (item) "Non-nil if ITEM is present in this node." (condition-case nil @@ -4125,7 +4216,7 @@ Info-check-pointer :help "Go backward one node, considering all as a sequence"] ["Forward" Info-forward-node :help "Go forward one node, considering all as a sequence"] - ["Beginning" beginning-of-buffer + ["Beginning" Info-beginning-of-buffer :help "Go to beginning of this node"] ["Top" Info-top-node :help "Go to top node of file"] @@ -4323,20 +4414,21 @@ Info-copy-current-node-name The name of the Info file is prepended to the node name in parentheses. With a zero prefix arg, put the name inside a function call to `info'." (interactive "P" Info-mode) - (unless Info-current-node - (user-error "No current Info node")) - (let ((node (if (stringp Info-current-file) - (concat "(" (file-name-sans-extension - (file-name-nondirectory Info-current-file)) - ") " - Info-current-node)))) - (if (zerop (prefix-numeric-value arg)) - (setq node (concat "(info \"" node "\")"))) - (unless (stringp Info-current-file) - (setq node (format "(Info-find-node '%S '%S)" - Info-current-file Info-current-node))) - (kill-new node) - (message "%s" node))) + (with-selected-window (info-window) + (unless Info-current-node + (user-error "No current Info node")) + (let ((node (if (stringp Info-current-file) + (concat "(" (file-name-sans-extension + (file-name-nondirectory Info-current-file)) + ") " + Info-current-node)))) + (if (zerop (prefix-numeric-value arg)) + (setq node (concat "(info \"" node "\")"))) + (unless (stringp Info-current-file) + (setq node (format "(Info-find-node '%S '%S)" + Info-current-file Info-current-node))) + (kill-new node) + (message "%s" node)))) ;; Info mode is suitable only for specially formatted data. @@ -5230,8 +5322,7 @@ Info-speedbar-browser ;; Make sure that speedbar is active (speedbar-frame-mode 1) ;; Now, throw us into Info mode on speedbar. - (speedbar-change-initial-expansion-list "Info") - ) + (speedbar-change-initial-expansion-list "Info")) ;; speedbar loads dframe at runtime. (declare-function dframe-select-attached-frame "dframe" (&optional frame)) @@ -5509,6 +5600,44 @@ info--manual-names (apply-partially #'Info-read-node-name-2 Info-directory-list (mapcar #'car Info-suffix-list)))))))) + +;;; General buffer manipulation support +;; commands from special-mode wrapped to work on Info-mode only + +(defun Info-beginning-of-buffer () + "Move point to the beginning of *info* buffer." + (interactive) + (with-selected-window (info-window) + (goto-char (point-min)))) + +(defun Info-end-of-buffer () + "Move point to the beginning of *info* buffer." + (interactive) + (with-selected-window (info-window) + (goto-char (point-max)))) + +(defun Info-describe-mode () + "As `describe-mode' but for Info-mode only." + (interactive) + ;; I guess we are good if there is any buffer in Info-mode so + ;; we do a special here to prevent prompting + ;; If there are no info buffer, use (info-window) to signal + ;; the error; this to not duplicate the error message in two places + (catch 'found + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (eq major-mode 'Info-mode) + (describe-mode) + (throw 'found buffer)))) + (throw 'found + (with-temp-buffer + (Info-mode) + (describe-mode))))) + +(defun Info-quit-window () + (interactive) + (with-selected-window (info-window) + (quit-window nil (selected-window)))) (provide 'info) diff --git a/lisp/window.el b/lisp/window.el index 5964fe37ee6..2cc5cc6a274 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10741,6 +10741,73 @@ window-prefix-map "0" #'delete-windows-on) (define-key ctl-x-map "w" window-prefix-map) + +;; help function to find an Info- or help-mode window +(defun window-list-by-mode (mode &optional exclude all-frames) + "Get list of windows to act on, displaying live buffer with major mode MODE. + +If EXCLUDE is not nil it should be a window to exclude from the list. +All-FRAMES has same meaning as in `walk-windows' function." + (let (windows) + (walk-windows + (lambda (w) + (with-current-buffer (window-buffer w) + (and (eq major-mode mode) + (not (eq exclude w)) + (not (eq (selected-window) w)) + (push (cons (prin1-to-string w) w) windows)))) + nil all-frames) + windows)) + +(defun get-window-from-user (window-list) + "Ask user to choose a window to act on via completing read. + +This is internal helper function used by `find-window-for-help'" + (cdr + (assoc + (completing-read "Act on window: " window-list) window-list))) + +(defun get-numbered-window (window-list N) + "Get a window from a WINDOW-LIST matching string \"<%N>\" in its name." + (let ((numbered-window-list + (let ((new-list nil)) + (dolist (elt window-list) + (when (string-match-p (format "<%s>" N) (car elt)) + (push elt new-list))) + new-list))) + (cond + ((= (length numbered-window-list) 0) nil) + ((= (length numbered-window-list) 1) + (cdar numbered-window-list)) + ((> (length numbered-window-list) 1) + (get-window-from-user numbered-window-list))))) + +(defun find-window-for-help (mode &optional all-frames exclude) + "Find window displaing buffer with major-mode MODE. + +With numeric argument N, return window containing in the name otherwise nil. +With non-numeric prefix, prompt user to select one of the buffers matching +MODE. + +Meaning of ALL-FRAMES is same as in `window-list-1'. +EXCLIDE is an Info window not to be considered as a candidate." + (let ((window-list (remq (selected-window) + (window-list-by-mode mode exclude all-frames)))) + (when (> (length window-list) 0) + (let ((window + (cond + ((numberp current-prefix-arg) + (let ((window + (get-numbered-window window-list current-prefix-arg))) + (if window + window + (when (> (length window-list) 0) ;; misstyped number arg? + (get-window-from-user window-list))))) + ((> (length window-list) 1) + (get-window-from-user window-list)) + (t (cdar window-list))))) + window)))) + (provide 'window) ;;; window.el ends here -- 2.40.0