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

Merge branch 'use-consult-for-org-headlines'

Browse Source
This commit is contained in:
Daniel Borchmann 2025-08-22 16:56:50 +02:00
commit 2904d46250
No known key found for this signature in database
GPG Key ID: 50EA937BF472ADD1
2 changed files with 68 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
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
@ -733,13 +734,13 @@ split horizontally again, but this extra work should not matter much."
;; that are defined in those packages. ;; that are defined in those packages.
(use-package org-attach) (use-package org-attach)
(use-package org-id) (use-package org-id)
(use-package org-goto)
(use-package org (use-package org
: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)
@ -778,7 +779,6 @@ split horizontally again, but this extra work should not matter much."
org-attach-store-link-p 'attached org-attach-store-link-p 'attached
org-attach-auto-tag nil org-attach-auto-tag nil
org-bookmark-names-plist nil org-bookmark-names-plist nil
org-goto-interface 'outline-path-completion
org-id-link-to-org-use-id t org-id-link-to-org-use-id t
org-return-follows-link t org-return-follows-link t
org-hide-emphasis-markers 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))) (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)

153
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")
@ -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:. ;; 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
@ -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) ("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))
@ -1873,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))))
@ -1912,67 +1917,37 @@ 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))
(-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 (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.