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

Compare commits

base: exot:2904d462506f10924d6e45451aff922d8e74c3ff
Branches Tags
exot:master
..
compare: exot:a0bcceaf8c74ae33af72fdcc42bc65d5f1854eeb
Branches Tags
exot:master

No commits in common. "2904d462506f10924d6e45451aff922d8e74c3ff" and "a0bcceaf8c74ae33af72fdcc42bc65d5f1854eeb" have entirely different histories.
2904d46250 ... a0bcceaf8c

2 changed files with 93 additions and 68 deletions
Show Stats Expand all files Collapse all files

8
init.el
View File

@ -703,7 +703,6 @@ 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
@ -734,13 +733,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)
@ -779,6 +778,7 @@ 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 nil org-refile-allow-creating-parent-nodes 'confirm
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,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")
@ -480,31 +479,6 @@ 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
@ -1333,7 +1307,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))
@ -1888,25 +1873,35 @@ 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 prompt) (defun db/org-get-location (&optional use-all-org-files initial-input)
"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. Use PROMPT as prompt when given. 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
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))))
@ -1917,37 +1912,67 @@ the variables `org-agenda-files',
(-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 (unless current-buffer-is-in-org-agenda-files? ; avoid duplicate entries ;; provided later to `org-refile-get-location' as additional argument
(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))
(-map #'file-truename)
(-uniq)))
(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 t nil scope) ;; already done so.
(user-error "No headings"))) (and use-all-org-files
:prompt (or prompt "Choose 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.