Compare commits

...

16 Commits

Author SHA1 Message Date
4e59c1467d
Remember to incorporate org-refile-target-verify-function 2025-08-17 19:53:05 +02:00
d6ea954434
Remove obsolete docstring parts 2025-08-17 19:53:04 +02:00
bc22db34da
Don't quote nil 2025-08-17 19:53:04 +02:00
4dd695a333
Use consult function to provide org-goto
`org-goto` does not work as before, as our custom Org refile location query function does not honor
the `org-refile-targets` variable.  So, let's just use `consult-org-heading` directly, since this is
what I want.
2025-08-17 19:53:03 +02:00
8c5cdd00bd
Provide regular expression in custom Org refile location function
Not sure what this is good for, but it might be necessary somewhen?
2025-08-17 19:53:03 +02:00
b10c97e06d
Fix type signature for org-refile-get-location substitute function 2025-08-17 19:53:03 +02:00
1ccc8d927d
Use consult for querying Org refile locations 2025-08-17 19:53:02 +02:00
44fb922b66
Allow custom prompt in own Org location query function 2025-08-17 19:53:02 +02:00
eff28a5321
Make custom Org location query function available in main init file 2025-08-17 19:53:02 +02:00
504b3cab80
Do not create new nodes when refiling
I haven't used this … ever?
2025-08-17 19:53:01 +02:00
7f512bed15
Avoid duplicate entries in Org location queries
This happens when the current buffer is already part of the Org agenda files.  In this case, we do
not add the default buffer to the list of search files.
2025-08-17 19:53:01 +02:00
e60dee0a13
Fix prompt when choosing Org headings 2025-08-17 19:53:01 +02:00
5d7776a6dd
Include prefix when choosing Org heading
Otherwise, the candidates seem to be truncated at the front?
2025-08-17 19:53:00 +02:00
9780f1fe7f
Use default buffer for Org location queries 2025-08-17 19:53:00 +02:00
27582a4195
Replace custom usage of `org-refile-targets' with consult functions
This is experimental and needs some further testing.
2025-08-17 19:53:00 +02:00
a0bcceaf8c
Prevent unintented expansion of % in conversion from item to heading 2025-08-17 19:52:04 +02:00
2 changed files with 80 additions and 95 deletions

18
init.el
View File

@ -703,6 +703,7 @@ split horizontally again, but this extra work should not matter much."
db/org-clock-goto-first-open-checkbox) db/org-clock-goto-first-open-checkbox)
:autoload (db/check-special-org-files-in-agenda :autoload (db/check-special-org-files-in-agenda
db/verify-refile-target db/verify-refile-target
db/org-refile-get-location
db/find-parent-task db/find-parent-task
db/ensure-running-clock db/ensure-running-clock
db/save-current-org-task-to-file db/save-current-org-task-to-file
@ -727,7 +728,8 @@ split horizontally again, but this extra work should not matter much."
db/org-bookmark-store-link db/org-bookmark-store-link
db/org-bookmark-export db/org-bookmark-export
db/org-lint-invalid-bookmark-link db/org-lint-invalid-bookmark-link
db/org-lint-possible-bookmark-link)) db/org-lint-possible-bookmark-link
db/org-get-location))
;; This is to make the byte-compiler happy about setting some variables later on ;; This is to make the byte-compiler happy about setting some variables later on
;; that are defined in those packages. ;; that are defined in those packages.
@ -739,7 +741,8 @@ split horizontally again, but this extra work should not matter much."
:pin "gnu" :pin "gnu"
:bind (:map org-mode-map :bind (:map org-mode-map
([remap org-return] . (lambda () (interactive) (org-return :indent))) ([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 :autoload (org-get-todo-state
org-entry-get) org-entry-get)
:commands (org-return) :commands (org-return)
@ -872,7 +875,7 @@ split horizontally again, but this extra work should not matter much."
(db/org-default-notes-file . (:maxlevel . 9))) (db/org-default-notes-file . (:maxlevel . 9)))
org-refile-use-outline-path 'buffer-name org-refile-use-outline-path 'buffer-name
org-refile-use-cache nil 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-indirect-buffer-display 'current-window
org-outline-path-complete-in-steps nil org-outline-path-complete-in-steps nil
org-refile-target-verify-function 'db/verify-refile-target) org-refile-target-verify-function 'db/verify-refile-target)
@ -947,7 +950,14 @@ split horizontally again, but this extra work should not matter much."
(org-agenda-redo-all)) (org-agenda-redo-all))
;; Inhibit direct input when point is at the beginning of a headline. ;; Inhibit direct input when point is at the beginning of a headline.
(add-to-list 'org-speed-command-hook 'db/org-ignore-insert-on-headline-start))) (add-to-list 'org-speed-command-hook 'db/org-ignore-insert-on-headline-start)
;; Use consult for querying refile targets
(define-advice org-refile-get-location (:around
(orig-func &optional prompt default-buffer new-nodes)
use-consult-instead)
(ignore orig-func)
(db/org-refile-get-location prompt default-buffer new-nodes))))
(use-package org-cycle (use-package org-cycle
:autoload (org-cycle-hide-drawers) :autoload (org-cycle-hide-drawers)

View File

@ -22,6 +22,7 @@
(require 'holidays) (require 'holidays)
(require 'dired) (require 'dired)
(require 'bookmark) (require 'bookmark)
(require 'consult-org)
(autoload 'which-function "which-func") (autoload 'which-function "which-func")
(autoload 'org-element-property "org-element") (autoload 'org-element-property "org-element")
@ -450,8 +451,10 @@ Via %%(with-temp-buffer (db/org-add-link-to-current-clock) (string-trim (buffer-
%s %s
%%?" %%?"
first-line-of-body ;; Quote % to prevent unintented expansion by
rest-of-body))) ;; `org-capture-fill-template'.
(replace-regexp-in-string "%" "\\\\%" first-line-of-body)
(replace-regexp-in-string "%" "\\\\%" rest-of-body))))
(org-capture-set-target-location) (org-capture-set-target-location)
(org-capture-place-template) (org-capture-place-template)
@ -477,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:. ;; any agenda when a super-item is tagged with :HOLD:.
(not (member "HOLD" (org-get-tags (point)))))) (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 ;;; Helper Functions for Clocking
@ -1305,18 +1333,7 @@ Current Task: %s(replace-regexp-in-string \"%\" \"%%\" (or org-clock-current-tas
" "
("c" (db/org-clock-goto-first-open-checkbox nil) ("c" (db/org-clock-goto-first-open-checkbox nil)
nil) nil)
("a" (with-current-buffer ("a" (consult-org-heading nil 'agenda)
;; 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))))
nil) nil)
("s" (db/org-clock-goto-first-open-checkbox t) ("s" (db/org-clock-goto-first-open-checkbox t)
nil)) nil))
@ -1871,35 +1888,25 @@ not."
(t (user-error "Neither ID nor CUSTOM_ID given"))))) (t (user-error "Neither ID nor CUSTOM_ID given")))))
(org-search-view nil query))) (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. "Interactively query for location and return mark.
Use INITIAL-INPUT as initial input when filtering available 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 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 through the current buffer if that one is an Org buffer and is
associated with a file, and `db/org-default-org-file' otherwise. associated with a file, and `db/org-default-org-file' otherwise.
If the current buffer is associated with a file from the variable However, if the current buffer is associated with a file from the list
`org-agenda-files', though, the search is extended through all returned by the function `org-agenda-files', the search is extended
agenda files (the rationale being that Org agenda files are through all agenda files (the rationale being that Org agenda files are
always considered to be one large data collection). always considered to be one large data collection).
When USE-ALL-ORG-FILES is non-nil, search through all files in When USE-ALL-ORG-FILES is non-nil, search through all files in
the variables `org-agenda-files', the variables `org-agenda-files',
`org-agenda-text-search-extra-files', and the current file or `org-agenda-text-search-extra-files', and the current file or
`db/org-default-org-file' as described above. `db/org-default-org-file' as described above."
(let ((default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode))
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))
(current-buffer) (current-buffer)
(find-file-noselect db/org-default-org-file)))) (find-file-noselect db/org-default-org-file))))
@ -1910,67 +1917,35 @@ linking to any item."
(-any (-partial #'file-equal-p it) (-any (-partial #'file-equal-p it)
org-agenda-files))) org-agenda-files)))
;; Default file(s) to search through; note that `default-buffer' is (scope (cond (use-all-org-files
;; provided later to `org-refile-get-location' as additional argument (append (unless current-buffer-is-in-org-agenda-files? ; avoid duplicate entries
(org-refile-targets (append (if current-buffer-is-in-org-agenda-files? (list (buffer-file-name default-buffer)))
'((org-agenda-files :maxlevel . 9)) (org-agenda-files)
'((nil :maxlevel . 9))) (cl-remove-if-not #'stringp
org-agenda-text-search-extra-files)))
(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 (pom (with-current-buffer default-buffer
;; all agenda files, but only if not (consult--read (consult--slow-operation "Collecting headings..."
;; already done so. (or (consult-org--headings t nil scope)
(and use-all-org-files (user-error "No headings")))
(not current-buffer-is-in-org-agenda-files?) :prompt (or prompt "Choose heading: ")
'((org-agenda-files :maxlevel . 9))) :category 'org-heading
:sort nil
;; When USE-ALL-ORG-FILES is non-nil, add :initial initial-input
;; extra file files to search though. :require-match t
(and use-all-org-files :history '(:input consult-org--history)
`((,(cl-remove-if-not #'stringp :narrow (consult-org--narrow)
org-agenda-text-search-extra-files) :annotate #'consult-org--annotate
:maxlevel . 9))))) :group #'consult-org--group
:lookup (apply-partially #'consult--lookup-prop 'org-marker)
(target-pointer (let ((old-completing-read (symbol-function 'completing-read))) :preview-key nil))))
;; We temporarily overwrite `completing-read' to (if (markerp pom)
;; provide our initial input; this is necessary pom
;; because `org-refile-get-location' sets the (user-error "Invalid location")))))
;; 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"))))))
(defun db/org-find-links-to-current-item (arg) (defun db/org-find-links-to-current-item (arg)
"Find links to current item. "Find links to current item.