forked from bastibe/org-journal
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathorg-journal.el
1276 lines (1124 loc) · 53.8 KB
/
org-journal.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
;;; org-journal.el --- a simple org-mode based journaling mode -*- lexical-binding: t; -*-
;; Author: Bastian Bechtold
;; URL: http://github.com/bastibe/org-journal
;; Version: 1.15.1
;; Package-Requires: ((emacs "25.1"))
;;; Commentary:
;; Adapted from http://www.emacswiki.org/PersonalDiary
;; Functions to maintain a simple personal diary / journal in Emacs.
;; Feel free to use, modify and improve the code! - mtvoid, bastibe
;; This file is also available from marmalade as
;; http://marmalade-repo.org/packages/journal. After installing, add
;; the line (require 'org-journal) to your .emacs or init.el to activate
;; it. You also need to specify the directory where your journal files
;; will be saved. You can do this by setting the variable journal-dir
;; (remember to add a trailing slash). journal-dir is also a
;; customizable variable. The default value for journal-dir is
;; ~/Documents/journal/.
;;
;; Inside the journal directory, a separate file is created for each
;; day with a journal entry, with a file name in the format YYYYMMDD
;; (this is customizable). Each journal entry is an org-mode file that
;; begins with a date entry on the top, followed by entries for a
;; different times. Any subsequent entries on the same day are written
;; in the same file, with their own timestamp. You can customize the
;; date and time formats (or remove them entirely). To start writing a
;; journal entry, press "C-c C-j". You can also open the current day's
;; entry without adding a new entry with "C-u C-c C-j".
;;
;; You can browse through existing journal entries on disk via the
;; calendar. All dates for which an entry is present are highlighted.
;; Pressing "j" will open it up for viewing. Pressing "C-j" will open
;; it for viewing, but not switch to it. Pressing "[" or "]" will
;; select the date with the previous or next journal entry,
;; respectively. Pressing "i j" will create a new entry for the chosen
;; date.
;;
;; TODO items from the previous day will carry over to the current
;; day. This is customizable through org-journal-carryover-items.
;;
;; Quick summary:
;; To create a new journal entry for the current time and day: C-c C-j
;; To open today's journal without creating a new entry: C-u C-c C-j
;; In calendar view: j to view an entry in a new buffer
;; C-j to view an entry but not switch to it
;; i j to add a new entry
;; f w to search all entries of the current week
;; f m to search all entries of the current month
;; f y to search all entries of the current year
;; f f to search all entries of all time
;; f F to search all entries in the future
;; [ to go to previous entry
;; ] to go to next entry
;; When viewing a journal entry: C-c C-b to view previous entry
;; C-c C-f to view next entry
;;; Code:
(require 'org)
(require 'cal-iso)
(require 'org-crypt nil 'noerror)
(require 'seq)
(when (version< org-version "9.2")
(defalias 'org-set-tags-to 'org-set-tags))
(defvar org-journal-file-pattern
(expand-file-name "~/Documents/journal/\\(?1:[0-9]\\{4\\}\\)\\(?2:[0-9][0-9]\\)\\(?3:[0-9][0-9]\\)\\'")
"This matches journal files in your journal directory.
This variable is created and updated automatically by
org-journal. Use `org-journal-file-format' instead.")
;; use this function to update auto-mode-alist whenever
;; org-journal-dir or org-journal-file-pattern change.
;;;###autoload
(defun org-journal-update-auto-mode-alist ()
"Update `auto-mode-alist' to open journal files in `org-journal-mode'."
(add-to-list 'auto-mode-alist
(cons org-journal-file-pattern 'org-journal-mode)))
;;;###autoload
(add-hook 'org-mode-hook 'org-journal-update-auto-mode-alist)
(add-hook 'org-agenda-mode-hook 'org-journal-update-org-agenda-files)
;;;###autoload
(defun org-journal-dir-and-format->regex (dir format)
"Update `org-journal-file-pattern' with the current `org-journal-file-format'."
(concat
(file-truename (expand-file-name (file-name-as-directory dir)))
(replace-regexp-in-string
"%d" "\\\\(?3:[0-9][0-9]\\\\)"
(replace-regexp-in-string
"%m" "\\\\(?2:[0-9][0-9]\\\\)"
(replace-regexp-in-string
"%Y" "\\\\(?1:[0-9]\\\\{4\\\\}\\\\)" format)))
"\\(\\.gpg\\)?\\'"))
; Customizable variables
(defgroup org-journal nil
"Settings for the personal journal"
:version "1.15.1"
:group 'applications)
(defface org-journal-highlight
'((t (:foreground "#ff1493")))
"Face for highlighting org-journal buffers.")
(defun org-journal-highlight (str)
"Highlight STR in current-buffer"
(goto-char (point-min))
(while (search-forward str nil t)
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-face 'org-journal-highlight)))
(defface org-journal-calendar-entry-face
'((t (:foreground "#aa0000" :slant italic)))
"Face for highlighting org-journal entries in M-x calendar.")
(defface org-journal-calendar-scheduled-face
'((t (:foreground "#600000" :slant italic)))
"Face for highlighting future org-journal entries in M-x calendar.")
(defcustom org-journal-file-type 'daily
"What type of journal file to create."
:type '(choice
(const :tag "Daily" daily)
(const :tag "Weekly" weekly)
(const :tag "Monthly" monthly)
(const :tag "Yearly" yearly)))
(defcustom org-journal-dir "~/Documents/journal/"
"Directory containing journal entries.
Setting this will update the internal `org-journal-file-pattern' to a regex
that matches the directory, using `org-journal-dir-and-format->regex', and
update `auto-mode-alist' using `org-journal-update-auto-mode-alist'."
:type 'string
:set (lambda (symbol value)
(set-default symbol value)
;; if org-journal-file-format is not yet bound, we’ll need a default value
(let ((format (if (boundp 'org-journal-file-format)
org-journal-file-format
"%Y%m%d")))
(setq org-journal-file-pattern
(org-journal-dir-and-format->regex value format)))
(org-journal-update-auto-mode-alist)))
(defcustom org-journal-file-format "%Y%m%d"
"Format string for journal file names (Default \"YYYYMMDD\").
This pattern must include `%Y', `%m' and `%d'. Setting this will update the internal
`org-journal-file-pattern' to a regex that matches the format string, using
`org-journal-dir-and-format->regex', and update `auto-mode-alist' using
`org-journal-update-auto-mode-alist'."
:type 'string
:set (lambda (symbol value)
(set-default symbol value)
;; If org-journal-dir is not yet bound, we’ll need a default value
(let ((dir (if (boundp 'org-journal-dir)
org-journal-dir
"~/Documents/journal/")))
(setq org-journal-file-pattern
(org-journal-dir-and-format->regex dir value)))
(org-journal-update-auto-mode-alist)))
(defcustom org-journal-date-format "%A, %x"
"Format string for date entries.
By default \"WEEKDAY, DATE\", where DATE is what Emacs thinks is an
appropriate way to format days in your language. If you define it as
a function, it is evaluated and inserted."
:type 'string)
(defcustom org-journal-date-prefix "* "
"String that is put before every date at the top of a journal file.
By default, this is a org-mode heading. Another good idea would be
\"#+TITLE: \" for org titles.
Setting `org-journal-date-prefix' to something other than \"* \"
for weekly/monthly/yearly journal files won't work correctly."
:type 'string)
(defcustom org-journal-time-format "%R "
"Format string for time entries.
By default HH:MM. Set it to a blank string if you want to disable timestamps."
:type 'string)
(defcustom org-journal-time-format-post-midnight ""
"When non-blank, a separate time format string for after midnight.
When the current time is before the hour set by `org-extend-today-until'."
:type 'string)
(defcustom org-journal-time-prefix "** "
"String that is put before every time entry in a journal file.
By default, this is an org-mode sub-heading."
:type 'string)
(defcustom org-journal-hide-entries-p t
"If true, `org-journal-mode' will hide all but the current entry when creating a new one."
:type 'boolean)
(defcustom org-journal-enable-encryption nil
"If non-nil, new journal entries will have a `org-crypt-tag-matcher' tag for encrypting.
Whenever a user saves/opens these journal entries, emacs asks a user passphrase
to encrypt/decrypt it."
:type 'boolean)
(defcustom org-journal-encrypt-journal nil
"If non-nil, encrypt journal files using gpg.
The journal files will have the file extension \".gpg\"."
:type 'boolean)
(defcustom org-journal-encrypt-on 'before-save-hook
"Hook on which to encrypt entries.
It can be set to other hooks like `kill-buffer-hook'."
:type 'function)
(defcustom org-journal-enable-agenda-integration nil
"If non-nil, automatically adds current and future org-journal files to `org-agenda-files'."
:type 'boolean)
(defcustom org-journal-find-file 'find-file-other-window
"The function to use when opening an entry.
Set this to `find-file' if you don't want org-journal to split your window."
:type 'function)
(defcustom org-journal-carryover-items "TODO=\"TODO\""
"Carry over items that match these criteria from the previous entry to new entries.
See agenda tags view match description for the format of this."
:type 'string)
(defcustom org-journal-search-results-order-by :asc
"When :desc, make search results ordered by date descending, otherwise date ascending."
:type 'symbol)
(defcustom org-journal-tag-alist nil
"Default tags for use in Org-Journal mode.
This is analogous to `org-tag-alist', and uses the same format.
If nil, the default, then `org-tag-alist' is used instead.
This can also be overridden on a file-local level by using a “#+TAGS:”
keyword."
:type (get 'org-tag-alist 'custom-type))
(defcustom org-journal-tag-persistent-alist nil
"Persistent tags for use in Org-Journal mode.
This is analogous to `org-tag-persistent-alist', and uses the same
format. If nil, the default, then `org-tag-persistent-alist' is used
instead. These tags cannot be overridden with a “#+TAGS:” keyword, but
they can be disabled per-file by adding the line “#+STARTUP: noptag”
anywhere in your file."
:type (get 'org-tag-persistent-alist 'custom-type))
(defcustom org-journal-search-forward-fn 'search-forward
"The function used by `org-journal-search` to look for the string
forward in a buffer.
Defaults to search-forward.
You can, for example, set it to `search-forward-regexp` so the
search works with regexps."
:type 'function)
(defvar org-journal-after-entry-create-hook nil
"Hook called after journal entry creation.")
;; Automatically switch to journal mode when opening a journal entry file
(setq org-journal-file-pattern
(org-journal-dir-and-format->regex org-journal-dir org-journal-file-format))
(org-journal-update-auto-mode-alist)
(add-hook 'calendar-today-visible-hook 'org-journal-mark-entries)
(add-hook 'calendar-today-invisible-hook 'org-journal-mark-entries)
;; Journal mode definition
;;;###autoload
(define-derived-mode org-journal-mode org-mode
"Journal"
"Mode for writing or viewing entries written in the journal."
(turn-on-visual-line-mode)
(add-hook 'after-save-hook 'org-journal-update-org-agenda-files nil t)
(when (or org-journal-tag-alist org-journal-tag-persistent-alist)
(org-journal-set-current-tag-alist))
(run-mode-hooks))
;; Key bindings
(define-key org-journal-mode-map (kbd "C-c C-f") 'org-journal-open-next-entry)
(define-key org-journal-mode-map (kbd "C-c C-b") 'org-journal-open-previous-entry)
(define-key org-journal-mode-map (kbd "C-c C-j") 'org-journal-new-entry)
(define-key org-journal-mode-map (kbd "C-c C-s") 'org-journal-search)
;;;###autoload
(eval-after-load "calendar"
'(progn
(define-key calendar-mode-map "m" 'org-journal-mark-entries)
(define-key calendar-mode-map "j" 'org-journal-read-entry)
(define-key calendar-mode-map (kbd "C-j") 'org-journal-display-entry)
(define-key calendar-mode-map "]" 'org-journal-next-entry)
(define-key calendar-mode-map "[" 'org-journal-previous-entry)
(define-key calendar-mode-map (kbd "i j") 'org-journal-new-date-entry)
(define-key calendar-mode-map (kbd "f f") 'org-journal-search-forever)
(define-key calendar-mode-map (kbd "f F") 'org-journal-search-future)
(define-key calendar-mode-map (kbd "f w") 'org-journal-search-calendar-week)
(define-key calendar-mode-map (kbd "f m") 'org-journal-search-calendar-month)
(define-key calendar-mode-map (kbd "f y") 'org-journal-search-calendar-year)))
(global-set-key (kbd "C-c C-j") 'org-journal-new-entry)
(defmacro org-journal-with-journal (journal-file &rest body)
"Opens JOURNAL-FILE in fundamental mode, or switches to the buffer which is visiting JOURNAL-FILE.
Returns the last value from BODY. If the buffer didn't exist before it will be deposed."
;; Use find-file... instead of view-file... since
;; view-file does not respect auto-mode-alist
`(let* ((buffer-exists (get-buffer (file-name-nondirectory ,journal-file)))
(buf (if buffer-exists buffer-exists
(generate-new-buffer (file-name-nondirectory ,journal-file))))
result)
(with-current-buffer buf
(unless buffer-exists
(insert-file-contents ,journal-file))
(setq result (progn ,@body)))
(unless buffer-exists
(kill-buffer buf))
result))
(defvar org-journal-created-re " *:CREATED: *[0-9]\\{8\\}"
"Regex to find created property.")
(defsubst org-journal-search-forward-created (date)
"Search for CREATED tag with date.
DATE should be a calendar date list (MONTH DAY YEAR)."
(re-search-forward
(format " *:CREATED: *%.4d%.2d%.2d" (nth 2 date) (car date) (cadr date))))
(defun org-journal-daily-p ()
"Returns t if `org-journal-file-type' is set to `'daily'."
(eq org-journal-file-type 'daily))
(defun org-journal-org-heading-p ()
"Returns t if `org-journal-date-prefix' starts with \"* \"."
(string-match "^\* " org-journal-date-prefix))
(defun org-journal-convert-time-to-file-type-time (&optional time)
"Converts TIME to the file type format date.
If `org-journal-file-type' is 'weekly the TIME will be rounded to
the first date of the week.
If `org-journal-file-type' is 'monthly the TIME will be rounded to
the first date of the month.
If `org-journal-file-type' is 'yearly the TIME will be rounded to
the first date of the year."
(or time (setq time (current-time)))
(pcase org-journal-file-type
;; Do nothing for daily
(`daily time)
;; Round to the monday of the current week, e.g. 20181231 is the first week of 2019
(`weekly
(let ((date
(calendar-gregorian-from-absolute
(calendar-iso-to-absolute
(mapcar 'string-to-number
(split-string (format-time-string "%V 1 %G" time) " "))))))
(encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
;; Round to the first day of the month, e.g. 20190301
(`monthly
(apply 'encode-time
`(0 0 0 ,@(mapcar 'string-to-number
(split-string (format-time-string "1 %m %Y" time) " ")))))
;; Round to the first day of the year, e.g. 20190101
(`yearly
(apply 'encode-time
`(0 0 0 ,@(mapcar 'string-to-number
(split-string (format-time-string "1 1 %Y" time) " ")))))))
(defun org-journal-get-entry-path (&optional time)
"Return the path to an entry matching TIME, if no TIME is given, uses the current time."
(let ((file (file-truename
(expand-file-name
(format-time-string org-journal-file-format
(org-journal-convert-time-to-file-type-time time))
(file-name-as-directory org-journal-dir)))))
(when (and org-journal-encrypt-journal (not (file-exists-p file)))
(setq file (concat file ".gpg")))
file))
(defun org-journal-dir-check-or-create ()
"Check existence of `org-journal-dir'. If it doesn't exist, try to make directory."
(unless (file-exists-p org-journal-dir)
(if (yes-or-no-p (format "Journal directory %s not found. Create one? " org-journal-dir))
(make-directory org-journal-dir t)
(error "Journal directory is necessary to use org-journal.")))
t)
(defun org-journal-set-current-tag-alist ()
"Set `org-current-tag-alist' for the current journal file.
This allows the use of `org-journal-tag-alist' and
`org-journal-tag-persistent-alist', which when non-nil override
`org-tag-alist' and `org-journal-tag-persistent-alist' respectively."
(setq org-current-tag-alist ; this var is always buffer-local
(org--tag-add-to-alist
(or org-journal-tag-persistent-alist org-tag-persistent-alist)
(let* ((alist (org--setup-collect-keywords
(org-make-options-regexp
'("FILETAGS" "TAGS" "SETUPFILE"))))
(tags (cdr (assq 'tags alist))))
(if (and alist tags)
(org-tag-string-to-alist tags)
(or org-journal-tag-alist org-tag-alist))))))
;;;###autoload
(defun org-journal-new-entry (prefix &optional time)
"Open today's journal file and start a new entry.
Giving the command a PREFIX arg will just open a today's file,
without adding an entry. If given a TIME, create an entry for the
time's day. If no TIME was given, use the current time (which is
interpreted as belonging to yesterday if smaller than
`org-extend-today-until').
Whenever a journal entry is created the `org-journal-after-entry-create-hook'
hook is run."
(interactive "P")
(org-journal-dir-check-or-create)
;; if time is before org-extend-today-until, interpret it as
;; part of the previous day:
(let (oetu-active-p) ;; org-extend-today-until-active-p
(let ((now (decode-time nil)))
(if (and (not time) ; time was not given
(< (nth 2 now)
org-extend-today-until))
(setq oetu-active-p t
time (encode-time (nth 0 now) ; second
(nth 1 now) ; minute
(nth 2 now) ; hour
(1- (nth 3 now)) ; day
(nth 4 now) ; month
(nth 5 now) ; year
(nth 8 now))))) ; timezone
(let* ((entry-path (org-journal-get-entry-path time))
(should-add-entry-p (not prefix)))
;; Open journal file
(unless (string= entry-path (buffer-file-name))
(funcall org-journal-find-file entry-path))
;; Create new journal entry if there isn't one.
(let ((entry-header
(if (functionp org-journal-date-format)
(funcall org-journal-date-format time)
(concat org-journal-date-prefix
(format-time-string org-journal-date-format time)))))
(goto-char (point-min))
(unless (search-forward entry-header nil t)
;; Insure we insert the new journal header at the correct location
(unless (org-journal-daily-p)
(let ((date (decode-time time))
(dates (sort (org-journal-file->calendar-dates (buffer-file-name))
(lambda (a b)
(calendar-date-compare (list b) (list a)))))
found)
(setq date (list (nth 4 date) (nth 3 date) (nth 5 date)))
(while dates
(when (calendar-date-compare dates (list date))
(org-journal-search-forward-created (car dates))
(outline-end-of-subtree)
(insert "\n")
(setq found t
dates nil))
(setq dates (cdr dates)))
(unless found
(goto-char (point-max))
(forward-line))))
(when (looking-back "[^\t ]" (point-at-bol))
(insert "\n"))
(beginning-of-line)
(insert entry-header)
;; For 'weekly, 'monthly and 'yearly journal entries
;; create a "CREATED" property with the current date.
(unless (org-journal-daily-p)
(org-set-property "CREATED" (format-time-string "%Y%m%d" time)))
(when org-journal-enable-encryption
(unless (member org-crypt-tag-matcher (org-get-tags))
(org-set-tags org-crypt-tag-matcher)))))
(org-journal-decrypt)
;; move TODOs from previous day here
(when (and org-journal-carryover-items
(string= entry-path (org-journal-get-entry-path (current-time))))
(org-journal-carryover))
(if (org-journal-org-heading-p)
(outline-end-of-subtree)
(goto-char (point-max)))
;; insert the header of the entry
(when should-add-entry-p
(unless (eq (current-column) 0) (insert "\n"))
(let* ((day-discrepancy (- (time-to-days (current-time)) (time-to-days time)))
(timestamp (cond
;; “time” is today, use normal timestamp format
((= day-discrepancy 0)
(format-time-string org-journal-time-format))
;; “time” is yesterday with org-extend-today-until,
;; use different timestamp format if available
((and (= day-discrepancy 1) oetu-active-p)
(if (not (string-equal org-journal-time-format-post-midnight ""))
(format-time-string org-journal-time-format-post-midnight)
(format-time-string org-journal-time-format)))
;; “time” is on some other day, use blank timestamp
(t ""))))
(insert org-journal-time-prefix timestamp))
(run-hooks 'org-journal-after-entry-create-hook))
(if (and org-journal-hide-entries-p (org-journal-time-entry-level))
(outline-hide-sublevels (org-journal-time-entry-level))
(save-excursion (org-journal-finalize-view)))
(when should-add-entry-p
(outline-show-entry)))))
(defvar org-journal--kill-buffer nil
"Will be set to the `t' if `org-journal-open-entry' is visiting a
buffer not open already, otherwise `nil'.")
(defun org-journal-carryover ()
"Moves all items matching `org-journal-carryover-items' from the
previous day's file to the current file."
(interactive)
(let* ((org-journal-find-file 'find-file)
;; Doesn't keep value after org-journal-carryover-item-with-parents
(mapper (lambda ()
(let ((headings (org-journal-carryover-item-with-parents)))
;; since the next subtree now starts at point,
;; continue mapping from before that, to include it
;; in the search
(setq org-map-continue-from (point))
headings)))
carryover-items-with-parents
carryover-items-non-parents
prev-entry-buffer)
(save-excursion
(save-restriction
(when (let ((inhibit-message t))
(org-journal-open-previous-entry 'no-select))
(setq prev-entry-buffer (current-buffer))
(unless (org-journal-daily-p) ;; (org-journal-org-heading-p) should work to
(org-narrow-to-subtree))
;; Create a sorted list with duplicates removed from the value returned
;; from `org-map-entries'. The returned value from `org-map-entries',
;; is a list where each element is list containing points, which are representing
;; the headers to carryover -- cddr contains the text.
(mapc (lambda (carryover-path)
(push (car carryover-path) carryover-items-non-parents)
(mapc (lambda (heading)
(unless (member heading carryover-items-with-parents)
(push heading carryover-items-with-parents)))
carryover-path))
(org-map-entries mapper org-journal-carryover-items))
(setq carryover-items-with-parents (sort carryover-items-with-parents
(lambda (x y)
(< (car x) (car y))))))))
(when carryover-items-with-parents
(when (org-journal-org-heading-p)
(outline-end-of-subtree))
(unless (eq (current-column) 0) (insert "\n"))
(mapc (lambda (x) (insert (cddr x)))
carryover-items-with-parents)
;; Delete carryover items
(with-current-buffer prev-entry-buffer
(mapc (lambda (x)
(kill-region (car x) (cadr x)))
carryover-items-non-parents)
(save-buffer)
(when org-journal--kill-buffer
(kill-buffer))))))
(defun org-journal-carryover-item-with-parents ()
"Return carryover item inclusive the parents.
The carryover item The parents
| /---------\
;; ((START END . \"TEXT\") ... (START END . \"TEXT\"))
"
(let (start end text carryover-item-with-parents)
(save-excursion
(while (> (org-outline-level) (org-journal-time-entry-level))
(org-up-heading-safe)
(setq start (point)
end (save-excursion (outline-next-heading) (point))
text (buffer-substring-no-properties start end))
(push (cons start (cons end text)) carryover-item-with-parents)))
(setq start (point-at-bol)
end (progn (outline-end-of-subtree) (outline-next-heading) (point))
text (buffer-substring-no-properties start end))
(push (cons start (cons end text)) carryover-item-with-parents)))
(defun org-journal-time-entry-level ()
"Return the headline level of time entries based on the number
of leading asterisks in `org-journal-time-prefix'.
Return nil when it's impossible to figure out the level."
(when (string-match "\\(^\*+\\)" org-journal-time-prefix)
(length (match-string 1 org-journal-time-prefix))))
(defun org-journal-calendar-date->time (calendar-date)
"Convert a date as returned from the calendar to a time."
(encode-time 0 0 0 ; second, minute, hour
(nth 1 calendar-date) ; day
(nth 0 calendar-date) ; month
(nth 2 calendar-date))) ; year
(defun org-journal-file-name->calendar-date (file-name)
"Convert an org-journal file name to a calendar date.
If `org-journal-file-pattern' does not contain capture groups,
fall back to the old behavior of taking substrings."
(if (and (integerp (string-match "\(\?1:" org-journal-file-pattern))
(integerp (string-match "\(\?2:" org-journal-file-pattern))
(integerp (string-match "\(\?3:" org-journal-file-pattern)))
(list (string-to-number (replace-regexp-in-string
org-journal-file-pattern "\\2"
file-name))
(string-to-number (replace-regexp-in-string
org-journal-file-pattern "\\3"
file-name))
(string-to-number (replace-regexp-in-string
org-journal-file-pattern "\\1"
file-name)))
(list (string-to-number (substring file-name 4 6))
(string-to-number (substring file-name 6 8))
(string-to-number (substring file-name 0 4)))))
(defun org-journal-entry-date->calendar-date ()
"Return journal calendar-date from current buffer.
This is the counterpart of `org-journal-file-name->calendar-date' for
'weekly, 'monthly and 'yearly journal files."
(let (date)
(setq date (org-entry-get (point) "CREATED"))
(string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" date)
(list (string-to-number (match-string 2 date))
(string-to-number (match-string 3 date))
(string-to-number (match-string 1 date)))))
(defun org-journal-file->calendar-dates (file)
"Return journal dates from FILE."
(interactive "P")
(org-journal-with-journal
file (let (dates)
(save-excursion
(goto-char (point-min))
(while (re-search-forward org-journal-created-re nil t)
(push (org-journal-entry-date->calendar-date) dates))
dates))))
;;;###autoload
(defun org-journal-new-date-entry (prefix &optional event)
"Open the journal for the date indicated by point and start a new entry.
If the date is not today, it won't be given a time heading. With one prefix (C-u),
don't add a new heading.
If the date is in the future, create a schedule entry, unless two universal prefix
arguments (C-u C-u) are given. In that case insert just the heading."
(interactive
(list current-prefix-arg last-nonmenu-event))
(let* ((time (org-journal-calendar-date->time
(calendar-cursor-to-date t event))))
(if (time-less-p time (current-time))
(org-journal-new-entry prefix time)
(org-journal-new-scheduled-entry prefix (format-time-string "%Y-%m-%d" time)))))
;;;###autoload
(defun org-journal-new-scheduled-entry (prefix &optional scheduled-time)
"Create a new entry in the future."
(interactive "P")
(let ((scheduled-time (or scheduled-time (org-read-date nil nil nil "Date:")))
(raw (prefix-numeric-value prefix)))
(org-journal-new-entry (= raw 16) (org-time-string-to-time scheduled-time))
(unless (= raw 16)
(if (not prefix)
(insert "TODO "))
(save-excursion
(insert "\n<" scheduled-time ">")))))
(defsubst org-journal-goto-journal-heading ()
"Goto to journal heading."
(while (org-up-heading-safe)))
(defun org-journal-open-entry (msg &optional prev no-select)
"Open journal entry.
If no next/PREVious entry was found print MSG."
(let ((calendar-date (if (org-journal-daily-p)
(org-journal-file-name->calendar-date (buffer-file-name))
(org-journal-goto-journal-heading)
(org-journal-entry-date->calendar-date)))
(view-mode-p view-mode)
(dates (org-journal-list-dates)))
(unless (member calendar-date dates)
;; Insert calendar-date into dates list keeping it in order.
(setq dates (cl-loop
for date in dates
while (calendar-date-compare (list date) (list calendar-date))
collect date into result and count t into cnt
finally return (if result
;; Front
`(,@result ,calendar-date)
;; Somewhere enbetween or end of dates
`(,calendar-date ,@result ,@(nthcdr cnt dates))))))
;; Reverse list for previous search.
(when prev
(setq dates (reverse dates)))
(while (and dates (car dates)
(or (if prev
(calendar-date-compare (list calendar-date) dates)
(calendar-date-compare dates (list calendar-date)))
(calendar-date-equal (car dates) calendar-date)))
(setq dates (cdr dates)))
(if (and dates (car dates))
(let* ((date (car dates))
(time (org-journal-calendar-date->time date))
(filename (org-journal-get-entry-path time)))
(if (get-file-buffer filename)
(progn
(if (eq 'no-select no-select)
(set-buffer (get-file-buffer filename))
(switch-to-buffer (get-file-buffer filename)))
(setq org-journal--kill-buffer nil))
(setq org-journal--kill-buffer (if (eq 'no-select no-select)
(set-buffer (find-file-noselect filename))
(find-file filename))))
(goto-char (point-min))
(unless (org-journal-daily-p)
(org-journal-search-forward-created date))
(org-journal-finalize-view)
(view-mode (if view-mode-p 1 -1))
t)
(message msg)
nil)))
(defun org-journal-open-next-entry (&optional no-select)
"Open the next journal entry starting from a currently displayed one."
(interactive)
(org-journal-open-entry "No next journal entry after this one" nil no-select))
(defun org-journal-open-previous-entry (&optional no-select)
"Open the previous journal entry starting from a currently displayed one."
(interactive)
(org-journal-open-entry "No previous journal entry before this one" t no-select))
;;
;; Functions to browse existing journal entries using the calendar
;;
;;;###autoload
(defun org-journal-list-files ()
"Returns a list of all files in the journal directory."
(org-journal-dir-check-or-create)
;; grab the file list. We can’t use directory-files-recursively’s
;; regexp facility to filter it, because that only checks the
;; regexp against the base filenames, and we need to check it
;; against filenames relative to org-journal-dir.
(let ((file-list (directory-files-recursively
(file-truename (expand-file-name
(file-name-as-directory org-journal-dir))) "\.*"))
(predicate (lambda (file-path)
(and (string-match-p org-journal-file-pattern (file-truename file-path))
(or org-journal-encrypt-journal
(not (string-match-p "\.gpg$" (file-truename file-path))))))))
(seq-filter predicate file-list)))
(defun org-journal-list-dates ()
"Loads the list of files in the journal directory, and converts
it into a list of calendar date elements."
(let ((dates (mapcar (if (org-journal-daily-p)
#'org-journal-file-name->calendar-date
#'org-journal-file->calendar-dates)
(org-journal-list-files))))
;; Need to flatten the list and bring dates in correct order.
(unless (org-journal-daily-p)
(let ((flattened-date-l '())
flattened-date-reverse-l file-dates)
(while dates
(setq file-dates (car dates))
(setq flattened-date-reverse-l '())
(while file-dates
(push (car file-dates) flattened-date-reverse-l)
(setq file-dates (cdr file-dates)))
;; Correct order of journal entries from file by pushing it to a new list.
(mapc (lambda (p)
(push p flattened-date-l))
flattened-date-reverse-l)
(setq dates (cdr dates)))
(setq dates (reverse flattened-date-l))))
dates))
;;;###autoload
(defun org-journal-mark-entries ()
"Mark days in the calendar for which a diary entry is present"
(interactive)
(dolist (journal-entry (org-journal-list-dates))
(if (calendar-date-is-visible-p journal-entry)
(if (time-less-p (org-journal-calendar-date->time journal-entry)
(current-time))
(calendar-mark-visible-date journal-entry 'org-journal-calendar-entry-face)
(calendar-mark-visible-date journal-entry 'org-journal-calendar-scheduled-face)))))
;;;###autoload
(defun org-journal-read-entry (_arg &optional event)
"Open journal entry for selected date for viewing"
(interactive
(list current-prefix-arg last-nonmenu-event))
(let* ((time (org-journal-calendar-date->time
(calendar-cursor-to-date t event))))
(org-journal-read-or-display-entry time nil)))
;;;###autoload
(defun org-journal-display-entry (_arg &optional event)
"Display journal entry for selected date in another window."
(interactive
(list current-prefix-arg last-nonmenu-event))
(let* ((time (org-journal-calendar-date->time
(calendar-cursor-to-date t event))))
(org-journal-read-or-display-entry time t)))
;; silence compiler warning.
(defvar view-exit-action)
(defun org-journal-finalize-view ()
"Finalize visability of entry."
(org-journal-decrypt)
(if (org-journal-org-heading-p)
(progn
(org-up-heading-safe)
(org-back-to-heading)
(outline-hide-other)
(outline-show-subtree))
(outline-show-all)))
;;;###autoload
(defun org-journal-read-or-display-entry (time &optional noselect)
"Read an entry for the TIME and either select the new window when NOSELECT
is nil or avoid switching when NOSELECT is non-nil."
(let ((org-journal-file (org-journal-get-entry-path time))
(point))
(if (and (file-exists-p org-journal-file)
;; If daily continoue with body of if condition
(or (org-journal-daily-p)
;; Search for journal entry
(with-temp-buffer
(insert-file-contents org-journal-file)
(goto-char (point-min))
(setq point (re-search-forward
(format-time-string " *:CREATED: *%Y%m%d" time) nil t)))))
(progn
;; open file in view-mode if not opened already
(let ((had-a-buf (get-file-buffer org-journal-file))
;; use find-file... instead of view-file... since
;; view-file does not respect auto-mode-alist
(buf (find-file-noselect org-journal-file)))
(with-current-buffer buf
(when (not had-a-buf)
(view-mode)
(setq view-exit-action 'kill-buffer))
(set (make-local-variable 'org-hide-emphasis-markers) t)
(unless (org-journal-daily-p)
(goto-char point))
(org-journal-finalize-view)
(setq point (point)))
(if noselect
(display-buffer buf t)
(funcall org-journal-find-file org-journal-file))
(set-window-point (get-buffer-window (get-file-buffer org-journal-file)) point)))
(message "No journal entry for this date."))))
;;;###autoload
(defun org-journal-next-entry ()
"Go to the next date with a journal entry."
(interactive)
(let ((dates (org-journal-list-dates)))
(while (and dates (not (calendar-date-compare
(list (calendar-cursor-to-date)) dates)))
(setq dates (cdr dates)))
(when dates
(calendar-goto-date (car dates)))))
;;;###autoload
(defun org-journal-previous-entry ()
"Go to the previous date with a journal entry."
(interactive)
(let ((dates (reverse (org-journal-list-dates))))
(while (and dates
(not (calendar-date-compare dates (list (calendar-cursor-to-date)))))
(setq dates (cdr dates)))
(when dates
(calendar-goto-date (car dates)))))
;;; Journal search facilities
;;
;;;###autoload
(defun org-journal-search (str &optional period-name)
"Search for a string in the journal within a given interval.
See `org-read-date' for information on ways to specify dates.
If a prefix argument is given, search all dates."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(let* ((period-pair (org-journal-read-period (if current-prefix-arg 'forever period-name)))
(start (org-journal-calendar-date->time (car period-pair)))
(end (org-journal-calendar-date->time (cdr period-pair))))
(org-journal-search-by-string str start end)))
(defvar org-journal-search-history nil)
(defun org-journal-search-calendar-week (str)
"Search for a string within a current calendar-mode week entries."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(org-journal-search str 'week))
(defun org-journal-search-calendar-month (str)
"Search for a string within a current calendar-mode month entries."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(org-journal-search str 'month))
(defun org-journal-search-calendar-year (str)
"Search for a string within a current calendar-mode year entries."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(org-journal-search str 'year))
(defun org-journal-search-forever (str)
"Search for a string within all entries."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(org-journal-search str 'forever))
(defun org-journal-search-future (str)
"Search for a string within all future entries."
(interactive (list (read-string "Enter a string to search for: " nil 'org-journal-search-history)))
(org-journal-search str 'future))
(defun org-journal-search-future-scheduled ()
"Search for TODOs within all future entries."
(interactive)
(org-journal-search "TODO" 'future))
;; This macro is needed for many of the following functions.
(defmacro org-journal-with-find-file (file &rest body)
"Executes BODY in FILE. Use this to insert text into FILE.
The buffer is disposed after the macro exits (unless it already
existed before)."
`(save-excursion
(let ((current-buffer (current-buffer))
(buffer-exists (get-buffer (file-name-nondirectory ,file)))
(result nil))
(if buffer-exists
(switch-to-buffer buffer-exists)
(find-file ,file))
(setq result (progn ,@body))
(basic-save-buffer)
(unless buffer-exists
(kill-buffer))
(switch-to-buffer current-buffer)
result)))
(defun org-journal-update-org-agenda-files ()
"Adds the current and future journal files to `org-agenda-files', and cleans
out past org-journal files."
(when org-journal-enable-agenda-integration
(let ((not-org-journal-agenda-files
(seq-filter
(lambda (fname)
(not (string-match org-journal-file-pattern fname)))
(org-agenda-files)))
(org-journal-agenda-files
(let* ((future (org-journal-read-period 'future))
(beg (car future))
(end (cdr future)))
;; TODO(cschwarzgruber): Needs to be adopted for weekly, monthly or yearly journal file type.
;; We actually would need to limit the file scope, if we only want TODO's for today, and future.
(setcar (cdr beg) (1- (cadr beg)))
(org-journal-search-build-file-list
(org-journal-calendar-date->time beg)