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