My Emacs configuration.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

db-org.el 30KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776
  1. ;;; org.el -- Daniel's org mode configuration -*- lexical-binding: t -*-
  2. ;;; Commentary:
  3. ;; This file defines functions used in the main configuration of org-mode and
  4. ;; it’s subpackages. Nothing here changes the behavior of org-mode per se, as
  5. ;; loading this file only defines a couple of functions.
  6. ;;; Code:
  7. (require 'cl-lib)
  8. (require 'org)
  9. (require 'org-agenda)
  10. (require 'org-clock)
  11. (require 'hydra)
  12. (require 'db-customize)
  13. (require 'ox-icalendar)
  14. (autoload 'counsel-org-goto-all "counsel")
  15. (autoload 'which-function "which-func")
  16. (autoload 'org-element-property "org-element")
  17. (declare-function w32-shell-execute "w32fns.c")
  18. ;;; Agenda Customization
  19. (defun db/check-special-org-files-in-agenda (&rest args)
  20. "Check special Org mode files to be part of the variable `org-agenda-files'.
  21. The special Org mode files are `db/org-default-org-file',
  22. `db/org-default-work-file', `db/org-default-home-file', and
  23. `db/org-default-refile-file'. Ignore ARGS."
  24. (ignore args)
  25. (require 'org)
  26. (let ((agenda-files (mapcar #'file-truename (org-agenda-files t))))
  27. (dolist (file '(db/org-default-org-file
  28. db/org-default-home-file
  29. db/org-default-work-file
  30. db/org-default-refile-file))
  31. (when (and (symbol-value file)
  32. (not (member (file-truename (symbol-value file))
  33. agenda-files)))
  34. (warn "File %s is not part of `org-agenda-files'."
  35. file)))))
  36. (defun db/org-agenda-list-deadlines (&optional match)
  37. "Prepare agenda view that only lists upcoming deadlines.
  38. Ignores MATCH. Date is always today, no forward or backward is
  39. supported. Consequently, no date is shown. Also does not
  40. support any of the usual key bindings, e.g., showing a
  41. clockreport. It is, plainly speaking, just listing all active
  42. deadlines."
  43. (interactive "P")
  44. (catch 'exit
  45. (org-agenda-prepare "Deadlines")
  46. (org-compile-prefix-format 'agenda)
  47. (org-set-sorting-strategy 'agenda)
  48. (let* ((today (org-today))
  49. (thefiles (org-agenda-files nil 'ifmode))
  50. (inhibit-redisplay (not debug-on-error))
  51. s rtn rtnall file files date start-pos)
  52. ;; headline
  53. (unless org-agenda-compact-blocks
  54. (setq s (point))
  55. (if org-agenda-overriding-header
  56. (insert (org-add-props (copy-sequence org-agenda-overriding-header)
  57. nil 'face 'org-agenda-structure) "\n"))
  58. (org-agenda-mark-header-line s))
  59. ;; actual content
  60. (setq date (calendar-gregorian-from-absolute today)
  61. s (point)
  62. start-pos (point)
  63. files thefiles
  64. rtnall nil)
  65. (while (setq file (pop files))
  66. (catch 'nextfile
  67. (org-check-agenda-file file)
  68. (setq rtn (apply 'org-agenda-get-day-entries
  69. file date
  70. '(:deadline)))
  71. (setq rtnall (append rtnall rtn)))) ;; all entries
  72. (when rtnall
  73. (insert (org-agenda-finalize-entries rtnall 'agenda)
  74. "\n"))
  75. ;; finalize
  76. (goto-char (point-min))
  77. (or org-agenda-multi (org-agenda-fit-window-to-buffer))
  78. (unless (and (pos-visible-in-window-p (point-min))
  79. (pos-visible-in-window-p (point-max)))
  80. (goto-char (1- (point-max)))
  81. (recenter -1)
  82. (if (not (pos-visible-in-window-p (or start-pos 1)))
  83. (progn
  84. (goto-char (or start-pos 1))
  85. (recenter 1))))
  86. (goto-char (or start-pos 1))
  87. (add-text-properties
  88. (point-min) (point-max)
  89. `(org-agenda-type agenda
  90. org-redo-cmd
  91. (db/org-agenda-list-deadlines ,match)))
  92. (org-agenda-finalize)
  93. (setq buffer-read-only t)
  94. (message ""))))
  95. (defun db/org-agenda-skip-tag (tag &optional others)
  96. ;; https://stackoverflow.com/questions/10074016/org-mode-filter-on-tag-in-agenda-view
  97. "Skip all entries that correspond to TAG.
  98. If OTHERS is true, skip all entries that do not correspond to TAG."
  99. (let* ((next-headline (save-mark-and-excursion
  100. (or (outline-next-heading) (point-max))))
  101. (current-headline (or (and (org-at-heading-p)
  102. (point))
  103. (save-mark-and-excursion
  104. ;; remember to also consider invisible headings
  105. (org-back-to-heading t))))
  106. (has-tag (member tag (org-get-tags current-headline))))
  107. (if (or (and others (not has-tag))
  108. (and (not others) has-tag))
  109. next-headline
  110. nil)))
  111. ;; A Hydra for changing agenda appearance
  112. ;; http://oremacs.com/2016/04/04/hydra-doc-syntax/
  113. (defun db/org-agenda-span ()
  114. "Return the display span of the current shown agenda."
  115. (let ((args (get-text-property
  116. (min (1- (point-max)) (point))
  117. 'org-last-args)))
  118. (nth 2 args)))
  119. (defhydra hydra-org-agenda-view (:hint none)
  120. "
  121. _d_: ?d? day _g_: time grid=?g? _a_: arch-trees
  122. _w_: ?w? week _[_: inactive _A_: arch-files
  123. _t_: ?t? fortnight _F_: follow=?F? _r_: report=?r?
  124. _m_: ?m? month _e_: entry =?e? _D_: diary=?D?
  125. _y_: ?y? year _q_: quit _L__l__c_: ?l?
  126. "
  127. ("SPC" org-agenda-reset-view)
  128. ("d" org-agenda-day-view
  129. (if (eq 'day (db/org-agenda-span))
  130. "[x]" "[ ]"))
  131. ("w" org-agenda-week-view
  132. (if (eq 'week (db/org-agenda-span))
  133. "[x]" "[ ]"))
  134. ("t" org-agenda-fortnight-view
  135. (if (eq 'fortnight (db/org-agenda-span))
  136. "[x]" "[ ]"))
  137. ("m" org-agenda-month-view
  138. (if (eq 'month (db/org-agenda-span)) "[x]" "[ ]"))
  139. ("y" org-agenda-year-view
  140. (if (eq 'year (db/org-agenda-span)) "[x]" "[ ]"))
  141. ("l" org-agenda-log-mode
  142. (format "% -3S" org-agenda-show-log))
  143. ("L" (org-agenda-log-mode '(4)))
  144. ("c" (org-agenda-log-mode 'clockcheck))
  145. ("F" org-agenda-follow-mode
  146. (format "% -3S" org-agenda-follow-mode))
  147. ("a" org-agenda-archives-mode)
  148. ("A" (org-agenda-archives-mode 'files))
  149. ("r" org-agenda-clockreport-mode
  150. (format "% -3S" org-agenda-clockreport-mode))
  151. ("e" org-agenda-entry-text-mode
  152. (format "% -3S" org-agenda-entry-text-mode))
  153. ("g" org-agenda-toggle-time-grid
  154. (format "% -3S" org-agenda-use-time-grid))
  155. ("D" org-agenda-toggle-diary
  156. (format "% -3S" org-agenda-include-diary))
  157. ("!" org-agenda-toggle-deadlines)
  158. ("["
  159. (let ((org-agenda-include-inactive-timestamps t))
  160. (org-agenda-check-type t 'timeline 'agenda)
  161. (org-agenda-redo)))
  162. ("q" (message "Abort") :exit t))
  163. ;; Show sum of daily efforts in agenda, the following two functions are from
  164. ;; anpandey,
  165. ;; cf. https://emacs.stackexchange.com/questions/21380/show-sum-of-efforts-for-a-day-in-org-agenda-day-title#21902
  166. (defun db/org-agenda-calculate-efforts (limit)
  167. "Sum efforts of day entries up to LIMIT in the agenda buffer.
  168. Entries included are those scheduled for that day, scheduled at
  169. some past day (and still on display) and active timestamps (appointments)."
  170. (let (total)
  171. (save-excursion
  172. (while (< (point) limit)
  173. (when (member (org-get-at-bol 'type)
  174. '("scheduled" "past-scheduled" "timestamp"))
  175. (push (org-entry-get (org-get-at-bol 'org-hd-marker) "Effort") total))
  176. (forward-line)))
  177. (org-duration-from-minutes
  178. (cl-reduce #'+
  179. (mapcar #'org-duration-to-minutes
  180. (cl-remove-if-not 'identity total))))))
  181. (defun db/org-agenda-insert-efforts ()
  182. "Insert efforts for each day into the agenda buffer.
  183. Add this function to `org-agenda-finalize-hook' to enable this."
  184. (save-excursion
  185. (let (pos)
  186. (while (setq pos (text-property-any
  187. (point) (point-max) 'org-agenda-date-header t))
  188. (goto-char pos)
  189. (end-of-line)
  190. (insert-and-inherit
  191. (concat " ("
  192. (db/org-agenda-calculate-efforts
  193. (or (next-single-property-change (point) 'day)
  194. ;; If nothing is shown on the current day, the previous
  195. ;; call may return nil; in that case, don't sum anything
  196. ;; by setting the limit to 0
  197. 0))
  198. ")"))
  199. (forward-line)))))
  200. ;;; Capturing
  201. (defun db/org-timestamp-difference (stamp-1 stamp-2)
  202. "Return time difference between two Org mode timestamps.
  203. STAMP-1 and STAMP-2 must be understood by
  204. `org-parse-time-string'."
  205. ;; Things copied from `org-clock-update-time-maybe’
  206. (let* ((s (-
  207. (float-time
  208. (apply #'encode-time (org-parse-time-string stamp-2 t)))
  209. (float-time
  210. (apply #'encode-time (org-parse-time-string stamp-1 t)))))
  211. (neg (< s 0))
  212. (s (abs s))
  213. (h (floor (/ s 3600)))
  214. (m (floor (/ (- s (* 3600 h)) 60))))
  215. (format (if neg "-%d:%02d" "%2d:%02d") h m)))
  216. ;; Capture Code Snippets
  217. ;; from http://ul.io/nb/2018/04/30/better-code-snippets-with-org-capture/
  218. (defun db/org-capture-code-snippet (filename)
  219. "Format Org mode source block with contant of active region in FILENAME."
  220. (with-current-buffer (find-buffer-visiting filename)
  221. (let ((code-snippet (buffer-substring-no-properties (mark) (- (point) 1)))
  222. (func-name (which-function))
  223. (file-name (buffer-file-name))
  224. (line-number (line-number-at-pos (region-beginning)))
  225. (org-src-mode (let ((mm (intern (replace-regexp-in-string
  226. "-mode" "" (format "%s" major-mode)))))
  227. (or (car (rassoc mm org-src-lang-modes))
  228. (format "%s" mm)))))
  229. (format
  230. "file:%s::%s
  231. In ~%s~:
  232. #+BEGIN_SRC %s
  233. %s
  234. #+END_SRC"
  235. file-name
  236. line-number
  237. func-name
  238. org-src-mode
  239. code-snippet))))
  240. ;; Make capture frame, made for being called via emacsclient
  241. ;; https://cestlaz.github.io/posts/using-emacs-24-capture-2/
  242. (defun db/make-org-capture-frame ()
  243. "Create a new frame for capturing."
  244. (interactive)
  245. (make-frame '((name . "capture")))
  246. (select-frame-by-name "capture")
  247. (delete-other-windows)
  248. (org-capture))
  249. (defun db/delete-frame-if-capture (&rest _r)
  250. "If current frame was made for a capture, close after done."
  251. (when (equal (frame-parameter nil 'name)
  252. "capture")
  253. (delete-frame)))
  254. (advice-add 'org-capture-finalize
  255. :after #'db/delete-frame-if-capture)
  256. ;;; Refiling
  257. (defun db/verify-refile-target ()
  258. "Verify that a certain location is eligible as a refile target.
  259. In other words, exclude tasks with a done state and those with
  260. tag PERIODIC."
  261. (and
  262. ;; Exclude DONE state tasks from refile targets (from bh)
  263. (not (member (nth 2 (org-heading-components))
  264. org-done-keywords))))
  265. ;;; Reset checklists
  266. ;; from `org-checklist’ by James TD Smith (@ ahktenzero (. mohorovi cc)),
  267. ;; version: 1.0
  268. (defun org-reset-checkbox-state-maybe ()
  269. "Reset all checkboxes in an entry if `RESET_CHECK_BOXES' property is set."
  270. (interactive "*")
  271. (when (org-entry-get (point) "RESET_CHECK_BOXES")
  272. (warn "Using the RESET_CHECK_BOXES property is deprecated, user periodic tasks instead")
  273. (org-reset-checkbox-state-subtree)))
  274. ;;; Helper Functions for Clocking
  275. (defun db/find-parent-task ()
  276. ;; http://doc.norang.ca/org-mode.html#Clocking
  277. "Return point of the nearest parent task, and NIL if no such task exists."
  278. (save-mark-and-excursion
  279. (save-restriction
  280. (widen)
  281. (let ((parent-task nil))
  282. (or (org-at-heading-p)
  283. (org-back-to-heading t))
  284. (while (and (not parent-task)
  285. (org-up-heading-safe))
  286. (let ((tags (org-get-tags nil 'local)))
  287. (unless (or (member "NOP" tags)
  288. (member "PERIODIC" tags))
  289. (setq parent-task (point)))))
  290. parent-task))))
  291. (defun db/ensure-running-clock ()
  292. "Clocks in into the parent task, if it exists, or the default task."
  293. (when (and (not org-clock-clocking-in)
  294. (not org-clock-resolving-clocks-due-to-idleness))
  295. (let ((parent-task (db/find-parent-task)))
  296. (save-mark-and-excursion
  297. (cond
  298. (parent-task
  299. ;; found parent task
  300. (org-with-point-at parent-task
  301. (org-clock-in)))
  302. ((and (markerp org-clock-default-task)
  303. (marker-buffer org-clock-default-task))
  304. ;; default task is set
  305. (org-with-point-at org-clock-default-task
  306. (org-clock-in)))
  307. (t
  308. (org-clock-in '(4))))))))
  309. (defun db/save-current-org-task-to-file ()
  310. "Format currently clocked task and write it to`db/org-clock-current-task-file'."
  311. (with-temp-file db/org-clock-current-task-file
  312. (let ((clock-buffer (marker-buffer org-clock-marker)))
  313. (if (null clock-buffer)
  314. (insert "No running clock")
  315. (insert org-clock-heading)))))
  316. (defun db/org-update-frame-title-with-current-clock ()
  317. "Set title of all active frames to the headline of the current task."
  318. (interactive)
  319. (let ((clock-buffer (marker-buffer org-clock-marker)))
  320. (when clock-buffer
  321. (dolist (frame (frame-list))
  322. (modify-frame-parameters frame `((name . , org-clock-heading)))))))
  323. (defun db/show-current-org-task ()
  324. "Show title of currently clock in task in modeline."
  325. (interactive)
  326. (message org-clock-current-task))
  327. ;;; Fixes
  328. (defun endless/org-ispell ()
  329. "Configure `ispell-skip-region-alist' for `org-mode'."
  330. (make-local-variable 'ispell-skip-region-alist)
  331. (add-to-list 'ispell-skip-region-alist '(org-property-drawer-re))
  332. (add-to-list 'ispell-skip-region-alist '("~" "~"))
  333. (add-to-list 'ispell-skip-region-alist '("=" "="))
  334. (add-to-list 'ispell-skip-region-alist '("^#\\+BEGIN_SRC" . "^#\\+END_SRC")))
  335. ;;; Hydra
  336. (defun db/clock-in-task-by-id (task-id)
  337. "Clock in org mode task as given by TASK-ID."
  338. (let ((location (org-id-find task-id 'marker)))
  339. (if (null location)
  340. (user-error "Invalid location give: %s»" task-id)
  341. (org-with-point-at location
  342. (org-clock-in))
  343. (org-save-all-org-buffers))))
  344. (defun db/clock-out-task-by-id (task-id)
  345. "Clock out org mode task as given by TASK-ID."
  346. (org-with-point-at (org-id-find task-id 'marker)
  347. (org-clock-out))
  348. (org-save-all-org-buffers))
  349. (defun db/org-clock-out ()
  350. "Clock out current clock."
  351. (interactive)
  352. (org-clock-out))
  353. (defun db/org-clock-in-break-task ()
  354. "Clock into default break task as given by `org-break-task-id’."
  355. (interactive)
  356. (db/clock-in-task-by-id org-break-task-id))
  357. (defun db/org-clock-in-home-task ()
  358. "Clock into default home task as given by `org-home-task-id’."
  359. (interactive)
  360. (db/clock-in-task-by-id org-home-task-id))
  361. (defun db/org-clock-in-work-task ()
  362. "Clock into default work task as given by `org-work-task-id’."
  363. (interactive)
  364. (db/clock-in-task-by-id org-working-task-id))
  365. (defun db/org-clock-in-last-task (&optional arg)
  366. ;; from doc.norang.ca, originally bh/clock-in-last-task
  367. "Clock in the interrupted task if there is one.
  368. Skip the default task and get the next one. If ARG is given,
  369. forces clocking in of the default task."
  370. (interactive "p")
  371. (let ((clock-in-to-task
  372. (cond
  373. ((eq arg 4) org-clock-default-task)
  374. ((and (org-clock-is-active)
  375. (equal org-clock-default-task (cadr org-clock-history)))
  376. (caddr org-clock-history))
  377. ((org-clock-is-active) (cadr org-clock-history))
  378. ((equal org-clock-default-task (car org-clock-history))
  379. (cadr org-clock-history))
  380. (t (car org-clock-history)))))
  381. (widen)
  382. (org-with-point-at clock-in-to-task
  383. (org-clock-in nil))))
  384. (defhydra hydra-org-clock (:color blue)
  385. ;; Quote %, as otherwise they would be misinterpreted as format characters
  386. "\nCurrent Task: %s(replace-regexp-in-string \"%\" \"%%\" org-clock-current-task); "
  387. ("w" (db/org-clock-in-work-task) "work")
  388. ("h" (db/org-clock-in-home-task) "home")
  389. ("b" (db/org-clock-in-break-task) "break")
  390. ("i" (lambda ()
  391. (interactive)
  392. (org-clock-in '(4))) "interactive")
  393. ("a" counsel-org-goto-all "goto")
  394. ("o" org-clock-out "clock out")
  395. ("l" db/org-clock-in-last-task "last")
  396. ("d" (lambda ()
  397. (interactive)
  398. (when (org-clock-is-active)
  399. (save-window-excursion
  400. (org-clock-goto)
  401. (let ((org-inhibit-logging 'note))
  402. (org-todo 'done)
  403. (org-save-all-org-buffers)))))
  404. "default"))
  405. ;;; Babel
  406. (defun org-babel-execute:hy (body params)
  407. ;; http://kitchingroup.cheme.cmu.edu/blog/2016/03/30/OMG-A-Lisp-that-runs-python/
  408. "Execute hy code BODY with parameters PARAMS."
  409. (ignore params)
  410. (let* ((temporary-file-directory ".")
  411. (tempfile (make-temp-file "hy-")))
  412. (with-temp-file tempfile
  413. (insert body))
  414. (unwind-protect
  415. (shell-command-to-string
  416. (format "hy %s" tempfile))
  417. (delete-file tempfile))))
  418. ;;; Custom link handlers
  419. (defun db/org-onenote-open (path)
  420. "Visit OneNote document on PATH."
  421. (unless (file-executable-p db/path-to-onenote)
  422. (user-error "Path for OneNote is not executable, please customize `db/path-to-onenote’"))
  423. (start-process "OneNote" nil db/path-to-onenote "/hyperlink" path))
  424. (defun db/org-outlook-open (id)
  425. "Open Outlook item identified by ID.
  426. ID should be an Outlook GUID."
  427. (unless (file-executable-p db/path-to-outlook)
  428. (user-error "Path for Outlook is not executable, please customize `db/path-to-outlook’"))
  429. (w32-shell-execute "open" db/path-to-outlook (concat "/select outlook:" id)))
  430. (defun db/org-rfc-open (number)
  431. "Open browser to show RFC of given NUMBER.
  432. If `db/rfc-cache-path' is defined, download the RFC in txt format
  433. there and open it. If the RFC has already been downloaded
  434. before, just open it. If `db/rfc-cache-path' is not defined,
  435. open RFC in HTML format in the default browser."
  436. (cond
  437. ((not (string-match "[1-9][0-9]*" number))
  438. (user-error "Not a valid number for an RFC: %s" number))
  439. ((and db/rfc-cache-path
  440. (file-name-absolute-p db/rfc-cache-path)
  441. (file-writable-p db/rfc-cache-path))
  442. (let ((rfc-path (expand-file-name (format "rfc%s.txt" number)
  443. db/rfc-cache-path)))
  444. (cond
  445. ((file-exists-p rfc-path)
  446. (find-file rfc-path))
  447. (t
  448. (with-temp-buffer
  449. (url-insert-file-contents (format "https://tools.ietf.org/rfc/rfc%s.txt"
  450. number))
  451. (write-file rfc-path))
  452. (find-file rfc-path)))))
  453. (t
  454. (warn "`db/rfc-cache-path' not defined or not an absolute writable path, opening RFC in browser.")
  455. (browse-url (concat "https://tools.ietf.org/html/rfc" number)))))
  456. ;;; Org Utilities
  457. (defun db/org-cleanup-continuous-clocks ()
  458. "Join continuous clock lines in the current buffer."
  459. (interactive)
  460. (let* ((inactive-timestamp (org-re-timestamp 'inactive))
  461. (clock-line (concat "\\(^ *\\)CLOCK: " inactive-timestamp "--" inactive-timestamp " => .*"
  462. "\n"
  463. " *CLOCK: " inactive-timestamp "--\\[\\2\\] => .*$")))
  464. (save-excursion
  465. (goto-char (point-min))
  466. (while (search-forward-regexp clock-line nil t)
  467. (replace-match "\\1CLOCK: [\\4]--[\\3]")
  468. (org-clock-update-time-maybe)))))
  469. (defun db/find-csv-in-org (arg)
  470. "Interactively find CSV file and open it as Org mode table.
  471. Default separator is \";\", but this can be changed interactively
  472. by passing a non-nil value for ARG."
  473. (interactive "P")
  474. (let ((separator (if arg (read-from-minibuffer "Separator (regular expression): ")
  475. ";")))
  476. (call-interactively #'find-file)
  477. (org-mode)
  478. (org-table-convert-region (point-min) (point-max) separator)))
  479. (defun db/org-mark-current-default-task ()
  480. "Mark current task as default when equal to work task or home task.
  481. Work task and home task are determined by the current values of
  482. `org-working-task-id’ and `org-home-task-id’, respectively."
  483. (let ((current-id (org-id-get org-clock-marker)))
  484. (when (member current-id (list org-working-task-id
  485. org-home-task-id))
  486. (org-clock-mark-default-task))))
  487. (defun db/org-copy-template-for-periodic-task ()
  488. "Copy template of the enclosing periodic task to item at point.
  489. The template must be placed into an item titled 'Template',
  490. called the template item. The template item must be the first
  491. headline of the periodic task, i.e., of the parent of the current
  492. item at point. The body of the template item, without any
  493. drawers, will be copied to point."
  494. (interactive)
  495. (let ((template (save-restriction
  496. (save-mark-and-excursion
  497. (let ((template-element (progn
  498. (outline-up-heading 1 'invisible-ok)
  499. (outline-next-heading)
  500. (org-element-at-point))))
  501. (unless (string-equal (org-element-property :title template-element)
  502. "Template")
  503. (user-error "Template must be first headline in periodic task"))
  504. ;; Starting from the end of the last element in the
  505. ;; subtree, we go up until we find a drawer or a
  506. ;; headline; everything in between is considered to be the template
  507. (let ((content-end (org-element-property :contents-end template-element))
  508. content-begin current-element)
  509. (goto-char content-end)
  510. (while (progn
  511. (setq current-element (org-element-at-point))
  512. (not (memq (org-element-type current-element)
  513. '(drawer property-drawer headline))))
  514. (setq content-begin (org-element-property :begin current-element))
  515. (goto-char (1- content-begin)))
  516. (string-trim-right
  517. (buffer-substring-no-properties content-begin content-end))))))))
  518. (insert template)
  519. (org-update-statistics-cookies nil)))
  520. ;;; Calendar
  521. (defun db/export-diary ()
  522. "Export diary.org as ics file to `org-icalendar-combined-agenda-file’.
  523. This is done only if the value of this variable is not null."
  524. (interactive)
  525. (cond
  526. ((null org-icalendar-combined-agenda-file)
  527. (message "`org-icalendar-combined-agenda-file’ not set, not exporting diary."))
  528. ((not (file-name-absolute-p org-icalendar-combined-agenda-file))
  529. (user-error "`org-icalendar-combined-agenda-file’ not an absolute path, aborting"))
  530. (t
  531. (progn
  532. (org-save-all-org-buffers)
  533. (let ((org-agenda-files (cl-remove-if #'null
  534. (list db/org-default-org-file
  535. db/org-default-home-file
  536. db/org-default-work-file)))
  537. (org-agenda-new-buffers nil))
  538. ;; check whether we need to do something
  539. (when (cl-some (lambda (org-file)
  540. (file-newer-than-file-p org-file
  541. org-icalendar-combined-agenda-file))
  542. org-agenda-files)
  543. (message "Exporting diary ...")
  544. ;; open files manually to avoid polluting `org-agenda-new-buffers’; we
  545. ;; don’t want these buffers to be closed after exporting
  546. (mapc #'find-file-noselect org-agenda-files)
  547. ;; actual export; calls `org-release-buffers’ and may thus close
  548. ;; buffers we want to keep around … which is why we set
  549. ;; `org-agenda-new-buffers’ to nil
  550. (when (file-exists-p org-icalendar-combined-agenda-file)
  551. (delete-file org-icalendar-combined-agenda-file)
  552. (sit-for 3))
  553. (org-icalendar-combine-agenda-files)
  554. (message "Exporting diary ... done.")))))))
  555. ;;; Find items by link to current headline
  556. (defun db/org-find-items-linking-by-id (id custom-id)
  557. "List all Org Mode items that link to ID.
  558. Uses `org-search-view' to conduct the actual search. ID must be
  559. a UUID as generated by, e.g., `org-id-get-create', and CUSTOM-ID
  560. must consist of ASCII letters, numbers, and hyphens only. Each
  561. of ID and CUSTOM-ID may be nil, but at least one of them must be
  562. not."
  563. (unless (or (not id)
  564. (and (stringp id)
  565. (string-match-p "^[a-f0-9]\\{8\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{12\\}$" id)))
  566. (user-error "Given ID is not a valid UUID: %s" id))
  567. (unless (or (not custom-id)
  568. (and (stringp custom-id)
  569. (string-match-p "[-a-zA-Z0-9]" custom-id)))
  570. ;; sorry, only ASCII right now …
  571. (user-error "CUSTOM_ID must consist of alphanumeric charaters only"))
  572. (let ((query (cond
  573. ((and id custom-id) (format "{\\[\\[id:%s\\]\\|\\[\\[file:[^]]*::#%s\\]\\|\\[#%s\\]}"
  574. id custom-id custom-id))
  575. (id (format "[[id:%s]" id))
  576. (custom-id (format "{\\[file:[^]]*::#%s\\]\\|\\[#%s\\]}"
  577. custom-id custom-id))
  578. (t (user-error "Neither ID nor CUSTOM_ID given")))))
  579. (org-search-view nil query)))
  580. (defun db/org--get-location (&optional arg)
  581. "Interactively query for location and return mark.
  582. Searches through the current buffer if that one is associated
  583. with a file, or `db/org-default-org-file'. When ARG is non-nil,
  584. search through all files in the variables `org-agenda-files',
  585. `org-agenda-text-search-extra-files', and the current file or
  586. `db/org-default-org-file'.
  587. Search is always conducted up to level 9. If the selected
  588. location does not have an associated point or mark, error out.
  589. Disable refile cache and any active refile filter hooks to allow
  590. linking to any item."
  591. (let ((org-refile-target-verify-function nil)
  592. (org-refile-use-cache nil)
  593. ;; If the current buffer is associated with a file, search through it;
  594. ;; otherwise, use the default Org Mode file as default buffer
  595. (default-buffer (if (buffer-file-name)
  596. (current-buffer)
  597. (find-file-noselect db/org-default-org-file))))
  598. (when (null default-buffer)
  599. (user-error "Current buffer is not associated with a file and `db/org-default-org-file' does not exist; nothing to search through"))
  600. (let* ((org-refile-targets (if arg
  601. `((org-agenda-files :maxlevel . 9)
  602. (,(cl-remove-if-not
  603. #'stringp org-agenda-text-search-extra-files)
  604. :maxlevel . 9)
  605. (nil :maxlevel . 9))
  606. '((nil :maxlevel . 9))))
  607. (pom (nth 3 (org-refile-get-location nil default-buffer))))
  608. (cond
  609. ((markerp pom) pom)
  610. ((integerp pom)
  611. ;; Convert point to marker to ensure we are always in the correct buffer
  612. (save-mark-and-excursion
  613. (with-current-buffer default-buffer
  614. (goto-char pom)
  615. (point-marker))))
  616. (t (user-error "Invalid location"))))))
  617. (defun db/org-find-links-to-current-item (arg)
  618. "Find links to current item.
  619. Only links using the ID or CUSTOM_ID property are considered.
  620. If ARG is given, or if neither in an Org Mode buffer nor on a
  621. headline in an Org Agenda buffer, interactively prompt for an
  622. item."
  623. (interactive "P")
  624. (apply #'db/org-find-items-linking-by-id
  625. (cond ((and (not arg) (derived-mode-p 'org-mode))
  626. (list (org-id-get) (org-entry-get nil "CUSTOM_ID")))
  627. ((and (not arg)
  628. (derived-mode-p 'org-agenda-mode)
  629. (org-get-at-bol 'org-hd-marker))
  630. (org-with-point-at (org-get-at-bol 'org-hd-marker)
  631. (list (org-id-get) (org-entry-get nil "CUSTOM_ID"))))
  632. (t
  633. (org-with-point-at (db/org--get-location)
  634. (list (org-id-get) (org-entry-get nil "CUSTOM_ID")))))))
  635. (defun db/org-add-link-to-other-item (arg)
  636. "Interactively query for item and add link to it at point.
  637. Search through all items of the current buffer, or
  638. `db/org-default-org-file' if the current buffer is not associated
  639. with a file. If ARG is non-nil, include all files in the
  640. variables `org-agenda-files' and
  641. `org-agenda-text-search-extra-files' in this search.
  642. Use `org-store-link' to save link to `org-stored-links'."
  643. (interactive "P")
  644. (unless (derived-mode-p 'org-mode)
  645. (user-error "Not in Org Mode"))
  646. (let ((pom (db/org--get-location arg)))
  647. (save-mark-and-excursion
  648. (org-with-point-at pom
  649. (org-store-link nil t))
  650. (insert (apply #'format "[[%s][%s]]" (cl-first org-stored-links))))))
  651. (defun db/org-add-link-to-current-clock ()
  652. "Insert link to currently clocked-in item at point.
  653. Uses `org-store-link' and `org-insert-link'. Error out when not
  654. in an Org Mode buffer or when the clock is not active."
  655. (interactive)
  656. (unless (derived-mode-p 'org-mode)
  657. (user-error "Not in Org Mode, aborting"))
  658. (unless org-clock-marker
  659. (user-error "No clocked-in task, aborting"))
  660. (save-mark-and-excursion
  661. (org-with-point-at org-clock-marker
  662. (org-store-link nil t)))
  663. (pcase-let ((`(,location ,description) (cl-first org-stored-links)))
  664. (org-insert-link nil location description)))
  665. (defhydra hydra-org-linking (:color blue :hint none)
  666. "
  667. Add link at point to …
  668. … _c_urrent clock
  669. … _o_ther item (from current file buffer or default Org file)
  670. … _O_ther item (from all Org mode text search files)
  671. Show _b_acklinks to current item."
  672. ("c" db/org-add-link-to-current-clock)
  673. ("o" (db/org-add-link-to-other-item nil))
  674. ("O" (db/org-add-link-to-other-item t))
  675. ("b" db/org-find-links-to-current-item))
  676. ;;; End
  677. (provide 'db-org)
  678. ;;; db-org.el ends here