diff --git a/init.el b/init.el index 9450235..787cd3e 100644 --- a/init.el +++ b/init.el @@ -703,6 +703,7 @@ split horizontally again, but this extra work should not matter much." db/org-clock-goto-first-open-checkbox) :autoload (db/check-special-org-files-in-agenda db/verify-refile-target + db/org-refile-get-location db/find-parent-task db/ensure-running-clock db/save-current-org-task-to-file @@ -733,13 +734,13 @@ split horizontally again, but this extra work should not matter much." ;; that are defined in those packages. (use-package org-attach) (use-package org-id) -(use-package org-goto) (use-package org :pin "gnu" :bind (:map org-mode-map ([remap org-return] . (lambda () (interactive) (org-return :indent))) - ([remap org-clock-goto] . db/org-clock-goto-first-open-checkbox)) + ([remap org-clock-goto] . db/org-clock-goto-first-open-checkbox) + ([remap org-goto] . consult-org-heading)) :autoload (org-get-todo-state org-entry-get) :commands (org-return) @@ -778,7 +779,6 @@ split horizontally again, but this extra work should not matter much." org-attach-store-link-p 'attached org-attach-auto-tag nil org-bookmark-names-plist nil - org-goto-interface 'outline-path-completion org-id-link-to-org-use-id t org-return-follows-link t org-hide-emphasis-markers t @@ -872,7 +872,7 @@ split horizontally again, but this extra work should not matter much." (db/org-default-notes-file . (:maxlevel . 9))) org-refile-use-outline-path 'buffer-name org-refile-use-cache nil - org-refile-allow-creating-parent-nodes 'confirm + org-refile-allow-creating-parent-nodes nil org-indirect-buffer-display 'current-window org-outline-path-complete-in-steps nil org-refile-target-verify-function 'db/verify-refile-target) diff --git a/site-lisp/db-org.el b/site-lisp/db-org.el index 930fe63..1433f6c 100644 --- a/site-lisp/db-org.el +++ b/site-lisp/db-org.el @@ -22,6 +22,7 @@ (require 'holidays) (require 'dired) (require 'bookmark) +(require 'consult-org) (autoload 'which-function "which-func") (autoload 'org-element-property "org-element") @@ -479,6 +480,31 @@ Via %%(with-temp-buffer (db/org-add-link-to-current-clock) (string-trim (buffer- ;; any agenda when a super-item is tagged with :HOLD:. (not (member "HOLD" (org-get-tags (point)))))) +(defun db/org-refile-get-location (&optional prompt default-buffer new-nodes) + "Replacement function for `org-refile-get-location' using `consult'. + +This function can be used instead of `org-refile-get-location', +e.g. using `define-advice'. The parameters PROMPT, DEFAULT-BUFFER, and +NEW-NODES have the same meaning. However, setting NEW-NODES to a +non-nil value will result in a warning, as creating new headlings is not +supported with this function. + +Also note that the usual variables governing the behavior of +`org-refile' do not have any effect here. In particular, +`org-refile-verify-target-function' is not (yet) considered." + (when new-nodes + (warn "Cannot create new nodes (yet) with consult interface for `org-refile'")) + (let ((pom (with-current-buffer (or default-buffer (current-buffer)) + (db/org-get-location t nil (concat prompt " "))))) ; TODO: incorporate verify + ; function, use direct call to + ; consult--read for this and + ; replace the :predicate key? + (list (buffer-name (marker-buffer pom)) + (buffer-file-name (marker-buffer pom)) + ;; The third entry is some regexp matching the headline, apparently? + (format org-complex-heading-regexp-format (org-entry-get pom "ITEM")) + (marker-position pom)))) + ;;; Helper Functions for Clocking @@ -1307,18 +1333,7 @@ Current Task: %s(replace-regexp-in-string \"%\" \"%%\" (or org-clock-current-tas " ("c" (db/org-clock-goto-first-open-checkbox nil) nil) - ("a" (with-current-buffer - ;; Make sure we are in some Org buffer, as `org-refile-get-location' - ;; might try to parse the current buffer in search for some Org - ;; headings, possibly producing errors along the way. - (->> (org-agenda-files :unrestricted) - cl-first - get-file-buffer) - ;; Show all possible items, i.e. exclude refile verification; since the - ;; cache includes only verified items, also disable it locally. - (let ((org-refile-use-cache nil) - (org-refile-target-verify-function nil)) - (org-refile '(4)))) + ("a" (consult-org-heading nil 'agenda) nil) ("s" (db/org-clock-goto-first-open-checkbox t) nil)) @@ -1873,35 +1888,25 @@ not." (t (user-error "Neither ID nor CUSTOM_ID given"))))) (org-search-view nil query))) -(defun db/org-get-location (&optional use-all-org-files initial-input) +(defun db/org-get-location (&optional use-all-org-files initial-input prompt) "Interactively query for location and return mark. Use INITIAL-INPUT as initial input when filtering available -locations. +locations. Use PROMPT as prompt when given. When USE-ALL-ORG-FILES is nil, this functions by default searches through the current buffer if that one is an Org buffer and is associated with a file, and `db/org-default-org-file' otherwise. -If the current buffer is associated with a file from the variable -`org-agenda-files', though, the search is extended through all -agenda files (the rationale being that Org agenda files are +However, if the current buffer is associated with a file from the list +returned by the function `org-agenda-files', the search is extended +through all agenda files (the rationale being that Org agenda files are always considered to be one large data collection). When USE-ALL-ORG-FILES is non-nil, search through all files in the variables `org-agenda-files', `org-agenda-text-search-extra-files', and the current file or -`db/org-default-org-file' as described above. - -Search is always conducted up to level 9. If the selected -location does not have an associated point or mark, error out. -Disable refile cache and any active refile filter hooks to allow -linking to any item." - (let ((org-refile-target-verify-function nil) - (org-refile-use-cache nil) - ;; If the current buffer is an Org buffer and is associated with a file, - ;; search through it; otherwise, use the default Org Mode file as - ;; default buffer - (default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode)) +`db/org-default-org-file' as described above." + (let ((default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode)) (current-buffer) (find-file-noselect db/org-default-org-file)))) @@ -1912,67 +1917,37 @@ linking to any item." (-any (-partial #'file-equal-p it) org-agenda-files))) - ;; Default file(s) to search through; note that `default-buffer' is - ;; provided later to `org-refile-get-location' as additional argument - (org-refile-targets (append (if current-buffer-is-in-org-agenda-files? - '((org-agenda-files :maxlevel . 9)) - '((nil :maxlevel . 9))) + (scope (cond (use-all-org-files + (->> (append (unless current-buffer-is-in-org-agenda-files? ; avoid duplicate entries + (list (buffer-file-name default-buffer))) + (org-agenda-files) + (cl-remove-if-not #'stringp + org-agenda-text-search-extra-files)) + (-map #'file-truename) + (-uniq))) + (current-buffer-is-in-org-agenda-files? + (org-agenda-files)) + (t + (list (buffer-file-name default-buffer))))) - ;; When USE-ALL-ORG-FILES is non-nil, add - ;; all agenda files, but only if not - ;; already done so. - (and use-all-org-files - (not current-buffer-is-in-org-agenda-files?) - '((org-agenda-files :maxlevel . 9))) - - ;; When USE-ALL-ORG-FILES is non-nil, add - ;; extra file files to search though. - (and use-all-org-files - `((,(cl-remove-if-not #'stringp - org-agenda-text-search-extra-files) - :maxlevel . 9))))) - - (target-pointer (let ((old-completing-read (symbol-function 'completing-read))) - ;; We temporarily overwrite `completing-read' to - ;; provide our initial input; this is necessary - ;; because `org-refile-get-location' sets the - ;; initial-input parameter of `completing-read' to - ;; nil without any possibility for a custom string. - (unwind-protect - (progn - (fset 'completing-read #'(lambda (prompt - table - &optional - predicate - require-match - _initial-input - hist - def - inherit-input-method) - (funcall old-completing-read - prompt - table - predicate - require-match - initial-input - hist - def - inherit-input-method))) - (org-refile-get-location nil default-buffer)) - (fset 'completing-read old-completing-read)))) - (pom (nth 3 target-pointer))) - (cond - ((markerp pom) pom) - ((integerp pom) - ;; Convert point to marker to ensure we are always in the correct - ;; buffer; the second element of `target-pointer' contains the path to - ;; the target file - (save-mark-and-excursion - (with-current-buffer (find-file-noselect (nth 1 target-pointer)) - (org-with-wide-buffer - (goto-char pom) - (point-marker))))) - (t (user-error "Invalid location")))))) + (pom (with-current-buffer default-buffer + (consult--read (consult--slow-operation "Collecting headings..." + (or (consult-org--headings t nil scope) + (user-error "No headings"))) + :prompt (or prompt "Choose heading: ") + :category 'org-heading + :sort nil + :initial initial-input + :require-match t + :history '(:input consult-org--history) + :narrow (consult-org--narrow) + :annotate #'consult-org--annotate + :group #'consult-org--group + :lookup (apply-partially #'consult--lookup-prop 'org-marker) + :preview-key nil)))) + (if (markerp pom) + pom + (user-error "Invalid location"))))) (defun db/org-find-links-to-current-item (arg) "Find links to current item.