exot/.emacs.d
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Compare commits

base: exot:fcb340ad81bd3e9bcf877367c507cc363da13f6f
Branches Tags
exot:master
...
compare: exot:fb8b2837d5c59d2e81491ee6690fbc76c7acac65
Branches Tags
exot:master

2 Commits
fcb340ad81 ... fb8b2837d5

Author SHA1 Message Date
Daniel Borchmann
fb8b2837d5
Use default buffer for Org location queries 2025-08-17 13:08:18 +02:00
Daniel Borchmann
928ef10ac5
Replace custom usage of `org-refile-targets' with consult functions 
This is experimental and needs some further testing.
 2025-08-17 13:05:04 +02:00
1 changed files with 33 additions and 81 deletions
Show Stats Expand all files Collapse all files

114
site-lisp/db-org.el
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")
@ -1305,18 +1306,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))
@ -1880,9 +1870,9 @@ locations.
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
@ -1894,12 +1884,7 @@ Search is always conducted up to level 9. If the selected
location does not have an associated point or mark, error out. location does not have an associated point or mark, error out.
Disable refile cache and any active refile filter hooks to allow Disable refile cache and any active refile filter hooks to allow
linking to any item." linking to any item."
(let ((org-refile-target-verify-function nil) (let ((default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode))
(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 +1895,34 @@ 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 (list (buffer-file-name default-buffer))
(org-refile-targets (append (if current-buffer-is-in-org-agenda-files? (org-agenda-files)
'((org-agenda-files :maxlevel . 9)) (cl-remove-if-not #'stringp
'((nil :maxlevel . 9))) 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 nil nil scope)
(and use-all-org-files (user-error "No headings")))
(not current-buffer-is-in-org-agenda-files?) :prompt "Go to 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.