-
-
Notifications
You must be signed in to change notification settings - Fork 122
/
org-db-agenda.el
392 lines (341 loc) · 12.4 KB
/
org-db-agenda.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
;;; org-db-agenda.el --- Agenda from org-db
;;; Commentary:
(require 'org-archive)
(require 'org-db)
(require 'calendar)
(require 'color)
(defun org-db-agenda-setup ()
(with-org-db
(sqlite-execute org-db "create table if not exists agenda_ignores(
fname text)")))
(defun org-db-agenda--candidates (before-date)
"Get headings with deadlines before BEFORE-DATE
Examples:
today Due by today
+1w Due in a week
+1m Due in a month
"
(interactive)
(let* ((deadline-headings (with-org-db
(sqlite-select org-db "select
headlines.level, headlines.title, headlines.tags,
files.filename, headlines.begin,
strftime('<%Y-%m-%d %H:%M:%S>', headlines.deadline),
files.last_updated, headlines.todo_keyword, headlines.priority
from headlines
inner join files on files.rowid = headlines.filename_id
where headlines.todo_keyword = \"TODO\"
-- and headlines.archivedp is null
and headlines.deadline < date(?)
order by headlines.deadline desc
"
(list (org-format-time-string
"%Y-%m-%d %H:%M:%S"
(org-read-date t t before-date))))))
(scheduled-headings (with-org-db
(sqlite-select org-db "select
headlines.level,
format('%s (scheduled)', headlines.title),
headlines.tags,
files.filename, headlines.begin,
strftime('<%Y-%m-%d %H:%M:%S>', headlines.scheduled),
files.last_updated, headlines.todo_keyword, headlines.priority
from headlines
inner join files on files.rowid = headlines.filename_id
where headlines.todo_keyword = \"TODO\"
-- and headlines.archivedp is null
and headlines.scheduled < date(?)
order by headlines.scheduled desc
"
(list (org-format-time-string
"%Y-%m-%d %H:%M:%S"
(org-read-date t t before-date))))))
(todo-headings (with-org-db
(sqlite-select org-db "select
headlines.level, headlines.title, headlines.tags,
files.filename, headlines.begin,
null,
files.last_updated, headlines.todo_keyword, headlines.priority
from headlines
inner join files on files.rowid = headlines.filename_id
where headlines.todo_keyword = \"TODO\"
-- and headlines.archivedp is null
and headlines.scheduled is null
and headlines.deadline is null
")))
(ignores (mapcar 'car (with-org-db
(sqlite-execute org-db "select * from agenda_ignores"))))
(candidates (cl-loop for (level title tags filename begin deadline last-updated todo-keyword priority)
in (-uniq (append deadline-headings scheduled-headings
todo-headings))
when (not (member filename ignores))
collect
(cons
(format "%28s|%100s|%20s|%s|%s"
;; deadline
(s-pad-right 28 " "
(or deadline " "))
;; title
(s-pad-right 100 " " (concat (make-string
level
(string-to-char "*"))
(if priority
(format " [#%s] " priority)
" ")
todo-keyword " "
title))
(s-pad-right 20 " " (or tags ""))
filename last-updated)
(list
:file filename
:deadline deadline
:last-updated last-updated
:begin begin
:title title)))))
(sort candidates (lambda (a b)
(let ((d1 (plist-get (cdr a) :deadline))
(d2 (plist-get (cdr b) :deadline)))
(org-time< d1 d2))))))
(defun org-db-agenda-transformer (candidate)
"Add colors to candidates.
Things that are overdue are dark red, and things todo are in green.
CANDIDATE is a string, possibly with a timestamp in it."
(let* ((now (float-time (current-time)))
;; use a regexp to find the timestamp
(ts (string-match org-element--timestamp-regexp candidate))
;; if we have a timestamp, convert it to time
(es (when ts (float-time (org-timestamp-to-time
(org-timestamp-from-string
(match-string 0 candidate)))))))
(cond
((null es) candidate)
;; Make priority red
((string-match "\\[#A\\]" candidate) (propertize candidate 'face '(:foreground "red1" :weight bold)))
((string-match "scheduled" candidate) (propertize candidate 'face '(:foreground "DarkOrange3")))
;; Calendar entries are not meant to be changed
((string-match ":gcal:" candidate) (propertize candidate 'face '(:foreground "DodgerBlue3")))
((> es now) (propertize candidate 'face '(:foreground "green4")))
((< es now) (propertize candidate 'face '(:foreground "dark red"))))))
(ivy-configure 'org-db-agenda :display-transformer-fn
#'org-db-agenda-transformer)
(defun org-db-agenda--done (candidate)
"Mark the current candidate as done."
(let ((plist (cdr candidate)))
(find-file (plist-get plist :file))
(goto-char (plist-get plist :begin))
(org-todo "DONE")
(save-buffer)
(org-db-update-buffer t)))
(defun org-db-agenda--archive (candidate)
"Archive the CANDIDATE headline."
(let ((plist (cdr candidate)))
(find-file (plist-get plist :file))
(goto-char (plist-get plist :begin))
(org-archive-set-tag)
(save-buffer)
(org-db-update-buffer t)))
(defun org-db-agenda--archive-subtree (candidate)
"Archive the subtree indicated by CANDIDATE."
(let ((plist (cdr candidate)))
(find-file (plist-get plist :file))
(goto-char (plist-get plist :begin))
(org-archive-subtree)
(save-buffer)
(org-db-update-buffer t)))
(defun org-db-agenda--ignore (candidate)
"Add CANDIDATE to ignore list."
(let* ((plist (cdr candidate)))
(with-org-db
(sqlite-execute org-db "insert into agenda_ignores values(?)"
(list (plist-get plist :file))))))
(defun org-db-agenda--update (candidate)
"Update current entry"
(let* ((plist (cdr candidate))
(fname (plist-get plist :file)))
(if (file-exists-p fname)
(with-current-buffer (find-file-noselect fname)
(org-db-update-buffer t))
(org-db-remove-file fname))))
(defun org-db-agenda--remove (candidate)
(let* ((plist (cdr candidate))
(fname (plist-get plist :file)))
(org-db-remove-file fname)))
(defun org-db-agenda-marked-candidates (candidates)
(let* ((actions (cl-loop for (key cmd doc) in
(cdr (ivy-state-action ivy-last))
collect
(cons doc cmd)))
(cmd (cdr (assoc (completing-read "action: " actions) actions))))
(cl-loop for candidate in candidates do
(funcall cmd candidate))
(setq ivy-marked-candidates nil)))
(defun org-db-agenda (before)
(interactive (list (read-string "Before (e.g. +2w)" "+2w")))
(let* ((candidates (org-db-agenda--candidates before)))
(ivy-read "heading: " candidates
:caller 'org-db-agenda
:multi-action #'org-db-agenda-marked-candidates
:action
'(1
("o" org-db-headings--open "Open to heading")
("O" org-db-ogenda "open in org-agenda")
("a" (lambda (_) (call-interactively #'org-db-agenda)) "New interval")
("d" org-db-agenda--done "Mark entry done")
("v" org-db-agenda--archive "Add archive tag")
("V" org-db-agenda--archive-subtree "Archive subtree")
("i" org-db-agenda--ignore "Ignore this file")
("u" org-db-agenda--update "Update file in database")
("r" org-db-agenda--remove "Remove file")
("c" (lambda (_) (org-db-agenda-calendar-view)) "Calendar view")
("q" (lambda (_)
(org-db-process-queue t)
(call-interactively #'org-db-agenda))
"Process queue")))))
(defun scimax-all-headings-done ()
"Mark all entries in buffer as DONE."
(interactive)
(org-map-entries
(lambda ()
(when (org-get-repeat)
(org-todo -1))
(when (string= (org-get-todo-state) "TODO")
(org-todo "DONE")))))
(defun scimax-archive-todo-headings ()
"Make todo entries archived."
(interactive)
(org-map-entries
(lambda ()
(when (string= (org-get-todo-state) "TODO")
(org-archive-set-tag)))))
;; Note this did not work as well as I hoped. Maybe some things happen like
;; updating the deadline after this is done, like updating the CLOSED property.
;; It is also pretty slow to update a buffer, so it feels laggy when using it.
;; Leaving it here to remind me I tried it.
;; (defun org-db-todo-hook-fn ()
;; "Run when you change a TODO state.
;; Triggers updating the buffer so your agenda is up to date."
;; (org-db-update-buffer t))
;; (add-hook 'org-after-todo-state-change-hook 'org-db-todo-hook-fn)
;; * org-db-ogenda
;; use org-db to set `org-agenda-files' then use org-agenda
(defun org-db-ogenda (t1 t2)
(interactive (list
(org-read-date nil nil nil "First date: ")
(org-read-date nil nil nil "Second date: ")))
(let ((org-agenda-files (cl-delete-duplicates
(flatten-list (with-org-db
(sqlite-select org-db "select (files.filename) from headlines
inner join files on files.rowid = headlines.filename_id
where headlines.deadline > date(?)
and headlines.deadline < date(?)
and headlines.todo_keyword = \"TODO\""
(list t1 t2))))
:test #'equal)))
(org-agenda)))
;; * calendar view
(defun org-db-agenda-mark-calendar ()
"marks days in the calendar when there are things due"
(cl-loop for group in
(seq-group-by #'identity
(with-org-db
(sqlite-select org-db "select
strftime('%Y', headlines.deadline),
strftime('%m', headlines.deadline),
strftime('%d', headlines.deadline)
from headlines
where headlines.todo_keyword = \"TODO\"
and headlines.deadline is not null
order by headlines.deadline desc")))
collect (cons (car group) (length group))
do
(let* ((g (car group))
(year (nth 0 g))
(month (nth 1 g))
(day (nth 2 g))
(count (length group))
;; delta * 4%
(percent (* (- count 2) 4))
(color)
(d (mapcar 'string-to-number (list month day year)))
(calendar-date-echo-text (format "test %d" count)))
(when (calendar-date-is-visible-p d)
(save-excursion
(calendar-cursor-to-visible-date d)
(setq color (if (time-less-p (org-read-date nil t (string-join (car group) "-"))
(org-read-date nil t "+1w"))
(color-darken-name "red" percent)
(color-darken-name "DarkOliveGreen4" percent)))
(add-text-properties (1- (point)) (1+ (point))
`(font-lock-face '(:foreground ,color :weight bold)
help-echo (format "%s tasks" ,count))))))))
(defun org-db-agenda-calendar-view ()
"Show agenda in calendar view."
(interactive)
(let ((calendar-today-visible-hook))
(add-hook 'calendar-today-visible-hook
'org-db-agenda-mark-calendar)
;; What do we do with the selected date? This adds a day to what you
;; selected which then shows entries on that day or earlier.
;; (org-db-agenda
;; (org-format-time-string
;; "%Y-%m-%d %H:%M:%S"
;; (time-add (org-read-date t t) (* 60 60 24))))
(let* ((selection (org-read-date t t))
(entries (with-org-db
(sqlite-select org-db "select
headlines.level, headlines.title, headlines.tags,
files.filename, headlines.begin,
strftime('<%Y-%m-%d %H:%M:%S>', headlines.deadline),
files.last_updated, headlines.todo_keyword
from headlines
inner join files on files.rowid = headlines.filename_id
where headlines.todo_keyword = \"TODO\"
-- and headlines.archivedp is null
and headlines.deadline > date(?)
and headlines.deadline < date(?)
order by headlines.deadline desc
"
(list (format-time-string "%Y-%m-%d" selection)
(format-time-string "%Y-%m-%d" (time-add
selection
(* 60 60 24)))))))
(candidates (cl-loop for (level title tags filename begin deadline last-updated todo-keyword)
in entries
collect
(cons
(format "%28s|%100s|%20s|%s|%s"
(s-pad-right 28 " "
(or deadline " "))
(s-pad-right 100 " " (concat (make-string
level
(string-to-char "*"))
" "
todo-keyword " "
title))
(s-pad-right 20 " " (or tags ""))
filename last-updated)
(list
:file filename
:deadline deadline
:last-updated last-updated
:begin begin
:title title)))))
(ivy-read "Agenda: " candidates
:caller 'org-db-agenda
:action '(1
("o" org-db-headings--open "Open to heading")
("O" org-db-ogenda "open in org-agenda")
("a" (lambda (_) (call-interactively #'org-db-agenda)) "New interval")
("d" org-db-agenda--done "Mark entry done")
("v" org-db-agenda--archive "Add archive tag")
("V" org-db-agenda--archive-subtree "Archive subtree")
("i" org-db-agenda--ignore "Ignore this file")
("u" org-db-agenda--update "Update file in database")
("r" org-db-agenda--remove "Remove file")
("c" (lambda (_) (org-db-agenda-calendar-view)) "Calendar view")
("q" (lambda (_)
(org-db-process-queue t)
(call-interactively #'org-db-agenda))
"Process queue"))))))
(provide 'org-db-agenda)
;;; org-db-agenda.el ends here