diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-10-22 16:40:54 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-10-22 16:49:17 +0200 |
commit | e1c2db37ed5d96545c0214df1b011b85a485669c (patch) | |
tree | 854d2352533446d7a3f3cc10f1ada29cf45daf36 | |
parent | 87116700e6e7c99b1c9db4165b1311b48e87c2c5 (diff) | |
download | org-mode-e1c2db37ed5d96545c0214df1b011b85a485669c.tar.gz |
Extract "org-goto" code into a dedicated library
* lisp/org-goto.el: New file.
* lisp/org.el (org-goto-interface):
(org-goto-max-level):
(org-goto-auto-isearch):
(org-goto-local-auto-isearch):
(org-goto-ret):
(org-goto-left):
(org-goto-right):
(org-goto-quit):
(org-goto): Move to new file.
(org-goto-location): Change signature. Move to new file.
(org-goto-map): Remove function.
* lisp/org-id.el (org-id-get-with-outline-drilling): Update to new
`org-goto-location' signature.
-rw-r--r-- | lisp/org-goto.el | 312 | ||||
-rw-r--r-- | lisp/org-id.el | 5 | ||||
-rw-r--r-- | lisp/org.el | 246 |
3 files changed, 315 insertions, 248 deletions
diff --git a/lisp/org-goto.el b/lisp/org-goto.el new file mode 100644 index 0000000..eac4a56 --- /dev/null +++ b/lisp/org-goto.el @@ -0,0 +1,312 @@ +;;; org-goto.el --- Fast navigation in an Org buffer -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Nicolas Goaziou + +;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Code: + +(require 'org-macs) + +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-beginning-of-line "org" (&optional n)) +(declare-function org-defkey "org" (keymap key def)) +(declare-function org-fit-window-to-buffer "org" (&optional window max-height min-height shrink-only)) +(declare-function org-invisible-p "org" (&optional pos)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-no-popups "org" (&rest body)) +(declare-function org-overview "org" ()) +(declare-function org-refile-check-position "org" (refile-pointer)) +(declare-function org-refile-get-location "org" (&optional prompt default-buffer new-nodes)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-show-set-visibility "org" (detail)) + +(defvar org-complex-heading-regexp) +(defvar org-startup-align-all-tables) +(defvar org-startup-folded) +(defvar org-startup-truncated) +(defvar org-special-ctrl-a/e) +(defvar org-refile-target-verify-function) +(defvar org-refile-use-outline-path) +(defvar org-refile-targets) + +(defvar org-goto-exit-command nil) +(defvar org-goto-local-auto-isearch-map nil) +(defvar org-goto-map nil) +(defvar org-goto-marker nil) +(defvar org-goto-selected-point nil) +(defvar org-goto-start-pos nil) +(defvar org-goto-window-configuration nil) + +(defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) +(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) + +(defconst org-goto-help + "Browse buffer copy, to find location or copy text.%s +RET=jump to location C-g=quit and return to previous location +\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") + + + +;;; Customization + +(defgroup org-goto nil + "Options concerning Org Goto navigation interface." + :tag "Org Goto" + :group 'org) + +(defcustom org-goto-interface 'outline + "The default interface to be used for `org-goto'. + +Allowed values are: + +`outline' + + The interface shows an outline of the relevant file and the + correct heading is found by moving through the outline or by + searching with incremental search. + +`outline-path-completion' + + Headlines in the current buffer are offered via completion. + This is the interface also used by the refile command." + :group 'org-goto + :type '(choice + (const :tag "Outline" outline) + (const :tag "Outline-path-completion" outline-path-completion))) + +(defcustom org-goto-max-level 5 + "Maximum target level when running `org-goto' with refile interface." + :group 'org-goto + :type 'integer) + +(defcustom org-goto-auto-isearch t + "Non-nil means typing characters in `org-goto' starts incremental search. +When nil, you can use these keybindings to navigate the buffer: + + q Quit the Org Goto interface + n Go to the next visible heading + p Go to the previous visible heading + f Go one heading forward on same level + b Go one heading backward on same level + u Go one heading up" + :group 'org-goto + :type 'boolean) + + + +;;; Internal functions + +(defun org-goto--set-map () + "Set the keymap `org-goto'." + (setq org-goto-map + (let ((map (make-sparse-keymap))) + (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command + mouse-drag-region universal-argument org-occur))) + (dolist (cmd cmds) + (substitute-key-definition cmd cmd map global-map))) + (suppress-keymap map) + (org-defkey map "\C-m" 'org-goto-ret) + (org-defkey map [(return)] 'org-goto-ret) + (org-defkey map [(left)] 'org-goto-left) + (org-defkey map [(right)] 'org-goto-right) + (org-defkey map [(control ?g)] 'org-goto-quit) + (org-defkey map "\C-i" 'org-cycle) + (org-defkey map [(tab)] 'org-cycle) + (org-defkey map [(down)] 'outline-next-visible-heading) + (org-defkey map [(up)] 'outline-previous-visible-heading) + (if org-goto-auto-isearch + (if (fboundp 'define-key-after) + (define-key-after map [t] 'org-goto-local-auto-isearch) + nil) + (org-defkey map "q" 'org-goto-quit) + (org-defkey map "n" 'outline-next-visible-heading) + (org-defkey map "p" 'outline-previous-visible-heading) + (org-defkey map "f" 'outline-forward-same-level) + (org-defkey map "b" 'outline-backward-same-level) + (org-defkey map "u" 'outline-up-heading)) + (org-defkey map "/" 'org-occur) + (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) + (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) + (org-defkey map "\C-c\C-f" 'outline-forward-same-level) + (org-defkey map "\C-c\C-b" 'outline-backward-same-level) + (org-defkey map "\C-c\C-u" 'outline-up-heading) + map))) + +;; `isearch-other-control-char' was removed in Emacs 24.4. +(if (fboundp 'isearch-other-control-char) + (progn + (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) + (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) + (define-key org-goto-local-auto-isearch-map "\C-i" nil) + (define-key org-goto-local-auto-isearch-map "\C-m" nil) + (define-key org-goto-local-auto-isearch-map [return] nil)) + +(defun org-goto--local-search-headings (string bound noerror) + "Search and make sure that any matches are in headlines." + (catch 'return + (while (if isearch-forward + (search-forward string bound noerror) + (search-backward string bound noerror)) + (when (save-match-data + (and (save-excursion + (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5))))) + (throw 'return (point)))))) + +(defun org-goto-local-auto-isearch () + "Start isearch." + (interactive) + (goto-char (point-min)) + (let ((keys (this-command-keys))) + (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) + (isearch-mode t) + (isearch-process-search-char (string-to-char keys))))) + +(defun org-goto-ret (&optional _arg) + "Finish `org-goto' by going to the new location." + (interactive "P") + (setq org-goto-selected-point (point)) + (setq org-goto-exit-command 'return) + (throw 'exit nil)) + +(defun org-goto-left () + "Finish `org-goto' by going to the new location." + (interactive) + (if (org-at-heading-p) + (progn + (beginning-of-line 1) + (setq org-goto-selected-point (point) + org-goto-exit-command 'left) + (throw 'exit nil)) + (user-error "Not on a heading"))) + +(defun org-goto-right () + "Finish `org-goto' by going to the new location." + (interactive) + (if (org-at-heading-p) + (progn + (setq org-goto-selected-point (point) + org-goto-exit-command 'right) + (throw 'exit nil)) + (user-error "Not on a heading"))) + +(defun org-goto-quit () + "Finish `org-goto' without cursor motion." + (interactive) + (setq org-goto-selected-point nil) + (setq org-goto-exit-command 'quit) + (throw 'exit nil)) + + + +;;; Public API + +;;;###autoload +(defun org-goto-location (&optional _buf help) + "Let the user select a location in current buffer. +This function uses a recursive edit. It returns the selected +position or nil." + (org-no-popups + (let ((isearch-mode-map org-goto-local-auto-isearch-map) + (isearch-hide-immediately nil) + (isearch-search-fun-function #'org-goto--local-search-headings) + (org-goto-selected-point org-goto-exit-command) + (help (or help org-goto-help))) + (save-excursion + (save-window-excursion + (delete-other-windows) + (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) + (pop-to-buffer-same-window + (condition-case nil + (make-indirect-buffer (current-buffer) "*org-goto*") + (error (make-indirect-buffer (current-buffer) "*org-goto*")))) + (with-output-to-temp-buffer "*Org Help*" + (princ (format help (if org-goto-auto-isearch + " Just type for auto-isearch." + " n/p/f/b/u to navigate, q to quit.")))) + (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) + (setq buffer-read-only nil) + (let ((org-startup-truncated t) + (org-startup-folded nil) + (org-startup-align-all-tables nil)) + (org-mode) + (org-overview)) + (setq buffer-read-only t) + (if (and (boundp 'org-goto-start-pos) + (integer-or-marker-p org-goto-start-pos)) + (progn (goto-char org-goto-start-pos) + (when (org-invisible-p) + (org-show-set-visibility 'lineage))) + (goto-char (point-min))) + (let (org-special-ctrl-a/e) (org-beginning-of-line)) + (message "Select location and press RET") + (use-local-map org-goto-map) + (recursive-edit))) + (kill-buffer "*org-goto*") + (cons org-goto-selected-point org-goto-exit-command)))) + +;;;###autoload +(defun org-goto (&optional alternative-interface) + "Look up a different location in the current file, keeping current visibility. + +When you want look-up or go to a different location in a +document, the fastest way is often to fold the entire buffer and +then dive into the tree. This method has the disadvantage, that +the previous location will be folded, which may not be what you +want. + +This command works around this by showing a copy of the current +buffer in an indirect buffer, in overview mode. You can dive +into the tree in that copy, use org-occur and incremental search +to find a location. When pressing RET or `Q', the command +returns to the original buffer in which the visibility is still +unchanged. After RET it will also jump to the location selected +in the indirect buffer and expose the headline hierarchy above. + +With a prefix argument, use the alternative interface: e.g., if +`org-goto-interface' is `outline' use `outline-path-completion'." + (interactive "P") + (org-goto--set-map) + (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) + (org-refile-use-outline-path t) + (org-refile-target-verify-function nil) + (interface + (if (not alternative-interface) + org-goto-interface + (if (eq org-goto-interface 'outline) + 'outline-path-completion + 'outline))) + (org-goto-start-pos (point)) + (selected-point + (if (eq interface 'outline) (car (org-goto-location)) + (let ((pa (org-refile-get-location "Goto"))) + (org-refile-check-position pa) + (nth 3 pa))))) + (if selected-point + (progn + (org-mark-ring-push org-goto-start-pos) + (goto-char selected-point) + (when (or (org-invisible-p) (org-invisible-p2)) + (org-show-context 'org-goto))) + (message "Quit")))) + +(provide 'org-goto) + +;;; org-goto.el ends here diff --git a/lisp/org-id.el b/lisp/org-id.el index a508e76..2c85e2b 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -73,6 +73,7 @@ (require 'org) (declare-function message-make-fqdn "message" ()) +(declare-function org-goto-location "org-goto" (&optional _buf help)) ;;; Customization @@ -276,9 +277,9 @@ If necessary, the ID is created." ;;;###autoload (defun org-id-get-with-outline-drilling () "Use an outline-cycling interface to retrieve the ID of an entry. -This only finds entries in the current buffer, using `org-get-location'. +This only finds entries in the current buffer, using `org-goto-location'. It returns the ID of the entry. If necessary, the ID is created." - (let* ((spos (org-get-location (current-buffer) org-goto-help)) + (let* ((spos (org-goto-location)) (pom (and spos (move-marker (make-marker) (car spos))))) (prog1 (org-id-get pom 'create) (move-marker pom nil)))) diff --git a/lisp/org.el b/lisp/org.el index c7bff8a..ee112bb 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -915,11 +915,6 @@ already archived entries." :group 'org-todo :group 'org-archive) -(defgroup org-startup nil - "Options concerning startup of Org mode." - :tag "Org Startup" - :group 'org) - (defcustom org-startup-folded t "Non-nil means entering Org mode will switch to OVERVIEW. @@ -1658,19 +1653,6 @@ When nil, such lines will be treated like ordinary lines." :group 'org-edit-structure :type 'boolean) -(defcustom org-goto-auto-isearch t - "Non-nil means typing characters in `org-goto' starts incremental search. -When nil, you can use these keybindings to navigate the buffer: - - q Quit the org-goto interface - n Go to the next visible heading - p Go to the previous visible heading - f Go one heading forward on same level - b Go one heading backward on same level - u Go one heading up" - :group 'org-edit-structure - :type 'boolean) - (defgroup org-sparse-trees nil "Options concerning sparse trees in Org mode." :tag "Org Sparse Trees" @@ -2371,25 +2353,6 @@ do not specify a target file." :group 'org-capture :type 'file) -(defcustom org-goto-interface 'outline - "The default interface to be used for `org-goto'. -Allowed values are: -outline The interface shows an outline of the relevant file - and the correct heading is found by moving through - the outline or by searching with incremental search. -outline-path-completion Headlines in the current buffer are offered via - completion. This is the interface also used by - the refile command." - :group 'org-refile - :type '(choice - (const :tag "Outline" outline) - (const :tag "Outline-path-completion" outline-path-completion))) - -(defcustom org-goto-max-level 5 - "Maximum target level when running `org-goto' with refile interface." - :group 'org-refile - :type 'integer) - (defcustom org-reverse-note-order nil "Non-nil means store new notes at the beginning of a file or entry. When nil, new notes will be filed to the end of a file or entry. @@ -7355,215 +7318,6 @@ a block. Return a non-nil value when toggling is successful." (lambda () (add-hook 'change-major-mode-hook 'org-show-block-all 'append 'local))) -;;; Org-goto - -(defvar org-goto-window-configuration nil) -(defvar org-goto-marker nil) -(defvar org-goto-map) -(defun org-goto-map () - "Set the keymap `org-goto'." - (setq org-goto-map - (let ((map (make-sparse-keymap))) - (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command - mouse-drag-region universal-argument org-occur))) - (dolist (cmd cmds) - (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) - (org-defkey map "\C-m" 'org-goto-ret) - (org-defkey map [(return)] 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(control ?g)] 'org-goto-quit) - (org-defkey map "\C-i" 'org-cycle) - (org-defkey map [(tab)] 'org-cycle) - (org-defkey map [(down)] 'outline-next-visible-heading) - (org-defkey map [(up)] 'outline-previous-visible-heading) - (if org-goto-auto-isearch - (if (fboundp 'define-key-after) - (define-key-after map [t] 'org-goto-local-auto-isearch) - nil) - (org-defkey map "q" 'org-goto-quit) - (org-defkey map "n" 'outline-next-visible-heading) - (org-defkey map "p" 'outline-previous-visible-heading) - (org-defkey map "f" 'outline-forward-same-level) - (org-defkey map "b" 'outline-backward-same-level) - (org-defkey map "u" 'outline-up-heading)) - (org-defkey map "/" 'org-occur) - (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) - (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) - (org-defkey map "\C-c\C-f" 'outline-forward-same-level) - (org-defkey map "\C-c\C-b" 'outline-backward-same-level) - (org-defkey map "\C-c\C-u" 'outline-up-heading) - map))) - -(defconst org-goto-help - "Browse buffer copy, to find location or copy text.%s -RET=jump to location C-g=quit and return to previous location -\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") - -(defvar org-goto-start-pos) ; dynamically scoped parameter - -(defun org-goto (&optional alternative-interface) - "Look up a different location in the current file, keeping current visibility. - -When you want look-up or go to a different location in a -document, the fastest way is often to fold the entire buffer and -then dive into the tree. This method has the disadvantage, that -the previous location will be folded, which may not be what you -want. - -This command works around this by showing a copy of the current -buffer in an indirect buffer, in overview mode. You can dive -into the tree in that copy, use org-occur and incremental search -to find a location. When pressing RET or `Q', the command -returns to the original buffer in which the visibility is still -unchanged. After RET it will also jump to the location selected -in the indirect buffer and expose the headline hierarchy above. - -With a prefix argument, use the alternative interface: e.g., if -`org-goto-interface' is `outline' use `outline-path-completion'." - (interactive "P") - (org-goto-map) - (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) - (org-refile-use-outline-path t) - (org-refile-target-verify-function nil) - (interface - (if (not alternative-interface) - org-goto-interface - (if (eq org-goto-interface 'outline) - 'outline-path-completion - 'outline))) - (org-goto-start-pos (point)) - (selected-point - (if (eq interface 'outline) - (car (org-get-location (current-buffer) org-goto-help)) - (let ((pa (org-refile-get-location "Goto"))) - (org-refile-check-position pa) - (nth 3 pa))))) - (if selected-point - (progn - (org-mark-ring-push org-goto-start-pos) - (goto-char selected-point) - (when (or (org-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) - (message "Quit")))) - -(defvar org-goto-selected-point nil) ; dynamically scoped parameter -(defvar org-goto-exit-command nil) ; dynamically scoped parameter -(defvar org-goto-local-auto-isearch-map) ; defined below - -(defun org-get-location (_buf help) - "Let the user select a location in current buffer. -This function uses a recursive edit. It returns the selected position -or nil." - (org-no-popups - (let ((isearch-mode-map org-goto-local-auto-isearch-map) - (isearch-hide-immediately nil) - (isearch-search-fun-function - (lambda () 'org-goto-local-search-headings)) - (org-goto-selected-point org-goto-exit-command)) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (pop-to-buffer-same-window - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Org Help*" - (princ (format help (if org-goto-auto-isearch - " Just type for auto-isearch." - " n/p/f/b/u to navigate, q to quit.")))) - (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (setq buffer-read-only nil) - (let ((org-startup-truncated t) - (org-startup-folded nil) - (org-startup-align-all-tables nil)) - (org-mode) - (org-overview)) - (setq buffer-read-only t) - (if (and (boundp 'org-goto-start-pos) - (integer-or-marker-p org-goto-start-pos)) - (progn (goto-char org-goto-start-pos) - (when (org-invisible-p) - (org-show-set-visibility 'lineage))) - (goto-char (point-min))) - (let (org-special-ctrl-a/e) (org-beginning-of-line)) - (message "Select location and press RET") - (use-local-map org-goto-map) - (recursive-edit))) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command)))) - -(defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) -(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) -;; `isearch-other-control-char' was removed in Emacs 24.4. -(if (fboundp 'isearch-other-control-char) - (progn - (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) - (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) - (define-key org-goto-local-auto-isearch-map "\C-i" nil) - (define-key org-goto-local-auto-isearch-map "\C-m" nil) - (define-key org-goto-local-auto-isearch-map [return] nil)) - -(defun org-goto-local-search-headings (string bound noerror) - "Search and make sure that any matches are in headlines." - (catch 'return - (while (if isearch-forward - (search-forward string bound noerror) - (search-backward string bound noerror)) - (when (save-match-data - (and (save-excursion - (beginning-of-line) - (looking-at org-complex-heading-regexp)) - (or (not (match-beginning 5)) - (< (point) (match-beginning 5))))) - (throw 'return (point)))))) - -(defun org-goto-local-auto-isearch () - "Start isearch." - (interactive) - (goto-char (point-min)) - (let ((keys (this-command-keys))) - (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) - (isearch-mode t) - (isearch-process-search-char (string-to-char keys))))) - -(defun org-goto-ret (&optional _arg) - "Finish `org-goto' by going to the new location." - (interactive "P") - (setq org-goto-selected-point (point)) - (setq org-goto-exit-command 'return) - (throw 'exit nil)) - -(defun org-goto-left () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-at-heading-p) - (progn - (beginning-of-line 1) - (setq org-goto-selected-point (point) - org-goto-exit-command 'left) - (throw 'exit nil)) - (user-error "Not on a heading"))) - -(defun org-goto-right () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-at-heading-p) - (progn - (setq org-goto-selected-point (point) - org-goto-exit-command 'right) - (throw 'exit nil)) - (user-error "Not on a heading"))) - -(defun org-goto-quit () - "Finish `org-goto' without cursor motion." - (interactive) - (setq org-goto-selected-point nil) - (setq org-goto-exit-command 'quit) - (throw 'exit nil)) - ;;; Indirect buffer display of subtrees (defvar org-indirect-dedicated-frame nil |