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

Compare commits

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

No commits in common. "fb8b2837d5c59d2e81491ee6690fbc76c7acac65" and "fcb340ad81bd3e9bcf877367c507cc363da13f6f" have entirely different histories.
fb8b2837d5 ... fcb340ad81

1 changed files with 81 additions and 33 deletions
Show Stats Expand all files Collapse all files

114
site-lisp/db-org.el
View File

@ -22,7 +22,6 @@
(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")
@ -1306,7 +1305,18 @@ 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" (consult-org-heading nil 'agenda) ("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))))
nil) nil)
("s" (db/org-clock-goto-first-open-checkbox t) ("s" (db/org-clock-goto-first-open-checkbox t)
nil)) nil))
@ -1870,9 +1880,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.
However, if the current buffer is associated with a file from the list If the current buffer is associated with a file from the variable
returned by the function `org-agenda-files', the search is extended `org-agenda-files', though, the search is extended through all
through all agenda files (the rationale being that Org agenda files are 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
@ -1884,7 +1894,12 @@ 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 ((default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode)) (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))))
@ -1895,34 +1910,67 @@ linking to any item."
(-any (-partial #'file-equal-p it) (-any (-partial #'file-equal-p it)
org-agenda-files))) org-agenda-files)))
(scope (cond (use-all-org-files ;; Default file(s) to search through; note that `default-buffer' is
(append (list (buffer-file-name default-buffer)) ;; provided later to `org-refile-get-location' as additional argument
(org-agenda-files) (org-refile-targets (append (if current-buffer-is-in-org-agenda-files?
(cl-remove-if-not #'stringp '((org-agenda-files :maxlevel . 9))
org-agenda-text-search-extra-files))) '((nil :maxlevel . 9)))
(current-buffer-is-in-org-agenda-files?
(org-agenda-files))
(t
(list (buffer-file-name default-buffer)))))
(pom (with-current-buffer default-buffer ;; When USE-ALL-ORG-FILES is non-nil, add
(consult--read (consult--slow-operation "Collecting headings..." ;; all agenda files, but only if not
(or (consult-org--headings nil nil scope) ;; already done so.
(user-error "No headings"))) (and use-all-org-files
:prompt "Go to heading: " (not current-buffer-is-in-org-agenda-files?)
:category 'org-heading '((org-agenda-files :maxlevel . 9)))
:sort nil
:initial initial-input ;; When USE-ALL-ORG-FILES is non-nil, add
:require-match t ;; extra file files to search though.
:history '(:input consult-org--history) (and use-all-org-files
:narrow (consult-org--narrow) `((,(cl-remove-if-not #'stringp
:annotate #'consult-org--annotate org-agenda-text-search-extra-files)
:group #'consult-org--group :maxlevel . 9)))))
:lookup (apply-partially #'consult--lookup-prop 'org-marker)
:preview-key nil)))) (target-pointer (let ((old-completing-read (symbol-function 'completing-read)))
(if (markerp pom) ;; We temporarily overwrite `completing-read' to
pom ;; provide our initial input; this is necessary
(user-error "Invalid location"))))) ;; 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"))))))
(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.