2017-12-03 09:19:05 +01:00
|
|
|
|
;;; org.el -- Daniel's org mode configuration -*- lexical-binding: t -*-
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
2018-11-03 11:38:42 +01:00
|
|
|
|
;; This file defines functions used in the main configuration of org-mode and
|
|
|
|
|
;; it’s subpackages. Nothing here changes the behavior of org-mode per se, as
|
|
|
|
|
;; loading this file only defines a couple of functions.
|
2018-01-21 18:12:48 +01:00
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
;;; Code:
|
|
|
|
|
|
2021-12-15 09:43:50 +01:00
|
|
|
|
(require 'subr-x)
|
2022-09-10 09:12:02 +02:00
|
|
|
|
(require 'dash)
|
2021-01-29 17:51:26 +01:00
|
|
|
|
(require 'cl-lib)
|
2020-06-26 21:53:05 +02:00
|
|
|
|
(require 'org)
|
|
|
|
|
(require 'org-agenda)
|
2020-06-26 22:07:14 +02:00
|
|
|
|
(require 'org-clock)
|
2020-06-26 21:53:05 +02:00
|
|
|
|
(require 'hydra)
|
2020-01-19 17:17:47 +01:00
|
|
|
|
(require 'db-customize)
|
2020-06-27 10:12:46 +02:00
|
|
|
|
(require 'ox-icalendar)
|
2022-04-16 09:58:46 +02:00
|
|
|
|
(require 'org-ql)
|
2020-01-19 17:17:47 +01:00
|
|
|
|
|
2020-06-27 10:10:59 +02:00
|
|
|
|
(autoload 'counsel-org-goto-all "counsel")
|
|
|
|
|
(autoload 'which-function "which-func")
|
|
|
|
|
(autoload 'org-element-property "org-element")
|
|
|
|
|
|
2020-06-27 09:42:16 +02:00
|
|
|
|
(declare-function w32-shell-execute "w32fns.c")
|
2020-06-26 21:53:05 +02:00
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;;; Agenda Customization
|
|
|
|
|
|
2020-01-05 13:36:37 +01:00
|
|
|
|
(defun db/check-special-org-files-in-agenda (&rest args)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Check special Org mode files to be part of the variable `org-agenda-files'.
|
|
|
|
|
The special Org mode files are `db/org-default-org-file',
|
2020-09-20 10:39:58 +02:00
|
|
|
|
`db/org-default-work-file', `db/org-default-home-file', and
|
2021-03-20 16:03:12 +01:00
|
|
|
|
`db/org-default-refile-file'. Ignore ARGS."
|
2020-01-05 14:42:13 +01:00
|
|
|
|
(ignore args)
|
2020-01-05 13:36:37 +01:00
|
|
|
|
(require 'org)
|
|
|
|
|
(let ((agenda-files (mapcar #'file-truename (org-agenda-files t))))
|
2020-08-27 12:16:54 +02:00
|
|
|
|
(dolist (file '(db/org-default-org-file
|
|
|
|
|
db/org-default-home-file
|
2020-01-05 13:36:37 +01:00
|
|
|
|
db/org-default-work-file
|
|
|
|
|
db/org-default-refile-file))
|
|
|
|
|
(when (and (symbol-value file)
|
|
|
|
|
(not (member (file-truename (symbol-value file))
|
|
|
|
|
agenda-files)))
|
|
|
|
|
(warn "File %s is not part of `org-agenda-files'."
|
|
|
|
|
file)))))
|
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
(defun db/org-agenda-list-deadlines (&optional match)
|
|
|
|
|
"Prepare agenda view that only lists upcoming deadlines.
|
|
|
|
|
|
2020-09-17 16:05:20 +02:00
|
|
|
|
Ignores MATCH. Date is always today, no forward or backward is
|
|
|
|
|
supported. Consequently, no date is shown. Also does not
|
|
|
|
|
support any of the usual key bindings, e.g., showing a
|
|
|
|
|
clockreport. It is, plainly speaking, just listing all active
|
|
|
|
|
deadlines."
|
2017-07-16 18:07:00 +02:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(catch 'exit
|
|
|
|
|
(org-agenda-prepare "Deadlines")
|
|
|
|
|
(org-compile-prefix-format 'agenda)
|
|
|
|
|
(org-set-sorting-strategy 'agenda)
|
|
|
|
|
|
|
|
|
|
(let* ((today (org-today))
|
|
|
|
|
(thefiles (org-agenda-files nil 'ifmode))
|
|
|
|
|
(inhibit-redisplay (not debug-on-error))
|
2018-01-16 17:55:15 +01:00
|
|
|
|
s rtn rtnall file files date start-pos)
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;; headline
|
|
|
|
|
(unless org-agenda-compact-blocks
|
|
|
|
|
(setq s (point))
|
|
|
|
|
(if org-agenda-overriding-header
|
|
|
|
|
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
|
2022-05-08 17:04:40 +02:00
|
|
|
|
nil 'face 'org-agenda-structure)
|
|
|
|
|
"\n"))
|
2017-07-16 18:07:00 +02:00
|
|
|
|
(org-agenda-mark-header-line s))
|
|
|
|
|
|
|
|
|
|
;; actual content
|
|
|
|
|
(setq date (calendar-gregorian-from-absolute today)
|
|
|
|
|
s (point)
|
|
|
|
|
start-pos (point)
|
|
|
|
|
files thefiles
|
|
|
|
|
rtnall nil)
|
|
|
|
|
(while (setq file (pop files))
|
|
|
|
|
(catch 'nextfile
|
|
|
|
|
(org-check-agenda-file file)
|
|
|
|
|
(setq rtn (apply 'org-agenda-get-day-entries
|
|
|
|
|
file date
|
|
|
|
|
'(:deadline)))
|
|
|
|
|
(setq rtnall (append rtnall rtn)))) ;; all entries
|
|
|
|
|
(when rtnall
|
|
|
|
|
(insert (org-agenda-finalize-entries rtnall 'agenda)
|
|
|
|
|
"\n"))
|
|
|
|
|
|
|
|
|
|
;; finalize
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
|
|
|
|
|
(unless (and (pos-visible-in-window-p (point-min))
|
|
|
|
|
(pos-visible-in-window-p (point-max)))
|
|
|
|
|
(goto-char (1- (point-max)))
|
|
|
|
|
(recenter -1)
|
|
|
|
|
(if (not (pos-visible-in-window-p (or start-pos 1)))
|
|
|
|
|
(progn
|
|
|
|
|
(goto-char (or start-pos 1))
|
|
|
|
|
(recenter 1))))
|
|
|
|
|
(goto-char (or start-pos 1))
|
|
|
|
|
(add-text-properties
|
|
|
|
|
(point-min) (point-max)
|
|
|
|
|
`(org-agenda-type agenda
|
|
|
|
|
org-redo-cmd
|
|
|
|
|
(db/org-agenda-list-deadlines ,match)))
|
|
|
|
|
(org-agenda-finalize)
|
|
|
|
|
(setq buffer-read-only t)
|
|
|
|
|
(message ""))))
|
|
|
|
|
|
|
|
|
|
(defun db/org-agenda-skip-tag (tag &optional others)
|
|
|
|
|
;; https://stackoverflow.com/questions/10074016/org-mode-filter-on-tag-in-agenda-view
|
|
|
|
|
"Skip all entries that correspond to TAG.
|
|
|
|
|
|
|
|
|
|
If OTHERS is true, skip all entries that do not correspond to TAG."
|
|
|
|
|
(let* ((next-headline (save-mark-and-excursion
|
|
|
|
|
(or (outline-next-heading) (point-max))))
|
|
|
|
|
(current-headline (or (and (org-at-heading-p)
|
|
|
|
|
(point))
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
;; remember to also consider invisible headings
|
|
|
|
|
(org-back-to-heading t))))
|
2020-06-26 22:17:25 +02:00
|
|
|
|
(has-tag (member tag (org-get-tags current-headline))))
|
2017-07-16 18:07:00 +02:00
|
|
|
|
(if (or (and others (not has-tag))
|
|
|
|
|
(and (not others) has-tag))
|
|
|
|
|
next-headline
|
|
|
|
|
nil)))
|
|
|
|
|
|
|
|
|
|
;; A Hydra for changing agenda appearance
|
|
|
|
|
;; http://oremacs.com/2016/04/04/hydra-doc-syntax/
|
|
|
|
|
|
|
|
|
|
(defun db/org-agenda-span ()
|
|
|
|
|
"Return the display span of the current shown agenda."
|
|
|
|
|
(let ((args (get-text-property
|
|
|
|
|
(min (1- (point-max)) (point))
|
|
|
|
|
'org-last-args)))
|
|
|
|
|
(nth 2 args)))
|
|
|
|
|
|
|
|
|
|
(defhydra hydra-org-agenda-view (:hint none)
|
|
|
|
|
"
|
|
|
|
|
_d_: ?d? day _g_: time grid=?g? _a_: arch-trees
|
|
|
|
|
_w_: ?w? week _[_: inactive _A_: arch-files
|
|
|
|
|
_t_: ?t? fortnight _F_: follow=?F? _r_: report=?r?
|
|
|
|
|
_m_: ?m? month _e_: entry =?e? _D_: diary=?D?
|
|
|
|
|
_y_: ?y? year _q_: quit _L__l__c_: ?l?
|
|
|
|
|
|
|
|
|
|
"
|
|
|
|
|
("SPC" org-agenda-reset-view)
|
|
|
|
|
("d" org-agenda-day-view
|
|
|
|
|
(if (eq 'day (db/org-agenda-span))
|
|
|
|
|
"[x]" "[ ]"))
|
|
|
|
|
("w" org-agenda-week-view
|
|
|
|
|
(if (eq 'week (db/org-agenda-span))
|
|
|
|
|
"[x]" "[ ]"))
|
|
|
|
|
("t" org-agenda-fortnight-view
|
|
|
|
|
(if (eq 'fortnight (db/org-agenda-span))
|
|
|
|
|
"[x]" "[ ]"))
|
|
|
|
|
("m" org-agenda-month-view
|
|
|
|
|
(if (eq 'month (db/org-agenda-span)) "[x]" "[ ]"))
|
|
|
|
|
("y" org-agenda-year-view
|
|
|
|
|
(if (eq 'year (db/org-agenda-span)) "[x]" "[ ]"))
|
|
|
|
|
("l" org-agenda-log-mode
|
|
|
|
|
(format "% -3S" org-agenda-show-log))
|
|
|
|
|
("L" (org-agenda-log-mode '(4)))
|
|
|
|
|
("c" (org-agenda-log-mode 'clockcheck))
|
|
|
|
|
("F" org-agenda-follow-mode
|
|
|
|
|
(format "% -3S" org-agenda-follow-mode))
|
|
|
|
|
("a" org-agenda-archives-mode)
|
|
|
|
|
("A" (org-agenda-archives-mode 'files))
|
|
|
|
|
("r" org-agenda-clockreport-mode
|
|
|
|
|
(format "% -3S" org-agenda-clockreport-mode))
|
|
|
|
|
("e" org-agenda-entry-text-mode
|
|
|
|
|
(format "% -3S" org-agenda-entry-text-mode))
|
|
|
|
|
("g" org-agenda-toggle-time-grid
|
|
|
|
|
(format "% -3S" org-agenda-use-time-grid))
|
|
|
|
|
("D" org-agenda-toggle-diary
|
|
|
|
|
(format "% -3S" org-agenda-include-diary))
|
|
|
|
|
("!" org-agenda-toggle-deadlines)
|
|
|
|
|
("["
|
|
|
|
|
(let ((org-agenda-include-inactive-timestamps t))
|
|
|
|
|
(org-agenda-check-type t 'timeline 'agenda)
|
|
|
|
|
(org-agenda-redo)))
|
|
|
|
|
("q" (message "Abort") :exit t))
|
|
|
|
|
|
2021-01-29 17:11:55 +01:00
|
|
|
|
;; Show sum of daily efforts in agenda, the following two functions are from
|
|
|
|
|
;; anpandey,
|
|
|
|
|
;; cf. https://emacs.stackexchange.com/questions/21380/show-sum-of-efforts-for-a-day-in-org-agenda-day-title#21902
|
|
|
|
|
|
|
|
|
|
(defun db/org-agenda-calculate-efforts (limit)
|
2021-01-29 17:38:24 +01:00
|
|
|
|
"Sum efforts of day entries up to LIMIT in the agenda buffer.
|
|
|
|
|
Entries included are those scheduled for that day, scheduled at
|
2022-09-23 15:47:45 +02:00
|
|
|
|
some past day (and still on display), active
|
|
|
|
|
timestamps (appointments), and deadlines (assuming they are only
|
|
|
|
|
shown because they are due)."
|
2021-01-29 17:11:55 +01:00
|
|
|
|
(let (total)
|
|
|
|
|
(save-excursion
|
2021-01-29 17:38:24 +01:00
|
|
|
|
(while (< (point) limit)
|
|
|
|
|
(when (member (org-get-at-bol 'type)
|
2023-01-11 20:22:29 +01:00
|
|
|
|
'("scheduled" "past-scheduled" "timestamp" "deadline" "block"))
|
2021-01-29 17:38:24 +01:00
|
|
|
|
(push (org-entry-get (org-get-at-bol 'org-hd-marker) "Effort") total))
|
|
|
|
|
(forward-line)))
|
2021-01-29 17:11:55 +01:00
|
|
|
|
(org-duration-from-minutes
|
|
|
|
|
(cl-reduce #'+
|
|
|
|
|
(mapcar #'org-duration-to-minutes
|
|
|
|
|
(cl-remove-if-not 'identity total))))))
|
|
|
|
|
|
|
|
|
|
(defun db/org-agenda-insert-efforts ()
|
|
|
|
|
"Insert efforts for each day into the agenda buffer.
|
|
|
|
|
|
2021-01-29 17:38:24 +01:00
|
|
|
|
Add this function to `org-agenda-finalize-hook' to enable this."
|
2021-01-29 17:11:55 +01:00
|
|
|
|
(save-excursion
|
|
|
|
|
(let (pos)
|
|
|
|
|
(while (setq pos (text-property-any
|
|
|
|
|
(point) (point-max) 'org-agenda-date-header t))
|
|
|
|
|
(goto-char pos)
|
|
|
|
|
(end-of-line)
|
2023-01-11 20:44:19 +01:00
|
|
|
|
|
|
|
|
|
;; When there is already an effort sum shown, delete it first
|
|
|
|
|
(when (re-search-backward " ([0-9]+:[0-9]\\{2\\})"
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
;; Only search until start of line
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(point))
|
|
|
|
|
t)
|
|
|
|
|
(kill-line))
|
|
|
|
|
|
|
|
|
|
;; Insert effort sum
|
2021-01-29 17:11:55 +01:00
|
|
|
|
(insert-and-inherit
|
|
|
|
|
(concat " ("
|
|
|
|
|
(db/org-agenda-calculate-efforts
|
2021-01-29 17:36:21 +01:00
|
|
|
|
(or (next-single-property-change (point) 'day)
|
|
|
|
|
;; If nothing is shown on the current day, the previous
|
|
|
|
|
;; call may return nil; in that case, don't sum anything
|
|
|
|
|
;; by setting the limit to 0
|
|
|
|
|
0))
|
2021-01-29 17:11:55 +01:00
|
|
|
|
")"))
|
|
|
|
|
(forward-line)))))
|
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;;; Capturing
|
|
|
|
|
|
2017-07-18 18:14:53 +02:00
|
|
|
|
(defun db/org-timestamp-difference (stamp-1 stamp-2)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Return time difference between two Org mode timestamps.
|
|
|
|
|
STAMP-1 and STAMP-2 must be understood by
|
|
|
|
|
`org-parse-time-string'."
|
2017-07-18 18:14:53 +02:00
|
|
|
|
;; Things copied from `org-clock-update-time-maybe’
|
|
|
|
|
(let* ((s (-
|
|
|
|
|
(float-time
|
2018-01-16 17:55:15 +01:00
|
|
|
|
(apply #'encode-time (org-parse-time-string stamp-2 t)))
|
2017-07-18 18:14:53 +02:00
|
|
|
|
(float-time
|
2018-01-16 17:55:15 +01:00
|
|
|
|
(apply #'encode-time (org-parse-time-string stamp-1 t)))))
|
2017-07-18 18:14:53 +02:00
|
|
|
|
(neg (< s 0))
|
|
|
|
|
(s (abs s))
|
|
|
|
|
(h (floor (/ s 3600)))
|
|
|
|
|
(m (floor (/ (- s (* 3600 h)) 60))))
|
|
|
|
|
(format (if neg "-%d:%02d" "%2d:%02d") h m)))
|
|
|
|
|
|
2018-08-18 16:18:14 +02:00
|
|
|
|
;; Capture Code Snippets
|
|
|
|
|
;; from http://ul.io/nb/2018/04/30/better-code-snippets-with-org-capture/
|
|
|
|
|
(defun db/org-capture-code-snippet (filename)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Format Org mode source block with contant of active region in FILENAME."
|
2018-08-18 16:18:14 +02:00
|
|
|
|
(with-current-buffer (find-buffer-visiting filename)
|
|
|
|
|
(let ((code-snippet (buffer-substring-no-properties (mark) (- (point) 1)))
|
|
|
|
|
(func-name (which-function))
|
|
|
|
|
(file-name (buffer-file-name))
|
|
|
|
|
(line-number (line-number-at-pos (region-beginning)))
|
|
|
|
|
(org-src-mode (let ((mm (intern (replace-regexp-in-string
|
|
|
|
|
"-mode" "" (format "%s" major-mode)))))
|
|
|
|
|
(or (car (rassoc mm org-src-lang-modes))
|
|
|
|
|
(format "%s" mm)))))
|
|
|
|
|
(format
|
|
|
|
|
"file:%s::%s
|
|
|
|
|
In ~%s~:
|
|
|
|
|
#+BEGIN_SRC %s
|
|
|
|
|
%s
|
|
|
|
|
#+END_SRC"
|
|
|
|
|
file-name
|
|
|
|
|
line-number
|
|
|
|
|
func-name
|
|
|
|
|
org-src-mode
|
|
|
|
|
code-snippet))))
|
|
|
|
|
|
2018-11-18 16:39:43 +01:00
|
|
|
|
;; Make capture frame, made for being called via emacsclient
|
|
|
|
|
;; https://cestlaz.github.io/posts/using-emacs-24-capture-2/
|
|
|
|
|
|
|
|
|
|
(defun db/make-org-capture-frame ()
|
|
|
|
|
"Create a new frame for capturing."
|
|
|
|
|
(interactive)
|
|
|
|
|
(make-frame '((name . "capture")))
|
|
|
|
|
(select-frame-by-name "capture")
|
|
|
|
|
(delete-other-windows)
|
2018-11-18 16:57:16 +01:00
|
|
|
|
(org-capture))
|
2018-11-18 16:39:43 +01:00
|
|
|
|
|
2021-03-26 16:38:17 +01:00
|
|
|
|
(defun db/delete-frame-if-capture (&rest _r)
|
2018-11-18 16:39:43 +01:00
|
|
|
|
"If current frame was made for a capture, close after done."
|
|
|
|
|
(when (equal (frame-parameter nil 'name)
|
|
|
|
|
"capture")
|
|
|
|
|
(delete-frame)))
|
|
|
|
|
|
|
|
|
|
(advice-add 'org-capture-finalize
|
|
|
|
|
:after #'db/delete-frame-if-capture)
|
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;;; Refiling
|
|
|
|
|
|
2018-02-14 22:06:42 +01:00
|
|
|
|
(defun db/verify-refile-target ()
|
2022-06-11 21:17:57 +02:00
|
|
|
|
"Verify that a certain location is eligible as a refile target."
|
2020-07-04 11:43:19 +02:00
|
|
|
|
(and
|
|
|
|
|
;; Exclude DONE state tasks from refile targets (from bh)
|
|
|
|
|
(not (member (nth 2 (org-heading-components))
|
2022-06-29 16:51:19 +02:00
|
|
|
|
org-done-keywords))))
|
2018-02-14 22:06:42 +01:00
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
2017-08-12 11:25:04 +02:00
|
|
|
|
;;; Reset checklists
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
2017-08-12 11:25:04 +02:00
|
|
|
|
;; from `org-checklist’ by James TD Smith (@ ahktenzero (. mohorovi cc)),
|
|
|
|
|
;; version: 1.0
|
|
|
|
|
(defun org-reset-checkbox-state-maybe ()
|
2021-03-20 15:57:45 +01:00
|
|
|
|
"Reset all checkboxes in an entry if `RESET_CHECK_BOXES' property is set."
|
2017-08-12 11:25:04 +02:00
|
|
|
|
(interactive "*")
|
2021-03-20 16:33:00 +01:00
|
|
|
|
(when (org-entry-get (point) "RESET_CHECK_BOXES")
|
|
|
|
|
(warn "Using the RESET_CHECK_BOXES property is deprecated, user periodic tasks instead")
|
|
|
|
|
(org-reset-checkbox-state-subtree)))
|
2017-08-12 11:25:04 +02:00
|
|
|
|
|
2018-11-03 10:28:49 +01:00
|
|
|
|
|
2019-08-31 11:26:04 +02:00
|
|
|
|
;;; Helper Functions for Clocking
|
2018-11-03 10:28:49 +01:00
|
|
|
|
|
|
|
|
|
(defun db/find-parent-task ()
|
|
|
|
|
;; http://doc.norang.ca/org-mode.html#Clocking
|
2022-05-14 11:33:31 +02:00
|
|
|
|
"Return point of the nearest parent task, and NIL if no such task exists.
|
|
|
|
|
|
|
|
|
|
Ignores headlines tagged with NOP or PERIODIC, as those items
|
|
|
|
|
should not be clocked."
|
2018-11-03 10:28:49 +01:00
|
|
|
|
(save-mark-and-excursion
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
|
|
|
|
(let ((parent-task nil))
|
|
|
|
|
(or (org-at-heading-p)
|
|
|
|
|
(org-back-to-heading t))
|
|
|
|
|
(while (and (not parent-task)
|
|
|
|
|
(org-up-heading-safe))
|
|
|
|
|
(let ((tags (org-get-tags nil 'local)))
|
|
|
|
|
(unless (or (member "NOP" tags)
|
|
|
|
|
(member "PERIODIC" tags))
|
|
|
|
|
(setq parent-task (point)))))
|
|
|
|
|
parent-task))))
|
2018-11-03 10:28:49 +01:00
|
|
|
|
|
|
|
|
|
(defun db/ensure-running-clock ()
|
|
|
|
|
"Clocks in into the parent task, if it exists, or the default task."
|
|
|
|
|
(when (and (not org-clock-clocking-in)
|
|
|
|
|
(not org-clock-resolving-clocks-due-to-idleness))
|
|
|
|
|
(let ((parent-task (db/find-parent-task)))
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(cond
|
|
|
|
|
(parent-task
|
|
|
|
|
;; found parent task
|
|
|
|
|
(org-with-point-at parent-task
|
|
|
|
|
(org-clock-in)))
|
|
|
|
|
((and (markerp org-clock-default-task)
|
|
|
|
|
(marker-buffer org-clock-default-task))
|
|
|
|
|
;; default task is set
|
|
|
|
|
(org-with-point-at org-clock-default-task
|
|
|
|
|
(org-clock-in)))
|
|
|
|
|
(t
|
|
|
|
|
(org-clock-in '(4))))))))
|
|
|
|
|
|
2018-11-03 10:30:47 +01:00
|
|
|
|
(defun db/save-current-org-task-to-file ()
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Format currently clocked task and write it to`db/org-clock-current-task-file'."
|
2018-11-03 10:28:49 +01:00
|
|
|
|
(with-temp-file db/org-clock-current-task-file
|
|
|
|
|
(let ((clock-buffer (marker-buffer org-clock-marker)))
|
|
|
|
|
(if (null clock-buffer)
|
|
|
|
|
(insert "No running clock")
|
|
|
|
|
(insert org-clock-heading)))))
|
|
|
|
|
|
2019-08-31 11:26:04 +02:00
|
|
|
|
(defun db/org-update-frame-title-with-current-clock ()
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Set title of all active frames to the headline of the current task."
|
2019-08-31 11:26:04 +02:00
|
|
|
|
(interactive)
|
|
|
|
|
(let ((clock-buffer (marker-buffer org-clock-marker)))
|
|
|
|
|
(when clock-buffer
|
2021-10-16 12:21:02 +02:00
|
|
|
|
(setq frame-title-format org-clock-heading)
|
2019-12-05 17:09:49 +01:00
|
|
|
|
(dolist (frame (frame-list))
|
2021-10-16 12:21:02 +02:00
|
|
|
|
(modify-frame-parameters frame `((name . ,org-clock-heading)))))))
|
2019-08-31 11:26:04 +02:00
|
|
|
|
|
2020-06-27 08:56:53 +02:00
|
|
|
|
(defun db/show-current-org-task ()
|
|
|
|
|
"Show title of currently clock in task in modeline."
|
|
|
|
|
(interactive)
|
|
|
|
|
(message org-clock-current-task))
|
|
|
|
|
|
2022-09-06 18:34:12 +02:00
|
|
|
|
|
|
|
|
|
;;; Task Management
|
|
|
|
|
|
2022-09-08 18:37:42 +02:00
|
|
|
|
(defun db/org-planned-tasks-in-range (start-date end-date &optional org-ql-match)
|
2022-09-06 18:34:12 +02:00
|
|
|
|
"Return list of tasks planned between START-DATE and END-DATE.
|
|
|
|
|
|
|
|
|
|
This function will search through the files returned by
|
|
|
|
|
`org-agenda-files' (the function) for all tasks that are
|
|
|
|
|
scheduled, have an active timestamp, or are deadline in the given
|
|
|
|
|
time range.
|
|
|
|
|
|
|
|
|
|
The result has the form (TOTAL-TIME . TASKS), where TASKS is a
|
|
|
|
|
list of cons cells (ID . EFFORT). The total time is given as an
|
|
|
|
|
Org mode time string of the form hh:mm, as are all EFFORT
|
2022-09-08 18:37:42 +02:00
|
|
|
|
entries.
|
|
|
|
|
|
|
|
|
|
When ORG-QL-MATCH, an org-ql sexp, is given, filter the list of
|
|
|
|
|
tasks in range by this expression. When ORG-QL-MATCH is not
|
2022-09-10 09:12:02 +02:00
|
|
|
|
given, default to `(todo)'.
|
|
|
|
|
|
|
|
|
|
START-DATE and END-DATE must be strings formatted such that
|
|
|
|
|
`org-read-date' can parse a date from them. In particular,
|
|
|
|
|
everything understood by `parse-time-string' should be fine.
|
|
|
|
|
When START-DATE or END-DATE (or both) are nil, no constraints are
|
|
|
|
|
imposed on the respective time range."
|
|
|
|
|
|
|
|
|
|
(unless (or (null start-date)
|
|
|
|
|
(stringp start-date))
|
|
|
|
|
(user-error "START-DATE must be nil or a string, but it's %s" start-date))
|
|
|
|
|
|
|
|
|
|
(unless (or (null end-date)
|
|
|
|
|
(stringp end-date))
|
|
|
|
|
(user-error "END-DATE must be nil or a string, but it's %s" end-date))
|
|
|
|
|
|
|
|
|
|
(let* ((start-date-expr (--when-let (and start-date (org-read-date nil nil start-date))
|
|
|
|
|
(list :from it)))
|
|
|
|
|
(end-date-expr (--when-let (and end-date (org-read-date nil nil end-date))
|
|
|
|
|
(list :to it)))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
(tasks (org-ql-query
|
|
|
|
|
:from (org-agenda-files)
|
|
|
|
|
:select '(cons
|
|
|
|
|
(org-id-get-create)
|
|
|
|
|
(org-entry-get (point) "Effort"))
|
2022-09-08 18:37:42 +02:00
|
|
|
|
:where `(and ,(or org-ql-match '(todo))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
;; Is this redundant? Could we just stick with `ts-active'?
|
2022-09-10 09:12:02 +02:00
|
|
|
|
(or (scheduled ,@start-date-expr ,@end-date-expr)
|
|
|
|
|
(deadline ,@start-date-expr ,@end-date-expr)
|
|
|
|
|
(ts-active ,@start-date-expr ,@end-date-expr)))))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
(total-time (->> tasks
|
2022-09-07 17:41:09 +02:00
|
|
|
|
(-map #'(lambda (task)
|
|
|
|
|
(let ((effort (cdr task)))
|
|
|
|
|
(if (null effort)
|
|
|
|
|
0
|
|
|
|
|
(org-duration-to-minutes effort)))))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
-sum
|
|
|
|
|
org-duration-from-minutes)))
|
|
|
|
|
(cons total-time tasks)))
|
|
|
|
|
|
|
|
|
|
(defun org-dblock-write:db/org-workload-report (params)
|
|
|
|
|
"Write workload report based on tasks in `org-agenda-files'.
|
|
|
|
|
|
|
|
|
|
PARAMS is a property list of the following parameters:
|
|
|
|
|
|
|
|
|
|
`:start-date':
|
|
|
|
|
|
2022-09-10 09:17:41 +02:00
|
|
|
|
Start date for the workload report. Leave out if no constraint
|
|
|
|
|
on the start date is necessary.
|
2022-09-06 18:34:12 +02:00
|
|
|
|
|
|
|
|
|
`:end-date':
|
|
|
|
|
|
2022-09-10 09:17:41 +02:00
|
|
|
|
End date of the workload report. Leave out if no constraint on
|
|
|
|
|
the start date is necessary.
|
2022-09-06 18:34:12 +02:00
|
|
|
|
|
2022-09-08 18:37:42 +02:00
|
|
|
|
`:org-ql-match'
|
|
|
|
|
|
|
|
|
|
`org-ql' expression (in sexp syntax) to filter the list of tasks.
|
|
|
|
|
|
2022-09-10 09:39:30 +02:00
|
|
|
|
`:sort-column'
|
|
|
|
|
|
|
|
|
|
Specify the column to sort by. Can be any of `task', `effort',
|
|
|
|
|
`timestamp', `scheduled', or `deadline'.
|
|
|
|
|
|
2022-09-06 18:34:12 +02:00
|
|
|
|
All tasks between `:start-date' and `:end-date' will be collected
|
|
|
|
|
and their effort summed up. The date format is everything
|
|
|
|
|
understood by `org-read-date'."
|
|
|
|
|
(let* ((start-date (plist-get params :start-date))
|
|
|
|
|
(end-date (plist-get params :end-date))
|
2022-09-08 18:37:42 +02:00
|
|
|
|
(org-ql-match (plist-get params :org-ql-match))
|
2022-09-10 09:39:30 +02:00
|
|
|
|
(sort-column-count (cl-case (plist-get params :sort-column)
|
|
|
|
|
((nil) 2) ; sort by effort by default
|
|
|
|
|
((task) 1)
|
|
|
|
|
((effort) 2)
|
|
|
|
|
((timestamp) 3)
|
|
|
|
|
((scheduled) 4)
|
|
|
|
|
((deadline) 5)
|
|
|
|
|
(otherwise (user-error ":sort-column value invalid, see docstring of `org-dblock-write:db/org-workload-report' for options"))))
|
2022-09-08 18:37:42 +02:00
|
|
|
|
(task-summary (db/org-planned-tasks-in-range start-date end-date org-ql-match)))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
|
2022-09-10 09:55:55 +02:00
|
|
|
|
;; Create table
|
|
|
|
|
(cl-flet ((ts-property-from-id (task-id property)
|
|
|
|
|
;; Retrieve PROPERTY from task given by TASK-ID. If found,
|
|
|
|
|
;; assume PROPERTY to be a timestamp and unconditionally convert
|
|
|
|
|
;; it into an inactive timestamp. If PROPERTY is not found,
|
|
|
|
|
;; return the empty string.
|
|
|
|
|
(--if-let (org-entry-get (org-id-find task-id 'marker)
|
|
|
|
|
property)
|
2022-09-30 14:54:30 +02:00
|
|
|
|
(->> it
|
|
|
|
|
(string-replace "<" "[")
|
|
|
|
|
(string-replace ">" "]"))
|
2022-09-10 09:55:55 +02:00
|
|
|
|
"")))
|
|
|
|
|
|
|
|
|
|
(insert "| Task | Effort | Timestamp | SCHEDULED | DEADLINE |\n|---|\n")
|
|
|
|
|
(pcase-dolist (`(,task-id . ,effort-string) (cdr task-summary))
|
|
|
|
|
(insert (format "| %s | %s | %s | %s | %s |\n"
|
|
|
|
|
(db/org--format-link-from-org-id task-id)
|
|
|
|
|
(or effort-string "")
|
2022-09-15 10:22:27 +02:00
|
|
|
|
(ts-property-from-id task-id "TIMESTAMP")
|
2022-09-10 09:55:55 +02:00
|
|
|
|
(ts-property-from-id task-id "SCHEDULED")
|
|
|
|
|
(ts-property-from-id task-id "DEADLINE"))))
|
|
|
|
|
(insert (format "|---|\n| Total | %s |\n|---|" (car task-summary)))
|
|
|
|
|
(org-table-align))
|
|
|
|
|
|
|
|
|
|
;; Sort table
|
2022-09-10 09:39:30 +02:00
|
|
|
|
(forward-line -4) ; go back to actual data
|
|
|
|
|
(beginning-of-line)
|
|
|
|
|
(dotimes (_ sort-column-count) ; move to column to sort
|
|
|
|
|
(org-table-next-field))
|
|
|
|
|
(org-table-sort-lines nil ?t)))
|
2022-09-06 18:34:12 +02:00
|
|
|
|
|
|
|
|
|
(defun db/org-insert-workload-report ()
|
|
|
|
|
"Create dynamic block of planned tasks in given time range."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-create-dblock
|
|
|
|
|
(list :name "db/org-workload-report"
|
|
|
|
|
:start-date (read-string "Start date: ")
|
|
|
|
|
:end-date (read-string "End date: ")))
|
|
|
|
|
(org-update-dblock))
|
|
|
|
|
|
|
|
|
|
(org-dynamic-block-define "db/org-workload-report" #'db/org-insert-workload-report)
|
|
|
|
|
|
2022-09-17 10:17:25 +02:00
|
|
|
|
(defun org-dblock-write:db/org-workload-overview-report (params)
|
|
|
|
|
"Write an overview workload report based on tasks in `org-agenda-files'.
|
|
|
|
|
|
|
|
|
|
This overview report will list the amount of work planned for
|
|
|
|
|
increasing intervals of time until a given end date is reached.
|
|
|
|
|
For example, if the amount to increase the intervals is two
|
|
|
|
|
days (+2d) and the report is meant to start from today (.), then
|
|
|
|
|
this report will list the total amount of work planned for the
|
|
|
|
|
days .+2d, .+4d, .+6d, … until the end date is reached.
|
|
|
|
|
|
|
|
|
|
PARAMS is a property list of the following parameters:
|
|
|
|
|
|
|
|
|
|
`:start-date':
|
|
|
|
|
|
|
|
|
|
Start date for the workload report. When not provided, will
|
2022-10-07 15:42:02 +02:00
|
|
|
|
default to no start date. When provided, must be in a format
|
2022-09-17 10:17:25 +02:00
|
|
|
|
understood by `org-read-date'.
|
|
|
|
|
|
|
|
|
|
`:end-date':
|
|
|
|
|
|
|
|
|
|
End date of the workload report. Must be provided and provided
|
|
|
|
|
in a format understood by `org-read-date'. The end date is
|
|
|
|
|
inclusive.
|
|
|
|
|
|
|
|
|
|
`:increment':
|
|
|
|
|
|
|
|
|
|
Amount of days to increase the intervals. Defaults to \"+1d\"
|
|
|
|
|
and must be provided in a format understandable by
|
|
|
|
|
`org-read-date'.
|
|
|
|
|
|
|
|
|
|
`:org-ql-match'
|
|
|
|
|
|
|
|
|
|
`org-ql' expression (in sexp syntax) to filter the list of
|
|
|
|
|
tasks to consider. Defaults to (todo)."
|
2022-10-07 15:45:53 +02:00
|
|
|
|
(let* ((start-date (or (--if-let (plist-get params :start-date)
|
|
|
|
|
(org-read-date nil nil it))
|
2022-10-07 15:42:02 +02:00
|
|
|
|
nil))
|
2022-10-07 15:45:53 +02:00
|
|
|
|
(end-date (or (--if-let (plist-get params :end-date)
|
|
|
|
|
(org-read-date nil nil it))
|
|
|
|
|
(user-error "No valid end-date provided")))
|
2022-09-17 10:17:25 +02:00
|
|
|
|
(increment (or (plist-get params :increment)
|
|
|
|
|
"+1d"))
|
|
|
|
|
(org-ql-match (or (plist-get params :org-ql-match)
|
|
|
|
|
'(todo)))
|
2022-10-07 15:42:02 +02:00
|
|
|
|
(current (or start-date
|
|
|
|
|
(org-read-date nil nil ".")))
|
2022-09-17 10:17:25 +02:00
|
|
|
|
(date-range nil))
|
|
|
|
|
|
|
|
|
|
;; Check input
|
2022-10-07 15:42:02 +02:00
|
|
|
|
(unless (or (null start-date)
|
|
|
|
|
(string-match-p (org-re-timestamp 'inactive)
|
|
|
|
|
(format "[%s]" start-date)))
|
2022-09-17 10:17:25 +02:00
|
|
|
|
(user-error "Invalid start date given: %s" start-date))
|
|
|
|
|
|
|
|
|
|
(unless (string-match-p (org-re-timestamp 'inactive)
|
|
|
|
|
(format "[%s]" end-date))
|
|
|
|
|
(user-error "Invalid end date given: %s" end-date))
|
|
|
|
|
|
|
|
|
|
(unless (string-match-p (rx bos "+" (+ digit) (in "dwmy") eos)
|
|
|
|
|
increment)
|
|
|
|
|
(user-error "Increment must be of the form +1d, +2m, +3y, …, but it's %s" increment))
|
|
|
|
|
|
|
|
|
|
;; Compute range of dates to check; simple but potentially costly approach
|
|
|
|
|
;; taken from https://sachachua.com/blog/2015/08/org-mode-date-arithmetic/;
|
|
|
|
|
;; maybe consider `org-read-date-get-relative' as well?
|
|
|
|
|
(while (or (string< current end-date)
|
|
|
|
|
(string= current end-date))
|
|
|
|
|
(push current date-range)
|
|
|
|
|
(setq current (org-read-date nil
|
|
|
|
|
nil
|
|
|
|
|
;; Add an extra + to ensure we increase the
|
|
|
|
|
;; default time string.
|
|
|
|
|
;; amount of time relative to the given
|
|
|
|
|
(format "+%s" increment)
|
|
|
|
|
nil
|
|
|
|
|
(org-time-string-to-time current))))
|
|
|
|
|
(setq date-range (nreverse date-range))
|
|
|
|
|
|
|
|
|
|
;; Compute workload report for each date and record the total time; XXX:
|
|
|
|
|
;; this might be slow, try to reduce the calls to
|
|
|
|
|
;; `db/org-planned-tasks-in-range'.
|
|
|
|
|
(insert "| Until | Planned Total |\n| <r> | <r> |\n|---|\n")
|
2022-10-07 15:42:02 +02:00
|
|
|
|
(dolist (interval-end-date date-range)
|
2022-09-17 10:17:25 +02:00
|
|
|
|
(let ((total-time (car (db/org-planned-tasks-in-range start-date
|
|
|
|
|
interval-end-date
|
|
|
|
|
org-ql-match))))
|
|
|
|
|
(insert "| ")
|
|
|
|
|
(org-insert-time-stamp (org-time-string-to-time interval-end-date) nil 'inactive)
|
|
|
|
|
(insert (format " | %s |\n" total-time))))
|
|
|
|
|
(insert "|--|")
|
|
|
|
|
(org-table-align)))
|
|
|
|
|
|
|
|
|
|
(defun db/org-insert-workload-overview-report ()
|
|
|
|
|
"Create dynamic block of planned tasks in given time range."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-create-dblock
|
|
|
|
|
(list :name "db/org-workload-overview-report"
|
|
|
|
|
:end-date (org-read-date nil nil nil "End date: ")
|
|
|
|
|
:increment (read-string "Increment (default: +1d): " nil nil "+1d")))
|
|
|
|
|
(org-update-dblock))
|
|
|
|
|
|
|
|
|
|
(org-dynamic-block-define "db/org-workload-overview-report"
|
|
|
|
|
#'db/org-insert-workload-overview-report)
|
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
|
|
|
|
|
;;; Fixes
|
|
|
|
|
|
|
|
|
|
(defun endless/org-ispell ()
|
|
|
|
|
"Configure `ispell-skip-region-alist' for `org-mode'."
|
|
|
|
|
(make-local-variable 'ispell-skip-region-alist)
|
|
|
|
|
(add-to-list 'ispell-skip-region-alist '(org-property-drawer-re))
|
|
|
|
|
(add-to-list 'ispell-skip-region-alist '("~" "~"))
|
|
|
|
|
(add-to-list 'ispell-skip-region-alist '("=" "="))
|
|
|
|
|
(add-to-list 'ispell-skip-region-alist '("^#\\+BEGIN_SRC" . "^#\\+END_SRC")))
|
|
|
|
|
|
2018-11-03 09:05:01 +01:00
|
|
|
|
|
|
|
|
|
;;; Hydra
|
|
|
|
|
|
2018-11-03 09:38:35 +01:00
|
|
|
|
(defun db/clock-in-task-by-id (task-id)
|
|
|
|
|
"Clock in org mode task as given by TASK-ID."
|
2018-11-18 16:00:13 +01:00
|
|
|
|
(let ((location (org-id-find task-id 'marker)))
|
|
|
|
|
(if (null location)
|
2021-10-16 12:27:20 +02:00
|
|
|
|
(user-error "Invalid location given: «%s»" task-id)
|
2018-11-18 16:00:13 +01:00
|
|
|
|
(org-with-point-at location
|
|
|
|
|
(org-clock-in))
|
|
|
|
|
(org-save-all-org-buffers))))
|
2018-11-03 09:38:35 +01:00
|
|
|
|
|
|
|
|
|
(defun db/clock-out-task-by-id (task-id)
|
|
|
|
|
"Clock out org mode task as given by TASK-ID."
|
|
|
|
|
(org-with-point-at (org-id-find task-id 'marker)
|
|
|
|
|
(org-clock-out))
|
|
|
|
|
(org-save-all-org-buffers))
|
|
|
|
|
|
2018-11-18 16:00:04 +01:00
|
|
|
|
(defun db/org-clock-out ()
|
|
|
|
|
"Clock out current clock."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-clock-out))
|
|
|
|
|
|
|
|
|
|
(defun db/org-clock-in-break-task ()
|
|
|
|
|
"Clock into default break task as given by `org-break-task-id’."
|
|
|
|
|
(interactive)
|
|
|
|
|
(db/clock-in-task-by-id org-break-task-id))
|
|
|
|
|
|
|
|
|
|
(defun db/org-clock-in-home-task ()
|
|
|
|
|
"Clock into default home task as given by `org-home-task-id’."
|
|
|
|
|
(interactive)
|
|
|
|
|
(db/clock-in-task-by-id org-home-task-id))
|
|
|
|
|
|
|
|
|
|
(defun db/org-clock-in-work-task ()
|
|
|
|
|
"Clock into default work task as given by `org-work-task-id’."
|
|
|
|
|
(interactive)
|
|
|
|
|
(db/clock-in-task-by-id org-working-task-id))
|
|
|
|
|
|
2018-11-03 09:38:35 +01:00
|
|
|
|
(defun db/org-clock-in-last-task (&optional arg)
|
|
|
|
|
;; from doc.norang.ca, originally bh/clock-in-last-task
|
|
|
|
|
"Clock in the interrupted task if there is one.
|
|
|
|
|
|
|
|
|
|
Skip the default task and get the next one. If ARG is given,
|
|
|
|
|
forces clocking in of the default task."
|
|
|
|
|
(interactive "p")
|
|
|
|
|
(let ((clock-in-to-task
|
|
|
|
|
(cond
|
|
|
|
|
((eq arg 4) org-clock-default-task)
|
|
|
|
|
((and (org-clock-is-active)
|
|
|
|
|
(equal org-clock-default-task (cadr org-clock-history)))
|
|
|
|
|
(caddr org-clock-history))
|
|
|
|
|
((org-clock-is-active) (cadr org-clock-history))
|
|
|
|
|
((equal org-clock-default-task (car org-clock-history))
|
|
|
|
|
(cadr org-clock-history))
|
|
|
|
|
(t (car org-clock-history)))))
|
|
|
|
|
(widen)
|
|
|
|
|
(org-with-point-at clock-in-to-task
|
|
|
|
|
(org-clock-in nil))))
|
|
|
|
|
|
2018-11-03 09:05:01 +01:00
|
|
|
|
(defhydra hydra-org-clock (:color blue)
|
2020-07-01 17:15:13 +02:00
|
|
|
|
;; Quote %, as otherwise they would be misinterpreted as format characters
|
2022-02-26 10:16:13 +01:00
|
|
|
|
"\nCurrent Task: %s(replace-regexp-in-string \"%\" \"%%\" (or org-clock-current-task \"\")); "
|
2019-12-20 15:16:53 +01:00
|
|
|
|
("w" (db/org-clock-in-work-task) "work")
|
|
|
|
|
("h" (db/org-clock-in-home-task) "home")
|
|
|
|
|
("b" (db/org-clock-in-break-task) "break")
|
2018-11-03 09:05:01 +01:00
|
|
|
|
("i" (lambda ()
|
|
|
|
|
(interactive)
|
2019-12-20 15:16:53 +01:00
|
|
|
|
(org-clock-in '(4))) "interactive")
|
|
|
|
|
("a" counsel-org-goto-all "goto")
|
|
|
|
|
("o" org-clock-out "clock out")
|
|
|
|
|
("l" db/org-clock-in-last-task "last")
|
2018-11-03 09:05:01 +01:00
|
|
|
|
("d" (lambda ()
|
|
|
|
|
(interactive)
|
|
|
|
|
(when (org-clock-is-active)
|
|
|
|
|
(save-window-excursion
|
|
|
|
|
(org-clock-goto)
|
|
|
|
|
(let ((org-inhibit-logging 'note))
|
|
|
|
|
(org-todo 'done)
|
2019-12-20 15:16:53 +01:00
|
|
|
|
(org-save-all-org-buffers)))))
|
|
|
|
|
"default"))
|
2018-11-03 09:05:01 +01:00
|
|
|
|
|
2018-08-04 12:32:54 +02:00
|
|
|
|
|
|
|
|
|
;;; Babel
|
|
|
|
|
|
|
|
|
|
(defun org-babel-execute:hy (body params)
|
|
|
|
|
;; http://kitchingroup.cheme.cmu.edu/blog/2016/03/30/OMG-A-Lisp-that-runs-python/
|
|
|
|
|
"Execute hy code BODY with parameters PARAMS."
|
|
|
|
|
(ignore params)
|
|
|
|
|
(let* ((temporary-file-directory ".")
|
|
|
|
|
(tempfile (make-temp-file "hy-")))
|
|
|
|
|
(with-temp-file tempfile
|
|
|
|
|
(insert body))
|
|
|
|
|
(unwind-protect
|
|
|
|
|
(shell-command-to-string
|
|
|
|
|
(format "hy %s" tempfile))
|
|
|
|
|
(delete-file tempfile))))
|
|
|
|
|
|
2022-07-21 21:54:35 +02:00
|
|
|
|
(defun db/org-eval-subtree-no-confirm (&optional arg)
|
|
|
|
|
"Evaluate subtree at point without asking for confirmation.
|
|
|
|
|
|
|
|
|
|
Use with care!
|
|
|
|
|
|
|
|
|
|
With given ARG, force reevaluation as described for
|
|
|
|
|
`org-babel-execute-src-block'."
|
|
|
|
|
(interactive)
|
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org buffer, aborting"))
|
|
|
|
|
(let ((org-confirm-babel-evaluate nil))
|
|
|
|
|
(org-babel-execute-subtree arg)))
|
|
|
|
|
|
2020-01-19 17:17:47 +01:00
|
|
|
|
|
|
|
|
|
;;; Custom link handlers
|
|
|
|
|
|
2020-01-19 17:21:14 +01:00
|
|
|
|
(defun db/org-onenote-open (path)
|
|
|
|
|
"Visit OneNote document on PATH."
|
|
|
|
|
(unless (file-executable-p db/path-to-onenote)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
(user-error "Path for OneNote is not executable, please customize `db/path-to-onenote’"))
|
2020-01-19 17:21:14 +01:00
|
|
|
|
(start-process "OneNote" nil db/path-to-onenote "/hyperlink" path))
|
|
|
|
|
|
|
|
|
|
(defun db/org-outlook-open (id)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Open Outlook item identified by ID.
|
|
|
|
|
ID should be an Outlook GUID."
|
2020-01-19 17:21:14 +01:00
|
|
|
|
(unless (file-executable-p db/path-to-outlook)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
(user-error "Path for Outlook is not executable, please customize `db/path-to-outlook’"))
|
2020-01-19 17:21:14 +01:00
|
|
|
|
(w32-shell-execute "open" db/path-to-outlook (concat "/select outlook:" id)))
|
|
|
|
|
|
2020-01-19 17:17:47 +01:00
|
|
|
|
(defun db/org-rfc-open (number)
|
|
|
|
|
"Open browser to show RFC of given NUMBER.
|
|
|
|
|
If `db/rfc-cache-path' is defined, download the RFC in txt format
|
|
|
|
|
there and open it. If the RFC has already been downloaded
|
|
|
|
|
before, just open it. If `db/rfc-cache-path' is not defined,
|
|
|
|
|
open RFC in HTML format in the default browser."
|
|
|
|
|
(cond
|
|
|
|
|
((not (string-match "[1-9][0-9]*" number))
|
|
|
|
|
(user-error "Not a valid number for an RFC: %s" number))
|
|
|
|
|
((and db/rfc-cache-path
|
|
|
|
|
(file-name-absolute-p db/rfc-cache-path)
|
|
|
|
|
(file-writable-p db/rfc-cache-path))
|
|
|
|
|
(let ((rfc-path (expand-file-name (format "rfc%s.txt" number)
|
|
|
|
|
db/rfc-cache-path)))
|
|
|
|
|
(cond
|
|
|
|
|
((file-exists-p rfc-path)
|
|
|
|
|
(find-file rfc-path))
|
|
|
|
|
(t
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(url-insert-file-contents (format "https://tools.ietf.org/rfc/rfc%s.txt"
|
|
|
|
|
number))
|
|
|
|
|
(write-file rfc-path))
|
|
|
|
|
(find-file rfc-path)))))
|
|
|
|
|
(t
|
|
|
|
|
(warn "`db/rfc-cache-path' not defined or not an absolute writable path, opening RFC in browser.")
|
|
|
|
|
(browse-url (concat "https://tools.ietf.org/html/rfc" number)))))
|
|
|
|
|
|
2020-06-26 23:21:37 +02:00
|
|
|
|
|
|
|
|
|
;;; Org Utilities
|
|
|
|
|
|
|
|
|
|
(defun db/org-cleanup-continuous-clocks ()
|
|
|
|
|
"Join continuous clock lines in the current buffer."
|
|
|
|
|
(interactive)
|
|
|
|
|
(let* ((inactive-timestamp (org-re-timestamp 'inactive))
|
|
|
|
|
(clock-line (concat "\\(^ *\\)CLOCK: " inactive-timestamp "--" inactive-timestamp " => .*"
|
|
|
|
|
"\n"
|
|
|
|
|
" *CLOCK: " inactive-timestamp "--\\[\\2\\] => .*$")))
|
|
|
|
|
(save-excursion
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(while (search-forward-regexp clock-line nil t)
|
2022-03-30 08:44:15 +02:00
|
|
|
|
(replace-match "\\1CLOCK: [\\4]--[\\3]")
|
|
|
|
|
(org-clock-update-time-maybe)))))
|
2020-06-26 23:21:37 +02:00
|
|
|
|
|
|
|
|
|
(defun db/find-csv-in-org (arg)
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Interactively find CSV file and open it as Org mode table.
|
2020-06-26 23:21:37 +02:00
|
|
|
|
Default separator is \";\", but this can be changed interactively
|
2021-03-20 16:03:12 +01:00
|
|
|
|
by passing a non-nil value for ARG."
|
2020-06-26 23:21:37 +02:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(let ((separator (if arg (read-from-minibuffer "Separator (regular expression): ")
|
|
|
|
|
";")))
|
|
|
|
|
(call-interactively #'find-file)
|
|
|
|
|
(org-mode)
|
|
|
|
|
(org-table-convert-region (point-min) (point-max) separator)))
|
|
|
|
|
|
|
|
|
|
(defun db/org-mark-current-default-task ()
|
|
|
|
|
"Mark current task as default when equal to work task or home task.
|
|
|
|
|
Work task and home task are determined by the current values of
|
|
|
|
|
`org-working-task-id’ and `org-home-task-id’, respectively."
|
|
|
|
|
(let ((current-id (org-id-get org-clock-marker)))
|
|
|
|
|
(when (member current-id (list org-working-task-id
|
|
|
|
|
org-home-task-id))
|
|
|
|
|
(org-clock-mark-default-task))))
|
|
|
|
|
|
2022-12-15 14:16:52 +01:00
|
|
|
|
(defun db/org--find-template ()
|
|
|
|
|
"Return marker to template item associated with item at point.
|
|
|
|
|
|
|
|
|
|
Return NIL if no template is associated with item at point.
|
|
|
|
|
|
|
|
|
|
See `db/org-insert-checklist' for how this template item is
|
|
|
|
|
determined."
|
|
|
|
|
|
|
|
|
|
(let (template-marker)
|
|
|
|
|
|
|
|
|
|
;; Check for TEMPLATE_ID property
|
|
|
|
|
(when-let ((template-id (org-entry-get (point) "TEMPLATE_ID")))
|
|
|
|
|
(setq template-marker (org-id-find template-id :get-marker))
|
|
|
|
|
(unless template-marker
|
|
|
|
|
(warn "TEMPLATE_ID is set, but could not be resolved: %s"
|
|
|
|
|
template-id)))
|
|
|
|
|
|
|
|
|
|
;; If no template has been found so far, search for top-most sibling and
|
|
|
|
|
;; whether its headline starts with “Template”; use that when found.
|
|
|
|
|
(unless template-marker
|
|
|
|
|
(let ((top-most-sibling (condition-case _
|
|
|
|
|
(save-restriction
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(outline-up-heading 1 'invisible-ok)
|
|
|
|
|
(outline-next-heading)
|
|
|
|
|
(point)))
|
|
|
|
|
(t nil))))
|
|
|
|
|
(when (and top-most-sibling
|
|
|
|
|
(integerp top-most-sibling) ; just to make sure we have a point here
|
|
|
|
|
(string-match-p "^Template.*"
|
|
|
|
|
(org-entry-get top-most-sibling "ITEM")))
|
|
|
|
|
(setq template-marker (org-with-point-at top-most-sibling
|
|
|
|
|
(point-marker))))))
|
|
|
|
|
|
|
|
|
|
;; Return `template-marker', which is either `nil' or a marker.
|
|
|
|
|
template-marker))
|
|
|
|
|
|
2022-10-09 11:22:36 +02:00
|
|
|
|
(defun db/org-insert-checklist ()
|
|
|
|
|
"Insert checklist for Org Mode item at point.
|
|
|
|
|
|
|
|
|
|
The checklist consists of a listing of all backlinks to the
|
|
|
|
|
current item and its parents (without archives) as well as a
|
2022-10-30 12:04:13 +01:00
|
|
|
|
template.
|
|
|
|
|
|
|
|
|
|
The depth to which backlinks to parents are considered can be
|
|
|
|
|
configured via the CHECKLIST_BACKLINK_DEPTH property. This
|
|
|
|
|
property is looked up only at the current item, i.e., no
|
|
|
|
|
inheritance is considered. If this property is not set, the
|
|
|
|
|
depth to which backlinks to parents is considered is unlimited by
|
|
|
|
|
default (i.e., nil).
|
|
|
|
|
|
|
|
|
|
The template is determined by the TEMPLATE_ID property, which
|
|
|
|
|
must be an ID referencing the proper template item. If that
|
|
|
|
|
property is not set, search for the topmost sibling of the
|
|
|
|
|
current item and see whether its headline is matching
|
2022-11-12 16:56:29 +01:00
|
|
|
|
\"^Template.*\"; if so, use its body as template."
|
2021-12-15 09:43:50 +01:00
|
|
|
|
(interactive)
|
|
|
|
|
|
2022-10-09 11:22:36 +02:00
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org mode, aborting"))
|
|
|
|
|
|
2022-11-12 16:56:29 +01:00
|
|
|
|
;; Insert relevant backlinks, when available.
|
|
|
|
|
(let ((parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
|
2022-11-12 15:46:49 +01:00
|
|
|
|
(string-to-number it)))
|
|
|
|
|
number-of-backlinks
|
|
|
|
|
point-before-backlinks)
|
2022-10-30 12:04:13 +01:00
|
|
|
|
|
2022-11-12 11:50:53 +01:00
|
|
|
|
(insert (format "\nBacklinks (not DONE, no TEMPLATE, %s, no archives, not scheduled in the future):\n\n"
|
2022-10-30 12:04:13 +01:00
|
|
|
|
(if parent-depth
|
|
|
|
|
(format "parent-depth %d" parent-depth)
|
|
|
|
|
"all parents")))
|
2022-11-12 15:46:49 +01:00
|
|
|
|
|
|
|
|
|
;; Store where we are (minus the two newlines) so we can delete the
|
|
|
|
|
;; checklist in case it's empty.
|
|
|
|
|
(setq point-before-backlinks (- (point) 2))
|
|
|
|
|
|
|
|
|
|
(setq number-of-backlinks
|
|
|
|
|
(org-dblock-write:db/org-backlinks (list
|
|
|
|
|
:org-ql-match '(and
|
|
|
|
|
(not (done))
|
|
|
|
|
(not (ltags "TEMPLATE"))
|
|
|
|
|
(not (scheduled :from 1)))
|
|
|
|
|
:parent-depth (--when-let (org-entry-get (point) "CHECKLIST_BACKLINK_DEPTH" nil)
|
|
|
|
|
(string-to-number it))
|
|
|
|
|
:archive nil)))
|
|
|
|
|
|
|
|
|
|
;; When no backlinks have been found, remove the empty table head and just
|
|
|
|
|
;; print "none".
|
|
|
|
|
(when (zerop number-of-backlinks)
|
|
|
|
|
(delete-region point-before-backlinks (point))
|
|
|
|
|
(insert " none.")))
|
|
|
|
|
|
2022-11-12 16:56:29 +01:00
|
|
|
|
;; Insert template, when avilable.
|
2022-12-15 14:16:52 +01:00
|
|
|
|
(let ((template-marker (db/org--find-template)))
|
2022-11-12 16:56:29 +01:00
|
|
|
|
(insert "\n\nTemplate:")
|
2022-12-15 14:16:52 +01:00
|
|
|
|
(if (not template-marker)
|
2022-11-12 16:56:29 +01:00
|
|
|
|
(insert " none.")
|
|
|
|
|
(insert "\n")
|
2022-12-15 14:16:52 +01:00
|
|
|
|
(db/org-copy-body-from-item-to-point template-marker))))
|
2021-12-15 09:43:50 +01:00
|
|
|
|
|
2022-10-09 11:22:36 +02:00
|
|
|
|
(define-obsolete-function-alias 'db/org-copy-template
|
|
|
|
|
'db/org-insert-checklist
|
|
|
|
|
"2022-10-09")
|
|
|
|
|
|
2022-12-15 14:16:52 +01:00
|
|
|
|
(defun db/org-goto-checklist-item-of-point ()
|
|
|
|
|
"Go to template item associated with current item.
|
|
|
|
|
|
|
|
|
|
Error out if no such template item exists.
|
|
|
|
|
|
|
|
|
|
See `db/org-insert-checklist' for how this template item is
|
|
|
|
|
determined."
|
|
|
|
|
(interactive)
|
|
|
|
|
(--if-let (db/org--find-template)
|
|
|
|
|
(progn
|
|
|
|
|
(push-mark)
|
|
|
|
|
(org-goto-marker-or-bmk it))
|
|
|
|
|
(user-error "No template associated with item at point")))
|
|
|
|
|
|
2021-08-08 13:49:07 +02:00
|
|
|
|
(defun db/org-copy-body-from-item-to-point (pom)
|
|
|
|
|
"Copy body from item given by POM to point.
|
|
|
|
|
This can be used to copy checklists from templates to the current
|
2022-01-02 09:31:29 +01:00
|
|
|
|
item, which might be an instance of a periodic task. If POM is
|
|
|
|
|
not given, use `db/org-get-location' to interactively query for
|
|
|
|
|
it. Adds newline before and after the template."
|
2021-10-29 14:35:35 +02:00
|
|
|
|
(interactive (list (db/org-get-location t)))
|
2021-08-08 13:49:07 +02:00
|
|
|
|
(unless (number-or-marker-p pom)
|
|
|
|
|
(user-error "Argument is neither point nor mark: %s" pom))
|
|
|
|
|
(let ((body (save-restriction
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(let ((template-element (org-with-point-at pom
|
|
|
|
|
(org-element-at-point))))
|
2022-10-03 10:11:17 +02:00
|
|
|
|
(with-current-buffer (if (markerp pom) (marker-buffer pom) (current-buffer))
|
|
|
|
|
(let ((content-end (org-element-property :contents-end template-element))
|
|
|
|
|
current-element
|
|
|
|
|
content-begin)
|
|
|
|
|
;; Start finding the beginning of the template contents from the top …
|
|
|
|
|
(goto-char (org-element-property :contents-begin template-element))
|
|
|
|
|
;; … but skip any drawers we may find.
|
|
|
|
|
(setq current-element (org-element-at-point))
|
|
|
|
|
(while (memq (org-element-type current-element)
|
|
|
|
|
'(drawer property-drawer))
|
|
|
|
|
(goto-char (org-element-property :end current-element))
|
|
|
|
|
(setq current-element (org-element-at-point)))
|
|
|
|
|
;; Now we are at the beginning of the contents, let's copy
|
|
|
|
|
;; that, but only if it exists and is not empty.
|
|
|
|
|
(setq content-begin (org-element-property :begin current-element))
|
|
|
|
|
(unless (and content-begin
|
|
|
|
|
(< content-begin content-end))
|
|
|
|
|
(user-error "Cannot find content in template, or content is empty"))
|
|
|
|
|
(string-trim-right
|
|
|
|
|
(buffer-substring-no-properties content-begin content-end)))))))))
|
2022-01-02 09:31:29 +01:00
|
|
|
|
(insert "\n")
|
2021-08-08 13:49:07 +02:00
|
|
|
|
(insert body)
|
2022-01-02 09:31:29 +01:00
|
|
|
|
(insert "\n")
|
2020-06-26 23:21:37 +02:00
|
|
|
|
(org-update-statistics-cookies nil)))
|
|
|
|
|
|
2021-11-29 17:39:33 +01:00
|
|
|
|
(defun db/org-update-headline-log-note (&optional new-headline)
|
2021-11-29 17:05:21 +01:00
|
|
|
|
"Replace headline of item at point with NEW-HEADLINE.
|
2022-04-02 08:56:18 +02:00
|
|
|
|
|
|
|
|
|
Interactively query for HEADLINE when not provided. Clear refile
|
|
|
|
|
cache if that's in use."
|
2021-11-29 17:39:33 +01:00
|
|
|
|
(interactive)
|
2021-11-29 17:05:21 +01:00
|
|
|
|
|
2021-11-29 17:35:15 +01:00
|
|
|
|
(unless (derived-mode-p 'org-mode 'org-agenda-mode)
|
|
|
|
|
(user-error "Neither in an Org mode nor Org agenda buffer, aborting"))
|
2021-11-29 17:05:21 +01:00
|
|
|
|
|
2021-11-29 17:39:33 +01:00
|
|
|
|
(unless new-headline
|
2022-01-08 15:42:40 +01:00
|
|
|
|
(let ((default-value (cond
|
|
|
|
|
((derived-mode-p 'org-mode)
|
|
|
|
|
(org-entry-get (point) "ITEM"))
|
|
|
|
|
((derived-mode-p 'org-agenda-mode)
|
|
|
|
|
(org-agenda-with-point-at-orig-entry
|
|
|
|
|
nil (org-entry-get (point) "ITEM"))))))
|
|
|
|
|
(setq new-headline (read-string "New Headline: "
|
|
|
|
|
nil nil
|
|
|
|
|
default-value))))
|
2021-11-29 17:39:33 +01:00
|
|
|
|
|
|
|
|
|
(unless (stringp new-headline)
|
|
|
|
|
(user-error "New headline must be string"))
|
|
|
|
|
|
2021-11-29 17:05:21 +01:00
|
|
|
|
(when (string-match-p "\n" new-headline)
|
|
|
|
|
(user-error "New headline contains newlines, aborting"))
|
|
|
|
|
|
2021-11-29 17:35:15 +01:00
|
|
|
|
(save-window-excursion
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(when (derived-mode-p 'org-agenda-mode)
|
|
|
|
|
(org-agenda-goto))
|
|
|
|
|
|
|
|
|
|
(when (org-before-first-heading-p)
|
|
|
|
|
(user-error "Point is before first headline, aborting"))
|
|
|
|
|
|
|
|
|
|
(let ((old-headline (org-entry-get (point) "ITEM")))
|
2022-03-24 20:16:50 +01:00
|
|
|
|
;; Update headline
|
2021-11-29 17:35:15 +01:00
|
|
|
|
(org-edit-headline new-headline)
|
|
|
|
|
|
2022-03-24 20:16:50 +01:00
|
|
|
|
;; Store note manually (I tried using `org-add-log-note', but did not succeed …)
|
|
|
|
|
(goto-char (org-log-beginning 'create))
|
|
|
|
|
(indent-according-to-mode)
|
|
|
|
|
(insert "- Note taken on ")
|
|
|
|
|
(org-insert-time-stamp (current-time) t t)
|
|
|
|
|
(insert " \\\\\n")
|
|
|
|
|
(indent-according-to-mode)
|
|
|
|
|
(insert (format " Changed headline from: %s\n" old-headline)))))
|
2021-11-29 17:35:15 +01:00
|
|
|
|
|
2022-04-02 08:56:18 +02:00
|
|
|
|
(when org-refile-use-cache
|
|
|
|
|
(org-refile-cache-clear))
|
|
|
|
|
|
2021-11-29 17:35:15 +01:00
|
|
|
|
(when (derived-mode-p 'org-agenda-mode)
|
|
|
|
|
(org-agenda-redo)))
|
2021-11-29 17:05:21 +01:00
|
|
|
|
|
2022-11-19 16:09:38 +01:00
|
|
|
|
(defun db/org-goto-first-open-checkbox-in-subtree (&optional silent)
|
2022-08-28 19:07:51 +02:00
|
|
|
|
"Jump to first open checkbox in the current subtree.
|
|
|
|
|
|
|
|
|
|
First search for started checkboxes, i.e. [-], and if those are
|
|
|
|
|
not found, go to the first open checkbox, i.e. [ ].
|
|
|
|
|
|
2022-11-19 16:09:38 +01:00
|
|
|
|
If there's no such open checkbox, emit a message (unless SILENT
|
|
|
|
|
is non-nil) and stay put.
|
|
|
|
|
|
|
|
|
|
Note: when lists are nested, those are not (yet) descended into
|
|
|
|
|
to find the logically first open checkbox. This should be fixed
|
|
|
|
|
somewhen, though."
|
|
|
|
|
|
2022-08-28 19:07:51 +02:00
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org buffer, exiting"))
|
2022-11-19 16:09:38 +01:00
|
|
|
|
|
2022-08-28 19:07:51 +02:00
|
|
|
|
(save-restriction
|
2022-08-29 17:58:02 +02:00
|
|
|
|
(let ((original-point (point)))
|
|
|
|
|
(widen)
|
|
|
|
|
(org-back-to-heading 'invisible-ok)
|
|
|
|
|
(org-narrow-to-subtree)
|
|
|
|
|
(unless
|
2022-11-19 16:09:38 +01:00
|
|
|
|
;; Yes, those `progn's are not strictly necessary, but it feels
|
|
|
|
|
;; cleaner this way.
|
2022-08-29 17:58:02 +02:00
|
|
|
|
(or (progn
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(re-search-forward " \\[-\\] " nil 'no-error))
|
|
|
|
|
(progn
|
|
|
|
|
(goto-char (point-min))
|
|
|
|
|
(re-search-forward " \\[ \\] " nil 'no-error)))
|
2022-11-19 16:09:38 +01:00
|
|
|
|
(unless silent
|
|
|
|
|
(message "No open checkbox in subtree"))
|
2022-08-29 17:58:02 +02:00
|
|
|
|
(goto-char original-point)))))
|
2022-08-28 19:07:51 +02:00
|
|
|
|
|
2022-11-19 16:09:38 +01:00
|
|
|
|
(defun db/org-clock-goto-first-open-checkbox (&optional select)
|
|
|
|
|
"Go to the currently clocked-in item or most recently clocked item.
|
|
|
|
|
|
|
|
|
|
Move point to first open checkbox there, if there's one. See
|
|
|
|
|
`db/org-goto-first-open-checkbox-in-subtree' for details.
|
|
|
|
|
|
|
|
|
|
If SELECT is non-nil, offer a choice of the most recently
|
|
|
|
|
clocked-in tasks to jump to."
|
|
|
|
|
(interactive "@P")
|
|
|
|
|
(org-clock-goto select)
|
|
|
|
|
;; `org-clock-goto' will barf if there's no currently clocked-in task, so
|
|
|
|
|
;; there is no need to check this again; just try to find the first checkbox
|
|
|
|
|
;; now.
|
|
|
|
|
(db/org-goto-first-open-checkbox-in-subtree :silent))
|
|
|
|
|
|
2020-06-26 23:21:37 +02:00
|
|
|
|
|
|
|
|
|
;;; Calendar
|
|
|
|
|
|
|
|
|
|
(defun db/export-diary ()
|
2021-03-20 16:03:12 +01:00
|
|
|
|
"Export diary.org as ics file to `org-icalendar-combined-agenda-file’.
|
2020-06-26 23:21:37 +02:00
|
|
|
|
This is done only if the value of this variable is not null."
|
|
|
|
|
(interactive)
|
|
|
|
|
(cond
|
2022-11-19 16:09:38 +01:00
|
|
|
|
((null org-icalendar-combined-agenda-file)
|
|
|
|
|
(message "`org-icalendar-combined-agenda-file’ not set, not exporting diary."))
|
|
|
|
|
((not (file-name-absolute-p org-icalendar-combined-agenda-file))
|
|
|
|
|
(user-error "`org-icalendar-combined-agenda-file’ not an absolute path, aborting"))
|
|
|
|
|
(t
|
|
|
|
|
(progn
|
|
|
|
|
(org-save-all-org-buffers)
|
|
|
|
|
(let ((org-agenda-files (cl-remove-if #'null
|
|
|
|
|
(list db/org-default-org-file
|
|
|
|
|
db/org-default-home-file
|
|
|
|
|
db/org-default-work-file)))
|
|
|
|
|
(org-agenda-new-buffers nil))
|
|
|
|
|
;; check whether we need to do something
|
|
|
|
|
(when (cl-some (lambda (org-file)
|
|
|
|
|
(file-newer-than-file-p org-file
|
|
|
|
|
org-icalendar-combined-agenda-file))
|
|
|
|
|
org-agenda-files)
|
|
|
|
|
(message "Exporting diary ...")
|
|
|
|
|
;; open files manually to avoid polluting `org-agenda-new-buffers’; we
|
|
|
|
|
;; don’t want these buffers to be closed after exporting
|
|
|
|
|
(mapc #'find-file-noselect org-agenda-files)
|
|
|
|
|
;; actual export; calls `org-release-buffers’ and may thus close
|
|
|
|
|
;; buffers we want to keep around … which is why we set
|
|
|
|
|
;; `org-agenda-new-buffers’ to nil
|
|
|
|
|
(when (file-exists-p org-icalendar-combined-agenda-file)
|
|
|
|
|
(delete-file org-icalendar-combined-agenda-file)
|
|
|
|
|
(sit-for 3))
|
|
|
|
|
(org-icalendar-combine-agenda-files)
|
|
|
|
|
(message "Exporting diary ... done.")))))))
|
2020-06-26 23:21:37 +02:00
|
|
|
|
|
2020-09-26 14:14:45 +02:00
|
|
|
|
|
|
|
|
|
;;; Find items by link to current headline
|
|
|
|
|
|
2020-09-26 15:20:11 +02:00
|
|
|
|
(defun db/org-find-items-linking-by-id (id custom-id)
|
2020-09-26 14:14:45 +02:00
|
|
|
|
"List all Org Mode items that link to ID.
|
|
|
|
|
Uses `org-search-view' to conduct the actual search. ID must be
|
2020-09-26 15:00:34 +02:00
|
|
|
|
a UUID as generated by, e.g., `org-id-get-create', and CUSTOM-ID
|
2020-09-26 15:20:11 +02:00
|
|
|
|
must consist of ASCII letters, numbers, and hyphens only. Each
|
|
|
|
|
of ID and CUSTOM-ID may be nil, but at least one of them must be
|
|
|
|
|
not."
|
2020-09-26 15:12:28 +02:00
|
|
|
|
(unless (or (not id)
|
|
|
|
|
(and (stringp id)
|
|
|
|
|
(string-match-p "^[a-f0-9]\\{8\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{4\\}-[a-f0-9]\\{12\\}$" id)))
|
2020-09-26 15:00:34 +02:00
|
|
|
|
(user-error "Given ID is not a valid UUID: %s" id))
|
2020-09-26 15:12:28 +02:00
|
|
|
|
(unless (or (not custom-id)
|
|
|
|
|
(and (stringp custom-id)
|
|
|
|
|
(string-match-p "[-a-zA-Z0-9]" custom-id)))
|
2020-09-26 15:00:34 +02:00
|
|
|
|
;; sorry, only ASCII right now …
|
|
|
|
|
(user-error "CUSTOM_ID must consist of alphanumeric charaters only"))
|
|
|
|
|
|
|
|
|
|
(let ((query (cond
|
2020-09-26 18:16:43 +02:00
|
|
|
|
((and id custom-id) (format "{\\[\\[id:%s\\]\\|\\[\\[file:[^]]*::#%s\\]\\|\\[#%s\\]}"
|
|
|
|
|
id custom-id custom-id))
|
2020-09-26 15:00:34 +02:00
|
|
|
|
(id (format "[[id:%s]" id))
|
2020-09-26 18:16:43 +02:00
|
|
|
|
(custom-id (format "{\\[file:[^]]*::#%s\\]\\|\\[#%s\\]}"
|
|
|
|
|
custom-id custom-id))
|
2020-09-26 16:29:50 +02:00
|
|
|
|
(t (user-error "Neither ID nor CUSTOM_ID given")))))
|
2020-09-26 15:00:34 +02:00
|
|
|
|
(org-search-view nil query)))
|
2020-09-26 14:14:45 +02:00
|
|
|
|
|
2021-08-08 13:51:52 +02:00
|
|
|
|
(defun db/org-get-location (&optional arg)
|
2020-09-28 19:37:58 +02:00
|
|
|
|
"Interactively query for location and return mark.
|
2021-03-27 10:19:01 +01:00
|
|
|
|
|
2022-04-16 10:08:11 +02:00
|
|
|
|
Searches through the current buffer if that one is an Org buffer
|
|
|
|
|
and is associated with a file, or `db/org-default-org-file'.
|
|
|
|
|
When ARG is non-nil, search through all files in the variables
|
|
|
|
|
`org-agenda-files', `org-agenda-text-search-extra-files', and the
|
|
|
|
|
current file or `db/org-default-org-file'.
|
2021-03-27 10:19:01 +01:00
|
|
|
|
|
|
|
|
|
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."
|
2021-03-26 16:47:22 +01:00
|
|
|
|
(let ((org-refile-target-verify-function nil)
|
2021-03-27 10:19:01 +01:00
|
|
|
|
(org-refile-use-cache nil)
|
2022-04-16 10:08:11 +02:00
|
|
|
|
;; 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))
|
2021-03-27 10:19:01 +01:00
|
|
|
|
(current-buffer)
|
|
|
|
|
(find-file-noselect db/org-default-org-file))))
|
|
|
|
|
(when (null default-buffer)
|
|
|
|
|
(user-error "Current buffer is not associated with a file and `db/org-default-org-file' does not exist; nothing to search through"))
|
2021-04-16 17:34:40 +02:00
|
|
|
|
(let* ((org-refile-targets (append (and arg
|
|
|
|
|
`((org-agenda-files :maxlevel . 9)
|
|
|
|
|
(,(cl-remove-if-not #'stringp
|
|
|
|
|
org-agenda-text-search-extra-files)
|
|
|
|
|
:maxlevel . 9)))
|
|
|
|
|
'((nil :maxlevel . 9))))
|
2021-04-16 17:31:55 +02:00
|
|
|
|
(target-pointer (org-refile-get-location nil default-buffer))
|
2021-04-01 17:02:01 +02:00
|
|
|
|
(pom (nth 3 target-pointer)))
|
2021-03-27 10:19:01 +01:00
|
|
|
|
(cond
|
|
|
|
|
((markerp pom) pom)
|
|
|
|
|
((integerp pom)
|
2021-04-01 17:02:01 +02:00
|
|
|
|
;; 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
|
2021-03-27 10:19:01 +01:00
|
|
|
|
(save-mark-and-excursion
|
2021-04-01 17:02:01 +02:00
|
|
|
|
(with-current-buffer (find-file-noselect (nth 1 target-pointer))
|
2021-03-27 10:19:01 +01:00
|
|
|
|
(goto-char pom)
|
|
|
|
|
(point-marker))))
|
|
|
|
|
(t (user-error "Invalid location"))))))
|
2020-09-28 19:37:58 +02:00
|
|
|
|
|
2020-09-26 15:20:11 +02:00
|
|
|
|
(defun db/org-find-links-to-current-item (arg)
|
|
|
|
|
"Find links to current item.
|
|
|
|
|
Only links using the ID or CUSTOM_ID property are considered.
|
|
|
|
|
|
2021-03-27 10:39:53 +01:00
|
|
|
|
If ARG is given, or if neither in an Org Mode buffer nor on a
|
|
|
|
|
headline in an Org Agenda buffer, interactively prompt for an
|
2022-04-16 10:10:49 +02:00
|
|
|
|
item using `db/org-get-location', which see."
|
2020-09-26 15:20:11 +02:00
|
|
|
|
(interactive "P")
|
|
|
|
|
(apply #'db/org-find-items-linking-by-id
|
2022-04-16 10:10:49 +02:00
|
|
|
|
;; Determine the current item interactively based on where we are: when
|
|
|
|
|
;; in an Org buffer or in Org agenda view, indeed use the item at
|
|
|
|
|
;; point; otherwise, and when ARG is given, query the user for the item
|
|
|
|
|
;; to look for.
|
|
|
|
|
(org-with-point-at (cond ((and (not arg)
|
|
|
|
|
(derived-mode-p 'org-mode))
|
|
|
|
|
(point))
|
|
|
|
|
((and (not arg)
|
|
|
|
|
(derived-mode-p 'org-agenda-mode)
|
|
|
|
|
(org-get-at-bol 'org-hd-marker))
|
|
|
|
|
(org-get-at-bol 'org-hd-marker))
|
|
|
|
|
(t
|
|
|
|
|
(db/org-get-location)))
|
|
|
|
|
(list (org-id-get) (org-entry-get nil "CUSTOM_ID")))))
|
2020-09-26 15:20:11 +02:00
|
|
|
|
|
2022-05-20 19:34:56 +02:00
|
|
|
|
(defun db/org--format-link-from-pom (pom)
|
|
|
|
|
"Return Org link pointing to Org item at POM.
|
2022-05-20 19:21:05 +02:00
|
|
|
|
|
2022-05-20 19:34:56 +02:00
|
|
|
|
POM must be point or mark to a valid Org item. The link will be
|
|
|
|
|
of the format [[id][item-headline]], where `id' is the value of
|
|
|
|
|
the ID property of the item. If the item does not have such a
|
|
|
|
|
property, is is generated automatically.
|
2022-05-20 19:21:05 +02:00
|
|
|
|
|
2022-05-20 19:34:56 +02:00
|
|
|
|
If `item-headline' contains any links itself, those will be
|
|
|
|
|
replaced by the description when available, and otherwise by
|
|
|
|
|
their plain link part."
|
|
|
|
|
(unless (or (markerp pom) (integerp pom))
|
|
|
|
|
(user-error "POM must be point or mark"))
|
2021-05-12 17:47:45 +02:00
|
|
|
|
|
|
|
|
|
(let (item id)
|
|
|
|
|
(org-with-point-at pom
|
|
|
|
|
(setq item (org-entry-get (point) "ITEM")
|
|
|
|
|
id (org-id-get-create)))
|
|
|
|
|
|
2022-10-29 10:17:28 +02:00
|
|
|
|
(org-link-make-string (format "id:%s" id)
|
|
|
|
|
(org-link-display-format item))))
|
2022-05-20 19:34:56 +02:00
|
|
|
|
|
|
|
|
|
(defun db/org--format-link-from-org-id (id)
|
|
|
|
|
"Format ID as an Org mode link [[ID][item-headline]].
|
|
|
|
|
|
|
|
|
|
If the headline of the item pointed to by ID contains any links,
|
|
|
|
|
those are replaced by their description before formatting."
|
|
|
|
|
(db/org--format-link-from-pom (org-id-find id 'marker)))
|
|
|
|
|
|
|
|
|
|
(defun db/org-insert-link-to-pom (pom)
|
|
|
|
|
"Insert an Org link to headline at POM.
|
|
|
|
|
|
|
|
|
|
If headline consists of a link with description, only the
|
|
|
|
|
description of that link will be included in the description of
|
|
|
|
|
the newly inserted link instead of the complete headline. This
|
|
|
|
|
avoids containing a link in the description of the newly inserted
|
|
|
|
|
link."
|
|
|
|
|
(insert (db/org--format-link-from-pom pom)))
|
2021-05-12 17:47:45 +02:00
|
|
|
|
|
2021-03-20 11:50:56 +01:00
|
|
|
|
(defun db/org-add-link-to-other-item (arg)
|
2020-09-26 16:44:11 +02:00
|
|
|
|
"Interactively query for item and add link to it at point.
|
2021-03-20 11:50:56 +01:00
|
|
|
|
|
|
|
|
|
Search through all items of the current buffer, or
|
|
|
|
|
`db/org-default-org-file' if the current buffer is not associated
|
2021-03-20 16:03:12 +01:00
|
|
|
|
with a file. If ARG is non-nil, include all files in the
|
|
|
|
|
variables `org-agenda-files' and
|
2021-04-29 19:52:54 +02:00
|
|
|
|
`org-agenda-text-search-extra-files' in this search."
|
2021-03-20 11:50:56 +01:00
|
|
|
|
(interactive "P")
|
2020-09-26 16:48:02 +02:00
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org Mode"))
|
2021-08-08 13:51:52 +02:00
|
|
|
|
(db/org-insert-link-to-pom (db/org-get-location arg)))
|
2020-09-26 16:44:11 +02:00
|
|
|
|
|
2021-03-20 12:32:48 +01:00
|
|
|
|
(defun db/org-add-link-to-current-clock ()
|
|
|
|
|
"Insert link to currently clocked-in item at point.
|
2022-07-22 18:21:55 +02:00
|
|
|
|
Error out when the clock is not active."
|
2021-03-20 12:32:48 +01:00
|
|
|
|
(interactive)
|
|
|
|
|
(unless org-clock-marker
|
|
|
|
|
(user-error "No clocked-in task, aborting"))
|
2021-05-12 17:47:45 +02:00
|
|
|
|
(db/org-insert-link-to-pom org-clock-marker))
|
2021-03-20 12:32:48 +01:00
|
|
|
|
|
2021-07-17 08:47:37 +02:00
|
|
|
|
(defun db/org-add-link-to-org-clock-select-task ()
|
|
|
|
|
"Insert link to Org item that was recently associated with clocking.
|
|
|
|
|
|
|
|
|
|
Interactively query for such an item and insert link to current
|
|
|
|
|
buffer at point."
|
|
|
|
|
(interactive "")
|
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org Mode, will not insert link"))
|
|
|
|
|
(let ((pom (org-clock-select-task "Select item to link to: ")))
|
|
|
|
|
(if (null pom)
|
|
|
|
|
(error "Invalid choice")
|
|
|
|
|
(db/org-insert-link-to-pom pom))))
|
|
|
|
|
|
2021-03-20 15:45:49 +01:00
|
|
|
|
(defhydra hydra-org-linking (:color blue :hint none)
|
2021-03-20 20:50:27 +01:00
|
|
|
|
"
|
|
|
|
|
Add link at point to …
|
|
|
|
|
… _c_urrent clock
|
2021-09-04 16:17:35 +02:00
|
|
|
|
… _s_elect clock item from the recent clock history
|
2021-03-20 20:50:27 +01:00
|
|
|
|
… _o_ther item (from current file buffer or default Org file)
|
|
|
|
|
… _O_ther item (from all Org mode text search files)
|
|
|
|
|
|
|
|
|
|
Show _b_acklinks to current item."
|
2021-03-27 09:48:55 +01:00
|
|
|
|
("c" db/org-add-link-to-current-clock)
|
2021-07-17 08:47:37 +02:00
|
|
|
|
("s" db/org-add-link-to-org-clock-select-task)
|
2021-03-20 15:45:49 +01:00
|
|
|
|
("o" (db/org-add-link-to-other-item nil))
|
|
|
|
|
("O" (db/org-add-link-to-other-item t))
|
|
|
|
|
("b" db/org-find-links-to-current-item))
|
|
|
|
|
|
2022-05-05 22:08:02 +02:00
|
|
|
|
(defun db/org--backlinks-for-id (item-id &optional org-ql-match archives)
|
|
|
|
|
"Return list of ID properties of Org Mode items linking to ITEM-ID.
|
2022-04-16 09:58:46 +02:00
|
|
|
|
|
2022-05-05 22:08:02 +02:00
|
|
|
|
If the optional ORG-QL-MATCH is given and is a valid `org-ql' query in
|
2022-04-16 09:58:46 +02:00
|
|
|
|
sexp syntax, filter the list for all items matching this query.
|
|
|
|
|
If ARCHIVES is given, also include archive files.
|
|
|
|
|
|
|
|
|
|
The search is conducted over all files returned by
|
|
|
|
|
`org-agenda-files' including archives, as well as all files
|
|
|
|
|
referenced in `org-agenda-text-search-extra-files'."
|
|
|
|
|
|
2022-05-05 22:08:02 +02:00
|
|
|
|
(let ((extra-files org-agenda-text-search-extra-files)
|
|
|
|
|
files)
|
2022-04-16 09:58:46 +02:00
|
|
|
|
|
|
|
|
|
;; Determine files to search through; ignore `agenda-archive' in
|
|
|
|
|
;; `org-agenda-text-search-extra-files', as we already handle this when
|
|
|
|
|
;; calling `org-agenda-files'.
|
|
|
|
|
(setq files (org-agenda-files t archives))
|
2022-04-16 10:19:28 +02:00
|
|
|
|
(when (eq (car extra-files) 'agenda-archives)
|
|
|
|
|
(pop extra-files))
|
|
|
|
|
(setq files (append files extra-files))
|
2022-04-16 09:58:46 +02:00
|
|
|
|
|
2022-06-09 21:27:35 +02:00
|
|
|
|
;; Search directly for “[[id:ITEM-ID]” instead of using the regular
|
|
|
|
|
;; expression for links, as the latter seems to be broken (as of
|
|
|
|
|
;; [2022-06-09] when descriptions contain brackets
|
2022-05-05 22:08:02 +02:00
|
|
|
|
(org-ql-query :select '(org-id-get-create)
|
2022-04-16 09:58:46 +02:00
|
|
|
|
:from files
|
2022-06-09 21:27:35 +02:00
|
|
|
|
:where (let ((link-expression `(regexp ,(format "\\[\\[id:%s\\]" item-id))))
|
2022-04-16 09:58:46 +02:00
|
|
|
|
(if org-ql-match
|
|
|
|
|
`(and ,link-expression ,org-ql-match)
|
|
|
|
|
link-expression)))))
|
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
(defun db/org--find-parent-marks (&optional depth)
|
2022-05-14 11:33:31 +02:00
|
|
|
|
"Return list of markers of all parent headings of Org item at point.
|
2022-05-05 22:08:02 +02:00
|
|
|
|
|
2022-05-14 11:33:31 +02:00
|
|
|
|
The list will include a marker to the current headline as well.
|
|
|
|
|
The order of the list will be in ascending order of
|
|
|
|
|
positions (i.e., the marker for the headline with the lowest
|
2022-06-20 18:01:11 +02:00
|
|
|
|
level/position comes first).
|
|
|
|
|
|
|
|
|
|
When optional parameter DEPTH is given, at most check only that
|
|
|
|
|
many parents. If DEPTH is zero, only return a list of a single
|
|
|
|
|
marker pointing to the current headline."
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(unless (derived-mode-p 'org-mode)
|
|
|
|
|
(user-error "Not in Org mode buffer, cannot determine parent items"))
|
2022-05-05 22:08:02 +02:00
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
(let ((depth depth)) ; do not modify argument
|
|
|
|
|
(save-mark-and-excursion
|
|
|
|
|
(save-restriction
|
|
|
|
|
(widen)
|
2022-05-14 11:33:31 +02:00
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
;; Start at headline of current item
|
|
|
|
|
(or (org-at-heading-p)
|
|
|
|
|
(org-back-to-heading t))
|
2022-05-14 11:33:31 +02:00
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
;; Iterate over parents until at top-level
|
|
|
|
|
(let ((parent-markers (list (point-marker))))
|
|
|
|
|
(while (and (org-up-heading-safe)
|
|
|
|
|
(or (null depth)
|
|
|
|
|
(<= 0 (cl-decf depth))))
|
|
|
|
|
(push (point-marker) parent-markers))
|
|
|
|
|
parent-markers)))))
|
2022-05-14 11:33:31 +02:00
|
|
|
|
|
|
|
|
|
(defun org-dblock-write:db/org-backlinks (params)
|
|
|
|
|
"Write table of backlinks for current item and its parent items as Org table.
|
|
|
|
|
|
2022-11-12 15:46:49 +01:00
|
|
|
|
Returns the number of backlinks.
|
|
|
|
|
|
2022-05-14 11:33:31 +02:00
|
|
|
|
PARAMS may contain the following values:
|
|
|
|
|
|
|
|
|
|
:org-ql-match An org-ql-match expression in sexp syntax to filter
|
|
|
|
|
the resulting backlinks
|
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
:archives If non-nil, include archives
|
|
|
|
|
|
|
|
|
|
:parent-depth How many parents to check for backlinks; value of nil means
|
|
|
|
|
unrestricted, a value of 0 means only consider current item."
|
|
|
|
|
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(let* ((org-ql-match (plist-get params :org-ql-match))
|
|
|
|
|
(archives (plist-get params :archives))
|
2022-06-20 18:01:11 +02:00
|
|
|
|
(parent-depth (plist-get params :parent-depth))
|
2022-06-10 18:46:22 +02:00
|
|
|
|
headlines output-lines)
|
2022-05-14 11:33:31 +02:00
|
|
|
|
|
2022-06-20 18:01:11 +02:00
|
|
|
|
(when (and (not (null parent-depth))
|
|
|
|
|
(not (integerp parent-depth)))
|
2022-10-30 12:04:13 +01:00
|
|
|
|
(user-error ":parent-depth is not an integer: %s" parent-depth))
|
2022-06-20 18:01:11 +02:00
|
|
|
|
|
2022-05-14 11:33:31 +02:00
|
|
|
|
;; Get all backlinks as list of Org mode IDs. Each list consists of the ID
|
|
|
|
|
;; of the headline (current or partent), followed by the IDs linking back to
|
|
|
|
|
;; that headline. If any of the headlines (current or parent) does not have
|
|
|
|
|
;; an ID, it will not be included in that list.
|
|
|
|
|
(setq headlines
|
2022-06-20 18:01:11 +02:00
|
|
|
|
(->> (db/org--find-parent-marks parent-depth)
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(mapcar #'(lambda (mark)
|
|
|
|
|
(org-with-point-at mark
|
|
|
|
|
(when-let ((id-at-point (org-id-get)))
|
|
|
|
|
(cons id-at-point
|
2022-06-11 09:22:08 +02:00
|
|
|
|
(db/org--backlinks-for-id id-at-point
|
|
|
|
|
org-ql-match
|
|
|
|
|
archives))))))
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(cl-remove-if #'null)))
|
|
|
|
|
|
2022-06-10 18:46:22 +02:00
|
|
|
|
;; Change entries in headlines from the format (headline-id backlink-ids...)
|
2022-06-11 09:22:08 +02:00
|
|
|
|
;; to (backlink-id headline-ids ...) for grouping them in the output later.
|
2022-06-10 18:46:22 +02:00
|
|
|
|
(setq headlines
|
|
|
|
|
(->> headlines
|
2022-06-11 09:22:08 +02:00
|
|
|
|
;; Transform (headline-id backlink-ids) to pairs
|
|
|
|
|
;; (headline-id . backlink-id)
|
|
|
|
|
(-mapcat (pcase-lambda (`(,headline . ,backlinks))
|
|
|
|
|
(mapcar #'(lambda (backlink)
|
|
|
|
|
(cons backlink headline))
|
|
|
|
|
backlinks)))
|
|
|
|
|
;; Group by backlinks (first entry), returns alist of
|
|
|
|
|
;; backlink-ids and list of pairs (backlink-id . headline-id)
|
2022-06-10 18:46:22 +02:00
|
|
|
|
(-group-by #'car)
|
|
|
|
|
;; Flatten list, to get a list of (backlink-id headline-ids...)
|
2022-06-11 09:22:08 +02:00
|
|
|
|
(-map (pcase-lambda (`(,backlink . ,backlink-headline-conses))
|
|
|
|
|
(cons backlink (-map #'cdr backlink-headline-conses))))))
|
2022-06-10 18:46:22 +02:00
|
|
|
|
|
|
|
|
|
;; Replace IDs by headlines and add priority for sorting
|
|
|
|
|
(setq output-lines
|
|
|
|
|
(->> headlines
|
2022-06-11 09:22:08 +02:00
|
|
|
|
(-map (pcase-lambda (`(,backlink-id . ,headline-ids))
|
|
|
|
|
(list (db/org--format-link-from-org-id backlink-id)
|
|
|
|
|
(org-entry-get (org-id-find backlink-id 'marker)
|
|
|
|
|
"PRIORITY")
|
|
|
|
|
(-map #'db/org--format-link-from-org-id headline-ids))))
|
|
|
|
|
(-sort (pcase-lambda (`(_ ,prio-1 _) `(_ ,prio-2 _))
|
|
|
|
|
(string< prio-1 prio-2)))))
|
2022-06-10 18:46:22 +02:00
|
|
|
|
|
|
|
|
|
;; Format output-lines as Org table
|
|
|
|
|
(insert (format "| Backlink | Prio | Backlink Target(s) |\n|---|"))
|
|
|
|
|
(when output-lines
|
2022-06-11 09:10:17 +02:00
|
|
|
|
(let (pp) ; pervious-priority, to draw hlines between groups of same priority
|
2022-06-11 09:22:08 +02:00
|
|
|
|
(pcase-dolist (`(,backlink ,priority ,backlink-targets) output-lines)
|
|
|
|
|
(when (and pp (not (equal pp priority)))
|
|
|
|
|
(insert "\n|--|"))
|
|
|
|
|
(setq pp priority)
|
|
|
|
|
(insert
|
|
|
|
|
(format "\n| %s | %s | %s |"
|
|
|
|
|
backlink
|
|
|
|
|
priority
|
|
|
|
|
(apply #'concat (-interpose ", " backlink-targets)))))
|
|
|
|
|
(insert "\n|---|")))
|
2022-11-12 15:46:49 +01:00
|
|
|
|
(org-table-align)
|
|
|
|
|
|
|
|
|
|
(length output-lines)))
|
2022-05-14 11:33:31 +02:00
|
|
|
|
|
|
|
|
|
(defun db/org-insert-backlink-block ()
|
|
|
|
|
"Create dynamic block of backlinks to current item or any of its parents."
|
|
|
|
|
(interactive)
|
|
|
|
|
(org-create-dblock
|
|
|
|
|
(list :name "db/org-backlinks"
|
2022-06-30 16:51:55 +02:00
|
|
|
|
:org-ql-match '(not (done))
|
2022-06-20 18:01:11 +02:00
|
|
|
|
:parent-depth nil
|
|
|
|
|
:archives nil))
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(org-update-dblock))
|
2022-05-05 22:08:02 +02:00
|
|
|
|
|
2022-05-14 11:33:31 +02:00
|
|
|
|
(org-dynamic-block-define "db/org-backlinks" #'db/org-insert-backlink-block)
|
2022-05-05 22:08:02 +02:00
|
|
|
|
|
2017-12-02 20:00:58 +01:00
|
|
|
|
|
2017-07-16 18:07:00 +02:00
|
|
|
|
;;; End
|
|
|
|
|
|
|
|
|
|
(provide 'db-org)
|
|
|
|
|
|
|
|
|
|
;;; db-org.el ends here
|