/
annals.el
executable file
·1614 lines (1261 loc) · 59.1 KB
/
annals.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
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;; -*- lexical-binding: t -*-
;;; annals.el --- EMACS task based session manager and developer notebook
;; Copyright (c) Matthew O. Smith <matt@m0smith.com>
;;
;; Author:
;; Matthew Smith <matt@m0smith.com>
;; URL: http://www.github.com/m0smith/annals
;; Version: 0.0.1
;; Package-Requires: ((dash "2.12.1"))
;; Keywords: task, notebook, jira, mylyn
;;; License:
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA.
;;
;; This file is not part of GNU Emacs.
;;; Commentary:
;; See http://www.github.com/m0smith/annals/README.md
;; EMACS task based session manager and developer notebook with ideas similar to (mylyn) for eclipse.
;; When working in a task, such as a Jira issue, it would be nice to keep the state of EMACS, including non-file buffers like *shell*. EMACS desktop.el already does this. In addition, I would like to:
;; Optionally save the contents of earmuff buffers (*shell*, *grep*, etc), keeping a version per session (gh-1) (annals-buffer-name-create)
;; Manage a directory of desktops based on task name or JIRA issue id or github issue id (annals-task)
;; Integerate with org-mode task switching, clock in, clock out, etc.
;; Integerate with dir-mode by adding keystrokes to use a dir as a desktop (gh-3)
;; Create a jounal file for each task called annals.org. The name is controlled by annals-file-name-default.
;; Easily switch tasks (annals-task)
;; Allow multiple tasks to be active at the same time. Buffers can belong to one or more active tasks.
;; Of course it would rely heavily upon the built in desktop functionality.
;; Installation and Configuration
;; Clone the repo from https://github.com/m0smith/annals. The following instructions assume it is in ~/projects. Add to your .emacs:
;; (add-to-list 'load-path "~/projects/annals")
;; (load "annals")
;; (global-set-key [f6] (quote annals-task))
;; (global-set-key [C-f6] (quote annals-buffer-name-create))
;; To automatically have a type of non-file buffer associated with the current task, add annals-buffer-name-create to the mode hook like:
;; (add-hook 'sql-login-hook 'annals-buffer-name-create)
;; Basic Tasks
;; Start a new task (annals-task)
;; The user gives the task a name and it is created in a
;; subdirectory of annals-active-directory. It becomes the current
;; task and any new buffers will belong to it. Creates an
;; annals.org in the task directory. If the task id matches a Jira
;; issue or github issue, pull information from that issue into
;; the annals.org.
;; Suspend a task (annals-suspend)
;; Do the same as desktop-save and desktop-clear. In addition,
;; save off the state of interesting non-file buffers.
;; Resume a task (annals-task)
;; Do the same as desktop-read. Do not reload the non-file buffers.
;; Archive a task (annals-archive)
;; Move the task to the annals-archive-directory. If the task was active, suspend it first.
;; Save the state of active tasks and keep them all active (annals-checkpoint)
;; Same as desktop-save on all the active tasks. In addition, save
;; the associated non-file buffers. Running annals-task without
;; changing the task will also perform a checkpoint.
;; Associate a non-file buffer to be saved as part of the annal (annals-buffer-name-create)
;; Dired Mode Integration
;; A minor mode exists for for the active directory and the archive directory to manage the tasks.
;; When in dired-mode for the annals-active-directory (default
;; ~/annals), a new minor mode that adds some annals functionality
;; with the following bindings:
;; |a - annals-dired-task Activate the task on the current line
;; |z - annals-dired-archive Archive the task on the current line
;; |i - annals-dired-info Display the summary info for the current task
;; When in dired-mode for the annals-archive-directory (default
;; ~/annals/.archive), a new minor mode that adds some annals
;; functionality with the following bindings:
;; |z - annals-dired-unarchive Unarchive the task on the current line
;; |i - annals-dired-info Display the summary info for the current task
;; Hooks
;; annals-task-hook Run after the task has been initialized or
;; switched. The current task id will be in the variable
;; annals-active-task-id.
;; annals-create-file-hook Run when the annals.org file needs to be
;; created for a task. The function should accept 2 parameters:
;; task-id and file-name and return the file-name or nil if it did not
;; create the file. The file file-name will not exist when the
;; function is called. The functions in the list will be called until
;; one returns non-nil, meaning it actually created a file.
;; Jira Integration
;; If the task id looks like a Jira ID (letters-digits) and
;; annals-jira-server is set to the URL of a jira server, then
;; annals.org will have a link to the Jira issue and will also pull in
;; the issue summary.
;; Github Integration
;; If the task id looks like a Github ID (repo-project-digits like
;; m0smith/annals/gh-1) and annals-github-api-server is set to the URL of
;; the (Github API server), then annals.org will have a link to the
;; Github issue and will also pull in the issue summary.
;;
;;; Customization:
(require 'desktop)
(require 'find-lisp)
(require 'org-capture)
(require 'json)
(require 'dash)
(require 'cl)
(require 'org-attach)
(require 'org-clock)
(defgroup annals nil
"EMACS task based session manager and developer notebook"
:prefix "annals-"
:group 'tools
:link '(url-link :tag "Github" "https://github.com/m0smith/annals/"))
(defcustom annals-keymap-prefix nil
"Annals keymap prefix."
:group 'annals
:type 'string)
(defcustom annals-active-tag "annals#active"
"The tag that marks a headline as part of annals"
:group 'annals
:package-version '(annals . "1.0")
:type 'string)
(defcustom annals-active-directory (expand-file-name "~/annals")
"Directory where all the active tasks live"
:group 'annals
:package-version '(annals . "1.0")
:type 'directory)
(defcustom annals-jira-issue-directory (expand-file-name "Issues/Jira/" annals-active-directory)
"Directory where all new Jira issue org files are made."
:group 'annals
:package-version '(annals . "1.0")
:type 'directory)
(defcustom annals-archive-directory (expand-file-name "~/annals/.archive")
"Directory where all the archived tasks live"
:group 'annals
:package-version '(annals . "1.0")
:type 'directory)
(defcustom annals-jira-server nil
"The URL for the JIRA server or nil if it is not used"
:group 'annals
:package-version '(annals . "1.0")
:type '(choice (const :tag "Disabled" nil)
(string :tag "URL")))
(defcustom annals-github-api-server "https://api.github.com"
"The URL for the Github API server or nil if it is not used"
:group 'annals
:package-version '(annals . "1.0")
:type '(choice (const :tag "Disabled" nil)
(string :tag "URL")))
(defcustom annals-github-browser-server "https://github.com"
"The URL for the Github browser or nil if it is not used"
:group 'annals
:package-version '(annals . "1.0")
:type '(choice (const :tag "Disabled" nil)
(string :tag "URL")))
(defcustom annals-github-task-separator "/"
"Separator used in task-id to separator repo, project, and
issue id. For example, if the annals-github-task-separator
were set to \".\" then the task id for the first issue of the
annals project would be \"m0smith.annals.1\"."
:group 'annals
:package-version '(annals . "1.0")
:type 'string)
(defcustom annals-create-file-hook (list 'annals-jira-create-file 'annals-github-create-file 'annals-default-create-file)
"A list of functions to call to create the annals.org. The
function should accept 2 parameters: task-id and file-name and
return the file-name or nil if it did not create the file. The
file file-name will not exist when the function is called.
The functions in the list will be called until one returns non-nil, meaning it actually created a file."
:group 'annals
:package-version '(annals . "1.0")
:type 'hook)
(defcustom annals-task-template-create-hook (list 'annals-jira-create-template 'annals-github-create-template )
"A list of funtions to call to create a new template based on task-id"
:group 'annals
:package-version '(annals . "1.0"))
(defcustom annals-ics2org-exec (expand-file-name "~/bin/ics2org")
""
:group 'annals
:package-version '(annals . "1.0")
:type '(file :must-match t))
(defvar annals-active-task-id nil
"The currently active task id")
(defvar annals-session-stamp nil
"The session name. Just set each time a task is started.")
(defvar-local annals-buffer-name nil
"A buffer local variable to control inclusion of non-file
buffers in an annal. If this is non-nil, it will mark a buffer
for saving to this name when `annals-checkpoint' is called.")
(defvar annals-buffer-name-counter 1)
(eval-after-load "desktop"
'(progn
(add-to-list 'desktop-globals-to-save 'annals-buffer-name-counter)))
;;; Code:
(defun annals-file-name-default (_task-id)
"The name of the task note file."
"annals.org")
(defun annals-deactivate-task ()
(interactive)
(desktop-save (org-attach-dir) t))
(defun annals-desktop-ignore-buffers ()
(add-to-list 'desktop-clear-preserve-buffers (buffer-name))
(mapcar (lambda (m) (add-to-list 'desktop-clear-preserve-buffers
(buffer-name (marker-buffer m))))
org-clock-history))
(defun annals-activate-task ()
:PROPERTIES:
:ID: d6f63c69-dcf5-4d4c-87ab-a0bb0746cebc
:END:
(interactive)
(let ((dir (org-attach-dir t))
(desktop-clear-preserve-buffers desktop-clear-preserve-buffers))
(annals-desktop-ignore-buffers)
(when dir
(org-clock-history-push)
(desktop-change-dir dir)
(unless desktop-save-mode
(desktop-save-mode)))))
(defun annals-json-call (url &optional method data headers)
"Call a URL expecting JSON back. Return the JSON formatted as vectors and alists for the arrays and maps.
URL is the REST URL to call."
(setq url-request-method (or method "GET")
url-request-extra-headers headers
url-request-data data)
(with-current-buffer (url-retrieve-synchronously url)
(goto-char url-http-end-of-headers)
(setq json-array-type 'vector
json-object-type 'alist)
(let* ((readtable nil)
(json-readtable-old (when readtable
(let ((r json-readtable))
(setq json-readtable readtable)
r)))
(rtnval (json-read)))
(kill-buffer (current-buffer))
(when readtable (setq json-readtable json-readtable-old))
rtnval)))
(defun annals-task-summary (task-id task-dir)
"Given a task dir, extract the summary from the first line of the annals.org"
(let ((file-name (expand-file-name (annals-file-name-default task-id) task-dir)))
(when (file-readable-p file-name)
(with-temp-buffer
(insert-file-contents (expand-file-name (annals-file-name-default task-id) task-dir) nil 0 150 t)
(let ((start (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point))))
(goto-char start)
(re-search-forward "[*] *" end t) ;; Skip a leading star(*)
(re-search-forward "#[+][A-Za-z_]+: *" end t) ;; skip org mode stuff
(if (re-search-forward "]] *" end t)
(concat task-id " " (buffer-substring (point) end))
(buffer-substring (point) end)))))))
(defun annals-list-tasks ()
"Return an alist of task summary to task id. See `annals-task-summary' for how the summary is created"
(let ((task-ids (directory-files annals-active-directory nil "^[^.]"))
(task-dirs (directory-files annals-active-directory t "^[^.]")))
(mapcar (lambda (i) (cons (annals-task-summary (car i) (cdr i)) (car i))) (-zip task-ids task-dirs))))
;;;
;;; JIRA
;;
(defun annals-jira-rest-url (issue-id)
(when (and annals-jira-server (string-match "^[A-Z]+-[0-9]+$" issue-id))
(format "%s/rest/api/latest/issue/%s" annals-jira-server issue-id)))
(defun annals-jira-browse-url (issue-id)
(when (and annals-jira-server (string-match "^[A-Z]+-[0-9]+$" issue-id))
(format "%s/browse/%s" annals-jira-server issue-id)))
(defvar annals-jira-id-property-name "ANNALS_JIRA_ID")
(defun annals-jira-add-id-property (issue-id)
(org-set-property annals-jira-id-property-name issue-id))
(defun annals-github-add-id-property (issue-id)
(org-set-property annals-github-id-property-name issue-id))
(defun annals-jira (issue-id)
(setq
url-http-extra-headers nil
)
(-when-let (url (annals-jira-rest-url issue-id))
(unless (url-get-authentication url nil 'any t)
(url-basic-auth (url-generic-parse-url url) t))
(annals-json-call url)))
(defun annals-jira-attribute (issue-or-id &rest keys)
" ISSUE-OR-ID can either be a string Jira ID like \"ABC-123\" or the result of calling `annals-jira'"
(when annals-jira-server
(let ((jira-issue (if (stringp issue-or-id) (annals-jira issue-or-id) issue-or-id)))
(-reduce-from (lambda (map key) (cdr (assoc key map))) jira-issue keys))))
(defun annals-jira-summary (issue-or-id)
" ISSUE-OR-ID can either be a string Jira ID like \"ABC-123\" or the result of calling `annals-jira'"
(annals-jira-attribute issue-or-id 'fields 'summary))
(defun annals-jira-self (issue-or-id)
" ISSUE-OR-ID can either be a string Jira ID like \"ABC-123\" or the result of calling `annals-jira'"
(annals-jira-attribute issue-or-id 'self))
(defun annals-jira-create-file (task-id file-name)
"Create the note file for the task. Pull information from Jira
if TASK-ID is a Jira issue-id. Return FILE-NAME if there is a
Jira issue or nil."
(let* ((jira-issue (annals-jira task-id))
(jira-summary (annals-jira-summary jira-issue))
(title (when jira-summary
(format "#+TITLE: %s %s \n\n* [[%s][%s]] %s\n\n" task-id jira-summary
(annals-jira-browse-url task-id) task-id jira-summary) )))
(when title
(write-region title "" file-name)
file-name)))
(defun annals-jira-create-template (task-id)
"Create the note file for the task. Pull information from Jira
if TASK-ID is a Jira issue-id. Return FILE-NAME if there is a
Jira issue or nil."
(let* ((jira-issue (annals-jira task-id))
(jira-summary (annals-jira-summary jira-issue))
(title (when jira-summary
(format "* TASK [[%s][%s]] %s\n\n :PROPERTIES:\n :%s: %s\n :ATTACH_DIR: %s\n :ATTACH_DIR_INHERIT: t\n :END: \n\n"
(annals-jira-browse-url task-id)
task-id
jira-summary
annals-jira-id-property-name
task-id
task-id))))
(when title title)))
;;;
;;; Github
;;;
(defun annals-github-format ( pattern url issue-id)
(let ((r-pat (format "^\\([a-zA-Z0-9-]+\\)%s\\([-0-9a-zA-Z]+\\)%sgh-\\([0-9]+\\)$"
annals-github-task-separator
annals-github-task-separator)))
(when (string-match r-pat issue-id)
(format pattern url (match-string 1 issue-id)
(match-string 2 issue-id)
(match-string 3 issue-id)))))
(defun annals-github-rest-url (issue-id)
"Looks like https://api.github.com/repos/m0smith/malabar-mode/issues/134"
(when annals-github-api-server
(annals-github-format "%s/repos/%s/%s/issues/%s" annals-github-api-server issue-id)))
(defun annals-github-browse-url (issue-id)
"Looks like https://github.com/jdee-emacs/jdee/issues/83"
(when annals-github-browser-server
(annals-github-format "%s/%s/%s/issues/%s" annals-github-browser-server issue-id)))
(defun annals-github (issue-id)
"Pull the JSON info for the github issue."
(-when-let (url (annals-github-rest-url issue-id))
(unless (url-get-authentication url nil 'any t)
(url-basic-auth (url-generic-parse-url url) t))
(annals-json-call url)))
(defvar annals-github-id-property-name "ANNALS_GITHUB_ID")
(defun annals-github-create-file-template (task-id)
"Return a template for a Github issue"
(let* ((github-issue (annals-github task-id))
(github-summary (annals-jira-attribute github-issue 'title))
(github-url (annals-jira-attribute github-issue 'html_url))
(title (when github-summary
(format "#+TITLE: %s %s \n\n* [[%s][%s]] %s\n\n :PROPERTIES:\n :%s: %s\n :ATTACH_DIR: %s\n :ATTACH_DIR_INHERIT: t\n :END: \n\n"
task-id
github-summary
github-url
task-id
github-summary
annals-github-id-property-name
task-id
task-id) )))
(when title
(format "%s" title))))
(defun annals-github-create-template (task-id)
"Return a template for a Github issue"
(let* ((github-issue (annals-github task-id))
(github-summary (annals-jira-attribute github-issue 'title))
(github-url (annals-jira-attribute github-issue 'html_url))
(title (when github-summary
(format "* TASK [[%s][%s]] %s\n\n" github-url task-id github-summary) )))
(when title title)))
(defun annals-github-create-file (task-id file-name)
"Create the note file for the task. Pull information from Jira if TASK-ID is a Jira issue-id. Return FILE-NAME if there is a Jira issue or nil."
(let* ((github-issue (annals-github task-id))
(github-summary (annals-jira-attribute github-issue 'title))
(github-url (annals-jira-attribute github-issue 'html_url))
(title (when github-summary
(format "#+TITLE: %s %s \n\n* [[%s][%s]] %s\n\n" task-id github-summary
github-url task-id github-summary) )))
(when title
(write-region title "" file-name)
file-name)))
(defun annals-task-id-from-dir (full-name)
(let ((desktop-full-name (desktop-full-file-name full-name)))
(when (file-readable-p desktop-full-name)
(file-name-nondirectory (directory-file-name full-name)))))
;;;
;;; dired minor mode
;;;
(defun annals-dired-task ()
"In Dired, make the thing at point the active task, if it is a task."
(interactive)
(let* ((full-name (dired-file-name-at-point))
(desktop-full-name (desktop-full-file-name full-name)))
(if (file-readable-p desktop-full-name)
(annals-task (file-name-nondirectory (directory-file-name full-name)))
(message "Not an annals dir"))))
(defun annals-dired-archive ()
"In Dired, archive the thing at point, if it is a task."
(interactive)
(let* ((full-name (dired-file-name-at-point))
(desktop-full-name (desktop-full-file-name full-name)))
(if (file-readable-p desktop-full-name)
(annals-archive (file-name-nondirectory (directory-file-name full-name)))
(message "Not an annals dir"))))
(defun annals-dired-info ()
"Show a short description of the task."
(interactive)
(let* ((task-id (annals-task-id-from-dir (dired-file-name-at-point)))
(tasks-alist (annals-list-tasks))
(entry (rassoc task-id tasks-alist)))
(when entry (message "%s" (car entry)))))
(defun annals-dired-unarchive ()
"Move the task to the active directory."
(interactive)
(let* ((task-id (annals-task-id-from-dir (dired-file-name-at-point))))
(annals-unarchive task-id)))
(define-minor-mode annals-dired-mode
"Toggle Annals-Dired mode.
Interactively with no argument, this command toggles the mode.
A positive prefix argument enables the mode, any other prefix
argument disables it. From Lisp, argument omitted or nil enables
the mode, `toggle' toggles the state.
When Annals-Dired mode is enabled, the control delete key
gobbles all preceding whitespace except the last.
See the command \\[annals-dired-task]."
;; The initial value.
nil
;; The indicator for the mode line.
""
;; The minor mode bindings.
'(
((kbd "|a") . annals-dired-task)
((kbd "|z") . annals-dired-archive)
((kbd "|i") . annals-dired-info)
((kbd "|^") . annals-browse-file-directory)
)
:group 'annals)
(define-minor-mode annals-dired-archive-mode
"Toggle Annals-Dired-Archive mode.
Interactively with no argument, this command toggles the mode.
A positive prefix argument enables the mode, any other prefix
argument disables it. From Lisp, argument omitted or nil enables
the mode, `toggle' toggles the state.
When Annals-Dired mode is enabled, the control delete key
gobbles all preceding whitespace except the last.
See the command \\[annals-dired-unarchive]."
;; The initial value.
nil
;; The indicator for the mode line.
""
;; The minor mode bindings.
'(
((kbd "|z") . annals-dired-unarchive)
((kbd "|i") . annals-dired-info)
)
:group 'annals)
(defun annals-dired-mode-activate ()
"Hook run as part of `dired-mode-hook' to activate `annals-dired-mode' for the annals directory."
(when (annals-compare-directories default-directory annals-active-directory)
(annals-dired-mode)))
(defun annals-dired-archive-mode-activate ()
"Hook run as part of `dired-mode-hook' to activate `annals-dired-archvie-mode' for the annals directory."
(when (annals-compare-directories default-directory annals-archive-directory)
(annals-dired-archive-mode)))
(eval-after-load 'dired
'(progn
(add-hook 'dired-mode-hook 'annals-dired-mode-activate)
(add-hook 'dired-mode-hook 'annals-dired-archive-mode-activate)))
(defun annals-default-create-file (task-id file-name)
(when task-id
(write-region (format "#+TITLE: %s \n\n* %s\n\n" task-id task-id) "" file-name)
file-name))
(defun annals-read-task-id ()
"Prompts users for a task from the available tasks or allows the
user to enter a new task id"
(let* ((tasks (annals-list-tasks))
;(def (car (rassoc annals-active-task-id tasks)))
(prompt (format "Annals Task Id (default: %s): " annals-active-task-id))
(key (completing-read prompt tasks nil 'confirm))
(val (cdr (assoc key tasks))))
(or val (if (= 0 (length key)) annals-active-task-id key))))
(defun annals-task-directory (task-id)
"Return the directory associated with a task. Should be equivilent to `desktop-dirname', but not necessarily equal to the `annals-active-task-id' when TASK-ID is the active task"
(let* ((full-dir (expand-file-name task-id annals-active-directory)))
full-dir))
(defun annals-write-non-file-buffer (task-id buffer)
(with-current-buffer buffer
(when (and annals-buffer-name annals-session-stamp)
(let* ((file-name (format "%s-%s" annals-buffer-name annals-session-stamp))
(full-name (expand-file-name file-name (annals-task-directory task-id))))
(write-region (format "%s -*- mode: %s ; -*- %s\n"
(or comment-start "")
mode-name
(or comment-end ""))
nil full-name)
(write-region nil nil full-name t)))))
(defun annals-write-non-file-buffers ()
(when annals-active-task-id
(mapcar (lambda (b) (annals-write-non-file-buffer annals-active-task-id b)) (buffer-list))))
(defun annals-buffer-name-counter-next ()
(let ((rtnval annals-buffer-name-counter))
(setq annals-buffer-name-counter (+ 1 annals-buffer-name-counter))
; (add-dir-local-variable nil "annals-buffer-name-counter
rtnval))
;;;###autoload
(defun annals-buffer-name-create (&optional buffer)
"Add the buffer local variable `annals-buffer-name' to BUFFER, default to
the current buffer.
Called interactively applies to the current buffer.
Called in a buffer that already has `annals-buffer-name' set,
will give it a new name. This allows the user to keep the old
version and start building a new version.
Use this function in a hook to add the `annals-buffer-name' to
a buffer. Only appropriate for non-file buffers. File buffers
are already handled.
Example:
(add-hook 'sql-login-hook 'annals-buffer-name-create)
"
(interactive)
(with-current-buffer (or buffer (current-buffer))
(setq annals-buffer-name
(format "%s.%d"
(replace-regexp-in-string "[*]\\|#[+]TITLE:" ""
(replace-regexp-in-string "[: ]" "-" (buffer-name)))
(annals-buffer-name-counter-next)))))
(defun annals-compare-directories (d1 d2)
"Check 2 directories for equality. They are equal when they
expand to the same directory. Logically, a file created in D1
will be visible in D2."
(string= (file-name-as-directory d1)
(file-name-as-directory d2)))
;;;###autoload
(defun annals-task (task-id)
"Start a new task is TASK-ID as the `desktop-dirname'. This closes
open buffers and saves the active desktop.
It also creates and opens a note file file to keep notes in. If
TASK-ID is a Jira task \"ABC-123\" and `annals-jira-server' is
not null, then the note file will default to a link to the issue and its summary.
If the currently active task is selected, simply call `annals-checkpoint'.
"
(interactive (list (annals-read-task-id)))
(annals-checkpoint)
(let* ((full-dir (expand-file-name task-id annals-active-directory))
(desktop-save-mode t)
(annal-file (expand-file-name (annals-file-name-default task-id) full-dir)))
(unless (and (boundp 'desktop-dirname) desktop-dirname full-dir
(annals-compare-directories desktop-dirname full-dir))
(annals-suspend)
(unless (file-directory-p full-dir)
(make-directory full-dir t))
(ignore-errors
(desktop-read full-dir))
(setq annals-active-task-id task-id
annals-session-stamp (format-time-string "%Y-%m-%d"))
(unless (file-regular-p annal-file)
(run-hook-with-args-until-success 'annals-create-file-hook task-id annal-file))
(find-file-other-window annal-file)
(run-hooks 'annals-task-hook)
(find-file-other-window full-dir))))
(defvar annals-task-template-history nil)
(defvar annals-project-choose-new-task-annal-task-id nil
"A place holder for task-id when creating a new task project.")
;;;###autoload
(defun annals-task-template ()
"Return the template for the given task."
(interactive)
(let ((task-id (or annals-project-choose-new-task-annal-task-id
(read-from-minibuffer "Task: " nil nil nil 'annals-task-template-history))))
(setq annals-project-choose-new-task-annal-task-id task-id)
(run-hook-with-args-until-success 'annals-task-template-create-hook task-id)))
(defun annals-buffers-with-mode (mode)
"Return a list of all buffers matching mode"
(cl-loop for buf being the buffers
when (with-current-buffer buf (eq major-mode mode))
collect buf))
(defun annals-tag-agenda-buffer-p (buf tag)
"Return true if the buffer BUF was a search for TAG"
(with-current-buffer buf
(save-excursion
(let ((type (get-text-property (point-min) 'org-agenda-type))
(args (get-text-property (point-min) 'org-last-args)))
(when (and (eq type 'tags)
(string= (cadr args) tag))
buf)))))
(defun annals-property-markers (prop &optional buf)
"Rerturn a list of markers where PROP is a test property in BUF."
(interactive)
(let ((buf (or buf (current-buffer)))
(p (point-min))
(rtnval nil))
(setq p (next-single-property-change p prop buf))
(while p
(let ((mk (get-text-property p prop buf)))
(when mk
(add-to-list 'rtnval mk)))
(setq p (next-single-property-change p prop buf)))
rtnval))
(defun annals-add-active-to-clock-history ()
"Add the active tags to the clock history."
(interactive)
(save-current-buffer
(org-tags-view t annals-active-tag)
(let ((buf (cl-loop for buf in (annals-buffers-with-mode 'org-agenda-mode)
when (annals-tag-agenda-buffer-p buf annals-active-tag)
return buf)))
(when buf
(dolist (m (annals-property-markers 'org-hd-marker))
(org-clock-history-push (marker-position m) (marker-buffer m)))))))
(defun annals-activate ()
(interactive)
(org-toggle-tag annals-active-tag 'on))
(defun annals-deactivate ()
(interactive)
(org-toggle-tag annals-active-tag 'off))
;;;###autoload
(defun annals-archive (task-id)
"Archive task is TASK-ID. If the current task is the one being
archived, closes open buffers and saves the active desktop before .
It also moves the task to the archive dir `annals-archive-directory'.
"
(interactive (list (annals-read-task-id)))
(if (and (stringp task-id) (string= task-id annals-active-task-id))
(annals-suspend)
(annals-checkpoint))
(make-directory (expand-file-name annals-archive-directory) t)
(rename-file (expand-file-name task-id annals-active-directory)
(expand-file-name task-id annals-archive-directory)))
(defun annals-unarchive (task-id)
"Restore task id TASK-ID. It moves the task to the active dir `annals-active-directory'."
(annals-checkpoint)
(rename-file (expand-file-name task-id annals-archive-directory)
(expand-file-name task-id annals-active-directory)))
(defun annals-checkpoint ()
"Save the current state and keep it active"
(interactive)
(if (and (boundp 'desktop-dirname) desktop-dirname)
(progn
(desktop-save-in-desktop-dir)
(annals-write-non-file-buffers))
(message "annals is not active")))
(defun annals-suspend ()
"Save the active desktop and turn off the annals feature."
(interactive)
(annals-checkpoint)
(when (and (boundp 'desktop-dirname) desktop-dirname)
;(desktop-save desktop-dirname t)
(desktop-clear)
(setq annals-active-task-id nil
annals-session-stamp nil
annals-buffer-name-counter 1
desktop-dirname nil)))
;;;###autoload
(defun annals-browse-file-directory ()
"Open the current file's directory however the OS would."
(interactive)
(if default-directory
(browse-url-of-file (expand-file-name default-directory))
(error "No `default-directory' to open")))
;;;###autoload
(defun annals-agenda ()
"Go through all the annals and find all the active TODO items (`org-todo-kggeywords`)."
(interactive)
(make-local-variable 'org-agenda-files)
(let ((org-agenda-files* (find-lisp-find-files annals-active-directory "\\.org$")))
(setq org-agenda-files org-agenda-files*)
(org-todo-list)
(setq org-agenda-files org-agenda-files*)))
;;;###autoload
(defun annals-gnus-group-old (&optional dir)
"DEPrACATED: Go through the annals and make a gnus group"
(interactive)
(let ((project-dir (or dir (annals-project-choose))))
(gnus 1 t)
(let ((eml-files (find-lisp-find-files project-dir "\\.eml$")))
(mapc #'(lambda (x) (gnus-group-make-doc-group x nil)) eml-files))))
(defun annals-gnus-eml ()
"Open an EML file in a GNUS buffer"
(let* ((eml-file (buffer-file-name))
(nname (format "nndoc+%s:%s" eml-file (buffer-name)))
(eml-buffer (current-buffer)))
(gnus 1 t)
(unless (gnus-group-entry nname)
(gnus-group-make-doc-group eml-file nil))
(gnus-group-read-group nil t nname)
(kill-buffer eml-buffer)))
(defun annals-capture ()
"Use the `org-capture` function to add a note to the chosen project file"
(interactive)
(let* ((project-dir (annals-project-choose))
(org-default-notes-file (expand-file-name "annals.org" project-dir)))
(org-capture)))
(defun annals-add-meeting-template (annals-file template template-alist)
(cons (list "x" "Meeting from ICS" 'entry
(list 'file+headline annals-file "Meetings")
template) template-alist))
(defun annals-project-dirs (&optional dir)
"Return the list of project directories, relative to the directory. DIR defaults to `annals-active-directory`"
(let (( annals-dirs (find-lisp-find-files-internal (or dir annals-active-directory)
'find-lisp-file-predicate-is-directory
'find-lisp-default-directory-predicate)))
(-filter (lambda (d) (not (string-match "/[.]git" d))) annals-dirs)))
(defun annals-concat (list-of-strings &optional seperator)
"Take a LIST-OF-STRINGS and create a single string. Place SEPERATOR in between each element."
(if seperator
(apply 'concat (-interpose seperator list-of-strings))
(apply 'concat list-of-strings)))
(defvar annals-project-choose-history nil)
(defun annals-project-choose (&optional dir)
"Give the user a list of projects in DIR (default to
`annals-active-directory') and return the folder for the selected
project"
(let* ((project-dir (or dir annals-active-directory))
(current-dir (expand-file-name (file-name-as-directory default-directory)))
(projects (mapcar (lambda (d)
(let (( def (when (string-equal (expand-file-name (file-name-as-directory d)) current-dir) :default)))
(-> (file-relative-name d project-dir)
(split-string "/")
reverse
(annals-concat "-")
(list d def))))
(annals-project-dirs project-dir)))
(defaults (mapcar 'first (-filter (lambda (p) (eq :default (nth 2 p))) projects)))
(default (or (first defaults) (first (assoc (first annals-project-choose-history) projects))))
(prompt (if default (format "Select Project (default: %s): " default) "Select Project: "))
(choice (completing-read prompt projects nil t nil 'annals-project-choose-history default)))
(second (assoc (or choice default) projects))))
(defun annals-project-dired (project-dir)
"Open the project directory in dired."
(interactive (list (annals-project-choose)))
(dired project-dir))
(defun annals-project-choose-annal ()
"Allow the user to select an annals.org file"
(expand-file-name "annals.org" (annals-project-choose)))
(defun annals-project-choose-new-task-annal ()
"Allow the user to select a new project. Create the directory
and the org file"
(let* ((task-id (or annals-project-choose-new-task-annal-task-id (read-from-minibuffer "Task ID: ")))
(insert-default-directory t)
(issue-file (format "%s.org" task-id))
(rtnval (expand-file-name
(read-file-name "Create file:" annals-jira-issue-directory
nil nil issue-file)))
(new-project (file-name-directory rtnval)))
(make-directory new-project t)
(write-region "" nil rtnval)
(if annals-project-choose-new-task-annal-task-id
(setq annals-project-choose-new-task-annal-task-id task-id)
(setq annals-project-choose-new-task-annal-task-id nil))
rtnval))
(defun annals-update-org-capture-templates(entry)
"Add ENTRY to `org-capture-templates' if the key (car entry) is not already in the list. If it is, replace it."
(let ((existing (assoc (car entry) org-capture-templates)))
(if existing
(setcdr existing (cdr entry))
(add-to-list 'org-capture-templates entry))
org-capture-templates))
(defun annals-capture-templates-setup ( )
"Add the annals templates to the `org-capture-templates'."
(interactive)
(annals-update-org-capture-templates '("t" "Todo into default notes file" entry
(file+headline nil "Tasks")
"* TODO %?\n %i\n %a"))
(annals-update-org-capture-templates '("c" "Meeting from ICS" entry
(file+headline annals-project-choose-annal "Meetings")
(function annals-capture-ics-parse))) ;;annals-capture-ics-template)))
(annals-update-org-capture-templates '("a" "Annals templates"))
(annals-update-org-capture-templates '("at" "Todo into a project" entry
(file+headline annals-project-choose-annal "Tasks")
"* TODO %?\n %i\n %a"))
(annals-update-org-capture-templates '("ai" "Annals Task/Issue to existing project" entry
(file+headline annals-project-choose-annal "Issues")
(function annals-task-template)))
(annals-update-org-capture-templates '("aI" "Annals Task/Issue as a new org file" entry
(file annals-project-choose-new-task-annal)
(function annals-task-template))))
(defun annals-capture-ics-attendee ()
"Parse the ATTENDEE line and return a string [[email][name]]"
(interactive)
(save-excursion
(let* ((bol (progn (forward-line 0) (point)))
(eol (progn (end-of-line) (point)))
(line (replace-regexp-in-string "[\n\r]$" "" (buffer-substring-no-properties bol eol)))
(parts (split-string line ";"))