org-goto.el (10494B)
1 ;;; org-goto.el --- Fast navigation in an Org buffer -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2012-2024 Free Software Foundation, Inc. 4 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 7 8 ;; This file is part of GNU Emacs. 9 10 ;; GNU Emacs is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;;; Code: 26 27 (require 'org-macs) 28 (org-assert-version) 29 30 (require 'org) 31 (require 'org-refile) 32 33 (defvar org-goto-exit-command nil) 34 (defvar org-goto-map nil) 35 (defvar org-goto-marker nil) 36 (defvar org-goto-selected-point nil) 37 (defvar org-goto-start-pos nil) 38 (defvar org-goto-window-configuration nil) 39 40 (defconst org-goto-local-auto-isearch-map (make-sparse-keymap)) 41 (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) 42 43 (defconst org-goto-help 44 "Browse buffer copy, to find location or copy text.%s 45 RET=jump to location C-g=quit and return to previous location 46 \[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") 47 48 49 50 ;;; Customization 51 52 (defgroup org-goto nil 53 "Options concerning Org Goto navigation interface." 54 :tag "Org Goto" 55 :group 'org) 56 57 (defcustom org-goto-interface 'outline 58 "The default interface to be used for `org-goto'. 59 60 Allowed values are: 61 62 `outline' 63 64 The interface shows an outline of the relevant file and the 65 correct heading is found by moving through the outline or by 66 searching with incremental search. 67 68 `outline-path-completion' 69 70 Headlines in the current buffer are offered via completion. 71 This is the interface also used by the refile command." 72 :group 'org-goto 73 :type '(choice 74 (const :tag "Outline" outline) 75 (const :tag "Outline-path-completion" outline-path-completion))) 76 77 (defcustom org-goto-max-level 5 78 "Maximum target level when running `org-goto' with refile interface." 79 :group 'org-goto 80 :type 'integer) 81 82 (defcustom org-goto-auto-isearch t 83 "Non-nil means typing characters in `org-goto' starts incremental search. 84 When nil, you can use these keybindings to navigate the buffer: 85 86 q Quit the Org Goto interface 87 n Go to the next visible heading 88 p Go to the previous visible heading 89 f Go one heading forward on same level 90 b Go one heading backward on same level 91 u Go one heading up" 92 :group 'org-goto 93 :type 'boolean) 94 95 96 97 ;;; Internal functions 98 99 (defun org-goto--set-map () 100 "Set the keymap `org-goto'." 101 (setq org-goto-map 102 (let ((map (make-sparse-keymap))) 103 (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command 104 mouse-drag-region universal-argument org-occur))) 105 (dolist (cmd cmds) 106 (substitute-key-definition cmd cmd map global-map))) 107 (if org-goto-auto-isearch 108 ;; Suppress 0-9 interpreted as digital arguments. 109 ;; Make them initiate isearch instead. 110 (suppress-keymap map t) 111 (suppress-keymap map)) 112 (org-defkey map "\C-m" 'org-goto-ret) 113 (org-defkey map [(return)] 'org-goto-ret) 114 (org-defkey map [(left)] 'org-goto-left) 115 (org-defkey map [(right)] 'org-goto-right) 116 (org-defkey map [(control ?g)] 'org-goto-quit) 117 (org-defkey map "\C-i" 'org-cycle) 118 (org-defkey map [(tab)] 'org-cycle) 119 (org-defkey map [(down)] 'outline-next-visible-heading) 120 (org-defkey map [(up)] 'outline-previous-visible-heading) 121 (if org-goto-auto-isearch 122 (define-key-after map [t] 'org-goto-local-auto-isearch) 123 (org-defkey map "q" 'org-goto-quit) 124 (org-defkey map "n" 'outline-next-visible-heading) 125 (org-defkey map "p" 'outline-previous-visible-heading) 126 (org-defkey map "f" 'outline-forward-same-level) 127 (org-defkey map "b" 'outline-backward-same-level) 128 (org-defkey map "u" 'outline-up-heading)) 129 (org-defkey map "/" 'org-occur) 130 (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) 131 (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) 132 (org-defkey map "\C-c\C-f" 'outline-forward-same-level) 133 (org-defkey map "\C-c\C-b" 'outline-backward-same-level) 134 (org-defkey map "\C-c\C-u" 'outline-up-heading) 135 map))) 136 137 ;; `isearch-other-control-char' was removed in Emacs 24.4. 138 (if (fboundp 'isearch-other-control-char) 139 (progn 140 (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) 141 (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) 142 (define-key org-goto-local-auto-isearch-map "\C-i" nil) 143 (define-key org-goto-local-auto-isearch-map "\C-m" nil) 144 (define-key org-goto-local-auto-isearch-map [return] nil)) 145 146 (defun org-goto--local-search-headings (string bound noerror) 147 "Search and make sure that any matches are in headlines." 148 (catch 'return 149 (while (if isearch-forward 150 (search-forward string bound noerror) 151 (search-backward string bound noerror)) 152 (when (save-match-data 153 (and (save-excursion 154 (forward-line 0) 155 (looking-at org-complex-heading-regexp)) 156 (or (not (match-beginning 5)) 157 (< (point) (match-beginning 5))))) 158 (throw 'return (point)))))) 159 160 (defun org-goto-local-auto-isearch () 161 "Start isearch." 162 (interactive) 163 (let ((keys (this-command-keys))) 164 (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) 165 (isearch-mode t) 166 (isearch-process-search-char (string-to-char keys)) 167 (font-lock-ensure)))) 168 169 (defun org-goto-ret (&optional _arg) 170 "Finish `org-goto' by going to the new location." 171 (interactive "P") 172 (setq org-goto-selected-point (point)) 173 (setq org-goto-exit-command 'return) 174 (throw 'exit nil)) 175 176 (defun org-goto-left () 177 "Finish `org-goto' by going to the new location." 178 (interactive) 179 (if (org-at-heading-p) 180 (progn 181 (forward-line 0) 182 (setq org-goto-selected-point (point) 183 org-goto-exit-command 'left) 184 (throw 'exit nil)) 185 (user-error "Not on a heading"))) 186 187 (defun org-goto-right () 188 "Finish `org-goto' by going to the new location." 189 (interactive) 190 (if (org-at-heading-p) 191 (progn 192 (setq org-goto-selected-point (point) 193 org-goto-exit-command 'right) 194 (throw 'exit nil)) 195 (user-error "Not on a heading"))) 196 197 (defun org-goto-quit () 198 "Finish `org-goto' without cursor motion." 199 (interactive) 200 (setq org-goto-selected-point nil) 201 (setq org-goto-exit-command 'quit) 202 (throw 'exit nil)) 203 204 205 206 ;;; Public API 207 208 ;;;###autoload 209 (defun org-goto-location (&optional _buf help) 210 "Let the user select a location in current buffer. 211 This function uses a recursive edit. It returns the selected 212 position or nil." 213 (let ((isearch-mode-map org-goto-local-auto-isearch-map) 214 (isearch-hide-immediately nil) 215 (isearch-search-fun-function 216 (lambda () #'org-goto--local-search-headings)) 217 (help (or help org-goto-help))) 218 (save-excursion 219 (save-window-excursion 220 (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) 221 (pop-to-buffer 222 (condition-case nil 223 (make-indirect-buffer (current-buffer) "*org-goto*" t) 224 (error (make-indirect-buffer (current-buffer) "*org-goto*" t))) 225 '(org-display-buffer-full-frame)) 226 (let (temp-buffer-show-function temp-buffer-show-hook) 227 (with-output-to-temp-buffer "*Org Help*" 228 (princ (format help (if org-goto-auto-isearch 229 " Just type for auto-isearch." 230 " n/p/f/b/u to navigate, q to quit."))))) 231 (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) 232 (org-cycle-overview) 233 (setq buffer-read-only t) 234 (if (and (boundp 'org-goto-start-pos) 235 (integer-or-marker-p org-goto-start-pos)) 236 (progn (goto-char org-goto-start-pos) 237 (when (org-invisible-p) 238 (org-fold-show-set-visibility 'lineage))) 239 (goto-char (point-min))) 240 (let (org-special-ctrl-a/e) (org-beginning-of-line)) 241 (message "Select location and press RET") 242 (use-local-map org-goto-map) 243 (unwind-protect (recursive-edit) 244 (when-let* ((window (get-buffer-window "*Org Help*" t))) 245 (quit-window 'kill window))))) 246 (when (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) 247 (cons org-goto-selected-point org-goto-exit-command))) 248 249 ;;;###autoload 250 (defun org-goto (&optional alternative-interface) 251 "Look up a different location in the current file, keeping current visibility. 252 253 When you want look-up or go to a different location in a 254 document, the fastest way is often to fold the entire buffer and 255 then dive into the tree. This method has the disadvantage, that 256 the previous location will be folded, which may not be what you 257 want. 258 259 This command works around this by showing a copy of the current 260 buffer in an indirect buffer, in overview mode. You can dive 261 into the tree in that copy, use `org-occur' and incremental search 262 to find a location. When pressing RET or `Q', the command 263 returns to the original buffer in which the visibility is still 264 unchanged. After RET it will also jump to the location selected 265 in the indirect buffer and expose the headline hierarchy above. 266 267 With a prefix argument, use the alternative interface: e.g., if 268 `org-goto-interface' is `outline' use `outline-path-completion'." 269 (interactive "P") 270 (org-goto--set-map) 271 (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) 272 (org-refile-use-outline-path t) 273 (org-refile-target-verify-function nil) 274 (interface 275 (if (not alternative-interface) 276 org-goto-interface 277 (if (eq org-goto-interface 'outline) 278 'outline-path-completion 279 'outline))) 280 (org-goto-start-pos (point)) 281 (selected-point 282 (if (eq interface 'outline) (car (org-goto-location)) 283 (let ((pa (org-refile-get-location "Goto"))) 284 (org-refile-check-position pa) 285 (nth 3 pa))))) 286 (if selected-point 287 (progn 288 (org-mark-ring-push org-goto-start-pos) 289 (goto-char selected-point) 290 (when (or (org-invisible-p) (org-invisible-p2)) 291 (org-fold-show-context 'org-goto))) 292 (message "Quit")))) 293 294 (provide 'org-goto) 295 296 ;; Local variables: 297 ;; generated-autoload-file: "org-loaddefs.el" 298 ;; End: 299 300 ;;; org-goto.el ends here