;;; org-journal.el --- a simple org-mode based journaling mode -*- lexical-binding: t; -*-

;; Copyright 2013-2022 Bastian Bechtold

;; Author: Bastian Bechtold

;; Christian Schwarzgruber

;; URL: http://github.com/bastibe/org-journal

;; Version: 2.2.0

;; Package-Requires: ((emacs "25.1") (org "9.1"))

;; Redistribution and use in source and binary forms, with or without

;; modification, are permitted provided that the following conditions are met:

;;

;; 1. Redistributions of source code must retain the above copyright notice,

;; this list of conditions and the following disclaimer.

;;

;; 2. Redistributions in binary form must reproduce the above copyright notice,

;; this list of conditions and the following disclaimer in the documentation

;; and/or other materials provided with the distribution.

;;

;; 3. Neither the name of the copyright holder nor the names of its contributors

;; may be used to endorse or promote products derived from this software without

;; specific prior written permission.

;;

;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"

;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE

;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR

;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF

;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS

;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN

;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)

;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE

;; POSSIBILITY OF SUCH DAMAGE.

;;; 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, "M-x org-journal-new-entry". You can also open the

;; current day's entry without adding a new entry with "C-u M-x

;; org-journal-new-entry".

;;

;; 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: M-x org-journal-new-entry

;; To open today's journal without creating a new entry: C-u M-x org-journal-new-entry

;; In calendar view: j m to mark entries in calendar

;; j r to view an entry in a new buffer

;; j d to view an entry but not switch to it

;; j n to add a new entry

;; j s w to search all entries of the current week

;; j s m to search all entries of the current month

;; j s y to search all entries of the current year

;; j s f to search all entries of all time

;; j s 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 'cal-iso)

(require 'epa)

(require 'org)

(require 'org-crypt)

(require 'seq)

(require 'subr-x)

;; Silent byte-compiler

(defvar view-exit-action)

(declare-function org-collect-keywords "org")

(when (version< org-version "9.2")

(defalias 'org-set-tags-to 'org-set-tags))

(unless (fboundp 'org--tag-add-to-alist)

;; This function can be removed once emacs-26 es required or de-facto standard.

(defun org-tag-add-to-alist (alist1 alist2)

"Append ALIST1 elements to ALIST2 if they are not there yet.

From branch \"emacs-26\", added for compatibility.

"

(cond

((null alist2) alist1)

((null alist1) alist2)

(t (let ((alist2-cars (mapcar (lambda (x) (car-safe x)) alist2))

to-add)

(dolist (i alist1)

(unless (member (car-safe i) alist2-cars)

(push i to-add)))

(append to-add alist2)))))

(defalias 'org--tag-add-to-alist 'org-tag-add-to-alist))

;;; Customizable variables

(defgroup org-journal nil

"Settings for the personal journal"

:group 'org

:group 'org-journal)

(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.

When switching from daily to weekly, monthly, yearly, or from weekly,

monthly, yearly to daily, you need to invalidate the cache. This has currently

to be done manually by calling `org-journal-invalidate-cache'."

:type '(choice

(const :tag "Daily" daily)

(const :tag "Weekly" weekly)

(const :tag "Monthly" monthly)

(const :tag "Yearly" yearly)))

(defcustom org-journal-start-on-weekday 1

"When `org-journal-file-type' is set to 'weekly, start the week on this day.

1 for Monday, ..., and 7 for Sunday."

:type '(choice

(const :tag "Monday" 1)

(const :tag "Tuesday" 2)

(const :tag "Wednesday" 3)

(const :tag "Thursday" 4)

(const :tag "Friday" 5)

(const :tag "Saturday" 6)

(const :tag "Sunday" 7)))

(defcustom org-journal-dir "~/Documents/journal/"

"Directory containing journal entries."

:type 'directory

:risky t)

(defcustom org-journal-file-format "%Y%m%d"

"Format string for journal file names (Default \"YYYYMMDD\").

This pattern MUST include `%Y', `%m' and `%d' when `org-journal-file-type' is

`daily' or `weekly'. When `org-journal-file-type' is `monthly' this pattern

MUST at least include `%Y' and `%m', and at least `%Y' when

`org-journal-file-type' is `yearly'.

Currently supported placeholders are:

%Y is the year as decimal number, including the century.

%m is the month as a decimal number (range 01 to 12).

%d is the day as a decimal number (range 01 to 31).

%V is the ISO 8601 week number as a decimal number (range 01 to 53).

%a is the locale’s abbreviated name of the day of week, %A the full name.

%b is the locale's abbreviated name of the month, %B the full name.

%F is the ISO 8601 date format (equivalent to \"%Y-%m-%d\")."

:type 'string)

(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 the value is a function, the function will be evaluated and the return

value will be inserted."

:type '(choice

(string :tag "String")

(function :tag "Function")))

(defcustom org-journal-search-result-date-format "%A, %x"

"Date format string for search result.

By default \"WEEKDAY, DATE\", where DATE is what Emacs thinks is an

appropriate way to format days in your language."

:type 'string)

(defcustom org-journal-date-prefix "* "

"Prefix for `org-journal-date-format'.

The default prefix creates an `org-mode' heading. This default

should not be changed for weekly, monthly or yearly journal

files. An alternative for daily journal files could be

\"#+title: \" creating a title rather than a heading. To create

a \"#+title: \" for weekly, monthly or yearly (but also daily)

journal files, customize `org-journal-file-header' instead."

: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 all but the current entry will be hidden when creating a new one."

:type 'boolean)

(defcustom org-journal-enable-encryption nil

"Add `org-crypt-tag-matcher' tag for encrypted entries when non-nil.

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

"Add current and future org-journal files to `org-agenda-files' when non-nil."

: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.

See agenda tags view match description for the format of this."

:type 'string)

(defcustom org-journal-skip-carryover-drawers nil

"By default, we carry over all the drawers associated with the items.

This option can be used to skip certain drawers being carried over.

The drawers listed here will be wiped completely, when the item gets carried

over."

:type 'list)

(defcustom org-journal-handle-old-carryover 'org-journal-delete-old-carryover

"The function to handle the carryover entries in the previous journal.

This function takes one argument, which is a list of the carryover entries

in the journal of previous day.

The list is in form of ((START_POINT (END_POINT . \"TEXT\")) ...);

and in ascending order of START_POINT."

:type 'function)

(defcustom org-journal-carryover-delete-empty-journal 'never

"Delete empty journal entry/file after carryover.

Default is to `never' delete an empty journal entry/file. Other options

are `always', i.e. don't prompt, just delete or `ask'"

:type '(choice

(const :tag "never" never)

(const :tag "always" always)

(const :tag "ask" ask)))

(defcustom org-journal-search-results-order-by :asc

"Journal entry search order.

Search gets sorted by date either ascending :asc, or descending :desc."

: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, 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'.

Other possible value is e.g. `re-search-forward'."

:type 'function)

(defcustom org-journal-follow-mode nil

"If `t', follow journal entry in calendar."

:type 'boolean)

(defcustom org-journal-enable-cache nil

"If `t', journal entry dates will be cached for faster calendar operations."

:type 'boolean)

(defcustom org-journal-file-header ""

"A string which should be inserted at the top of a new journal file.

The string will be passed to `format-time-string' along with the time

of the new journal entry.

The value can also be a function expecting a time value."

:type '(choice

(string :tag "String")

(function :tag "Function")))

(defcustom org-journal-created-property-timestamp-format "%Y%m%d"

"The created property timestamp format-string.

We must be able to reconstruct the timestamp from year,

month and day.

Currently supported placeholders are:

%Y is the year as decimal number, including the century.

%m is the month as a decimal number (range 01 to 12).

%d is the day as a decimal number (range 01 to 31).

%V is the ISO 8601 week number as a decimal number (range 01 to 53).

%a is the locale’s abbreviated name of the day of week, %A the full name.

%b is the locale's abbreviated name of the month, %B the full name.

%F is the ISO 8601 date format (equivalent to \"%Y-%m-%d\").

You must call `org-journal-convert-created-property-timestamps' afterwards,

if you have existing journal entries."

:type 'string)

(defcustom org-journal-prefix-key "C-c C-"

"The default prefix key inside `org-journal-mode'.

This variable needs to set before `org-journal' gets loaded.

When this variable is set to an empty string or `nil' no bindings will

be made.

This prefix key is used for:

- `org-journal-next-entry' (key \"f\")

- `org-journal-previous-entry' (key \"b\")

- `org-journal-new-entry' (key \"j\")

- `org-journal-search' (key \"s\")"

:type 'string)

(defvar org-journal-after-entry-create-hook nil

"Hook called after journal entry creation.")

(defvar org-journal-after-header-create-hook nil

"Hook called after journal header creation.

The header is the string described by `org-journal-date-format'.

This runs once per date, before `org-journal-after-entry-create-hook'.")

(defvar org-journal--search-buffer "*Org-journal search*")



;;;###autoload

(add-hook 'calendar-today-visible-hook 'org-journal-mark-entries)

;;;###autoload

(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."

(add-hook 'after-save-hook 'org-journal-after-save-hook nil t)

(when (or org-journal-tag-alist org-journal-tag-persistent-alist)

(org-journal--set-current-tag-alist))

(run-mode-hooks))

;;;###autoload

(define-obsolete-function-alias 'org-journal-open-next-entry 'org-journal-next-entry "2.1.0")

;;;###autoload

(define-obsolete-function-alias 'org-journal-open-previous-entry 'org-journal-previous-entry "2.1.0")

;; Key bindings

(when (and (stringp org-journal-prefix-key) (not (string-empty-p org-journal-prefix-key)))

(let ((command-table '(("f" . org-journal-next-entry)

("b" . org-journal-previous-entry)

("j" . org-journal-new-entry)

("s" . org-journal-search)))

(key-func (if (string-prefix-p "\\" org-journal-prefix-key)

#'concat

(lambda (prefix key) (kbd (concat prefix "" key))))))

(cl-loop for (key . command) in command-table

do (define-key org-journal-mode-map (funcall key-func org-journal-prefix-key key) command))))

(eval-after-load "calendar"

'(progn

(define-key calendar-mode-map (kbd "j m") 'org-journal-mark-entries)

(define-key calendar-mode-map (kbd "j r") 'org-journal-read-entry)

(define-key calendar-mode-map (kbd "j d") '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 "j n") 'org-journal-new-date-entry)

(define-key calendar-mode-map (kbd "j s f") 'org-journal-search-forever)

(define-key calendar-mode-map (kbd "j s F") 'org-journal-search-future)

(define-key calendar-mode-map (kbd "j s w") 'org-journal-search-calendar-week)

(define-key calendar-mode-map (kbd "j s m") 'org-journal-search-calendar-month)

(define-key calendar-mode-map (kbd "j s y") 'org-journal-search-calendar-year)))

(defmacro org-journal--with-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

(declare (indent 1))

`(let* ((buffer-exists (get-buffer (file-name-nondirectory ,file)))

(buf (if buffer-exists buffer-exists

(generate-new-buffer (file-name-nondirectory ,file))))

result)

(with-current-buffer buf

(unless buffer-exists

(insert-file-contents ,file))

;; Use `let' to change the local value of `major-mode' and avoid

;; activating `org-mode' directly and incurring a performance penalty.

(setq result (let ((major-mode 'org-mode))

(progn ,@body))))

(unless buffer-exists

(kill-buffer buf))

result))

(def-edebug-spec org-journal--with-journal (form body))

(defun org-journal-after-save-hook ()

"Update agenda files and dates."

(org-journal--update-org-agenda-files)

(org-journal--dates-puthash)

(org-journal--serialize))

(defun org-journal-is-journal ()

"Determine if file is a journal file."

(and (buffer-file-name)

(string-match (org-journal--dir-and-file-format->pattern) (file-truename (buffer-file-name)))))

;; Open files in `org-journal-mode' if `org-journal-is-journal' returns true.

(add-to-list 'magic-mode-alist '(org-journal-is-journal . org-journal-mode))

(defun org-journal--dir-and-file-format->pattern ()

"Return the current journal file pattern"

(concat (file-name-as-directory (file-truename org-journal-dir))

(org-journal--format->regex org-journal-file-format)

"\\(\\.gpg\\)?\\'"))

(defvar org-journal--format-rx-alist

'(("%[aAbB]" . "\\\\(?4:[a-zA-Z]\\\\{3,\\\\}\\\\)")

("%d" . "\\\\(?3:[0-9]\\\\{2\\\\}\\\\)")

("%m" . "\\\\(?2:[0-9]\\\\{2\\\\}\\\\)")

("%Y" . "\\\\(?1:[0-9]\\\\{4\\\\}\\\\)")

("%V" . "[0-9]\\\\{2\\\\}")))

(defun org-journal--format->regex (format)

(cl-loop

initially (setq format (regexp-quote (replace-regexp-in-string "%F" "%Y-%m-%d" format t)))

for (fmt . rx) in org-journal--format-rx-alist

do (setq format (replace-regexp-in-string fmt rx format t))

;; Ignore extra timestamp elements rather than erroring out

finally return (replace-regexp-in-string "[]>]$" "[A-z0-9: ]*\\&" format)))

(defvar org-journal--created-re "^ *:CREATED: +.*$" "Regex to find created property.")

(defun org-journal--search-forward-created (date &optional bound noerror count)

"Search for CREATED tag with date."

(re-search-forward

(concat "[ \t]*:CREATED:[ \t]+"

(format-time-string

(regexp-quote org-journal-created-property-timestamp-format)

(org-journal--calendar-date->time date))

"[ \t]*$")

bound noerror count))

(defsubst org-journal--daily-p ()

"Returns t if `org-journal-file-type' is set to `'daily'."

(eq org-journal-file-type 'daily))

(defun org-journal--is-date-prefix-org-heading-p ()

"Returns t if `org-journal-date-prefix' starts with \"* \"."

(eq 0 (string-match "^\* " org-journal-date-prefix)))

;;;###autoload

(defun org-journal-convert-created-property-timestamps (old-format)

"Convert format of CREATED property timestamps.

Convert OLD-FORMAT or input to `org-journal-created-property-timestamp-format'."

(interactive "sEnter old format: ")

(if (org-journal--daily-p)

(message "Nothing to do, org-journal-file-type is 'daily")

(dolist (file (org-journal--list-files))

(let* ((inhibit-read-only)

(buffer (get-buffer (file-name-nondirectory file)))

(buffer-modefied (when buffer (buffer-modified-p buffer))))

(with-current-buffer (if buffer buffer (find-file-noselect file))

(goto-char (point-min))

(ignore-errors

(dolist (date (reverse (let ((org-journal-created-property-timestamp-format old-format))

(org-journal--file->calendar-dates file))))

(unless (let ((org-journal-created-property-timestamp-format old-format))

(org-journal--search-forward-created date nil t))

(error "Didn't find journal entry in file (%s), date was (%s) " file date))

(org-set-property "CREATED" (format-time-string

org-journal-created-property-timestamp-format

(org-journal--calendar-date->time date)))))

(unless buffer-modefied (save-buffer))

(unless buffer (kill-buffer)))))))

(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* ((absolute-monday

(calendar-iso-to-absolute

(mapcar 'string-to-number

(split-string (format-time-string "%V 1 %G" time) " "))))

(absolute-now

(calendar-absolute-from-gregorian

(mapcar 'string-to-number

(split-string (format-time-string "%m %d %Y" time) " "))))

(target-date

(+ absolute-monday

(- org-journal-start-on-weekday 1)))

(date

(calendar-gregorian-from-absolute

(if (> target-date absolute-now)

(- target-date 7)

target-date))))

(org-journal--calendar-date->time date)))

;; Round to the first day of the month, e.g. 20190301

(`monthly

(org-journal--calendar-date->time

(mapcar 'string-to-number (split-string (format-time-string "%m 1 %Y" time) " "))))

;; Round to the first day of the year, e.g. 20190101

(`yearly

(org-journal--calendar-date->time

(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))

org-journal-dir))))

(when (and org-journal-encrypt-journal (not (file-exists-p file)))

(setq file (concat file ".gpg")))

file))

(defun org-journal--create-journal-dir ()

"Create the `org-journal-dir'."

(unless (file-exists-p org-journal-dir)

(if (yes-or-no-p (format

"Journal directory %s doesn't exists. Create it? "

(file-truename org-journal-dir)))

(make-directory (file-truename org-journal-dir) t)

(user-error "A journal directory is necessary to use org-journal"))))

(defun org-journal--sanity-checks ()

"Do some sanity checks."

(unless (symbolp org-journal-file-type)

(user-error

"The value of `org-journal-file-type' must be symbol, not a %s"

(type-of org-journal-file-type))))

(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)

;; TODO: Remove this once org 9.3.7 is required

;; `org--setup-collect-keywords' was removed between version 9.3.6 and 9.3.7,

;; and is now called `org-collect-keywords', which has a different signature.

(let* ((alist (if (fboundp 'org--setup-collect-keywords)

(org--setup-collect-keywords

(org-make-options-regexp

'("FILETAGS" "TAGS" "SETUPFILE")))

(org-collect-keywords '("FILETAGS" "TAGS"))))

(tags (cdr (assq 'tags alist))))

(if (and alist tags)

(org-tag-string-to-alist tags)

(or org-journal-tag-alist org-tag-alist))))))

(defun org-journal--calendar-date-compare (date1 date2)

"Return t if DATE1 is before DATE2, nil otherwise."

(< (calendar-absolute-from-gregorian date1)

(calendar-absolute-from-gregorian date2)))

(defun org-journal--insert-header (time)

"Insert `org-journal-file-header'."

(when (and (or (functionp org-journal-file-header)

(and (stringp org-journal-file-header)

(not (string-empty-p org-journal-file-header))))

(= (buffer-size) 0))

(let ((file-header (if (functionp org-journal-file-header)

(funcall org-journal-file-header time)

(format-time-string org-journal-file-header time))))

;; if the file header consists of multiple lines append an

;; additional newline at the end to prevent it being mixed up

;; with the journal entry as in #360

(when (and (< 1 (length (split-string file-header "\n" :omit-nulls)))

(not (string-suffix-p "\n" file-header)))

(setf file-header (concat file-header "\n")))

(insert file-header))

(save-excursion

(when (re-search-backward "^#\\+" nil t)

(org-ctrl-c-ctrl-c)))))

(defun org-journal--insert-entry-header (time)

"Create new journal entry if there isn't one."

(let ((entry-header

(if (functionp org-journal-date-format)

(funcall org-journal-date-format time)

(when (string-empty-p org-journal-date-format)

(user-error "org-journal-date-format is empty, this won't work"))

(concat org-journal-date-prefix

(format-time-string org-journal-date-format time)))))

(goto-char (point-min))

(unless (if (org-journal--daily-p)

(or (search-forward entry-header nil t) (and (goto-char (point-max)) nil))

(cl-loop

with date = (decode-time time)

with file-dates = (sort (org-journal--file->calendar-dates (buffer-file-name))

(lambda (a b)

(org-journal--calendar-date-compare b a)))

with entry

initially (setq date (list (nth 4 date) (nth 3 date) (nth 5 date)))

unless file-dates ;; New entry at bof

do

(unless (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)

(goto-char (point-max)))

(if (org-at-heading-p)

(progn

(beginning-of-line)

(insert "\n")

(forward-line -1))

(forward-line -1)

(end-of-line))

and return nil

while file-dates

do

(setq entry (car file-dates)

file-dates (cdr file-dates))

if (or (org-journal--calendar-date-compare entry date) (equal entry date))

do

(org-journal--search-forward-created entry)

(when (org-journal--calendar-date-compare entry date) ;; New entry at eof, or somewhere in-between

(org-end-of-subtree))

and return (equal entry date))) ;; If an entry exists don't create a header

(when (looking-back "[^\t ]" (point-at-bol))

(insert "\n"))

(insert entry-header)

;; Create CREATED property for weekly, monthly, and yearly journal entries

(unless (org-journal--daily-p)

(org-set-property "CREATED"

(format-time-string

org-journal-created-property-timestamp-format time)))

(when org-journal-enable-encryption

(unless (member org-crypt-tag-matcher (org-get-tags))

(org-set-tags org-crypt-tag-matcher)))

(run-hooks 'org-journal-after-header-create-hook))))

(defun org-journal--insert-entry (time org-extend-today-until-active-p)

"Insert a new entry."

(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) org-extend-today-until-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))

;;;###autoload

(defun org-journal-new-entry (prefix &optional time)

"Open today's journal file and start a new entry.

With a PREFIX arg, open the today's file, create a heading if it

doesn't exist yet, but do not create a new 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--sanity-checks)

(org-journal--create-journal-dir)

;; If time is before org-extend-today-until, interpret it as

;; part of the previous day:

(let* ((now (decode-time nil))

(org-extend-today-until-active-p (and (not time) (< (nth 2 now) org-extend-today-until)))

(entry-path)

(should-add-entry-p (not prefix)))

(when org-extend-today-until-active-p

(setq time (encode-time (nth 0 now)

(nth 1 now)

(nth 2 now)

(1- (nth 3 now))

(nth 4 now)

(nth 5 now)

(nth 8 now))))

(setq entry-path (org-journal--get-entry-path time))

;; Open journal file

(unless (string= entry-path (buffer-file-name))

(funcall org-journal-find-file entry-path))

;; Insure `view-mode' is not active

(view-mode -1)

(org-journal--insert-header time)

(org-journal--insert-entry-header time)

(org-journal--decrypt)

;; Move TODOs from previous day to new entry

(when (and org-journal-carryover-items

(not (string-blank-p org-journal-carryover-items))

(string= entry-path (org-journal--get-entry-path (current-time))))

(org-journal--carryover))

(if (org-journal--is-date-prefix-org-heading-p)

(outline-end-of-subtree)

(goto-char (point-max)))

(when should-add-entry-p

(org-journal--insert-entry time org-extend-today-until-active-p))

(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--empty-journal-p (prev-buffer)

(let (entry)

(with-current-buffer prev-buffer (save-buffer))

(save-excursion

(org-journal--open-entry t t)

(setq entry (if (org-journal--is-date-prefix-org-heading-p)

(org-get-entry)

(buffer-substring-no-properties (point) (point-max)))))

(with-temp-buffer

(insert entry)

(goto-char (point-min))

(let (start end)

;; Delete scheduled timestamps

(while (re-search-forward (concat " *\\(CLOSED\\|DEADLINE\\|SCHEDULED\\): *" org-ts-regexp-both) nil t)

(delete-region (match-beginning 0) (match-end 0)))

;; Delete drawers

(while (re-search-forward org-drawer-regexp nil t)

(setq start (match-beginning 0))

(re-search-forward org-drawer-regexp nil t)

(setq end (match-end 0))

(delete-region start end)))

(string-empty-p (org-trim (buffer-string))))))

(defun org-journal--remove-drawer ()

"Removes the drawer configured via `org-journal-skip-carryover-drawers'"

(save-excursion

(save-restriction

(unless (org-journal--daily-p)

(org-narrow-to-subtree))

(goto-char (point-min))

(mapc 'delete-matching-lines (mapcar

(lambda (x)

(format ".*%s:[\\n[:ascii:]]+?:END:$" x))

org-journal-skip-carryover-drawers)))))

(defun org-journal--carryover-delete-empty-journal (prev-buffer)

"Check if the previous entry/file is empty after we carried over the

items, and delete or not delete the empty entry/file based on

`org-journal-carryover-delete-empty-journal'."

(when (and (org-journal--empty-journal-p prev-buffer)

(or (and (eq org-journal-carryover-delete-empty-journal 'ask)

(y-or-n-p "Delete empty journal entry/file?"))

(eq org-journal-carryover-delete-empty-journal 'always)))

(let ((inhibit-message t))

;; Check if the file doesn't contain any other entry, by comparing the

;; new filename with the previous entry filename and the next entry filename.

(if (and (save-excursion

(org-journal--open-entry t t)

(or (not (org-journal--open-entry t t))

(not (eq (current-buffer) prev-buffer))))

(not (eq (current-buffer) prev-buffer)))

(progn

(delete-file (buffer-file-name prev-buffer))

(kill-buffer prev-buffer)

(org-journal--list-dates))

(save-excursion

(org-journal--open-entry t t)

(delete-region (point) (progn (outline-end-of-subtree) (point)))

(save-buffer))))))

(defun org-journal-delete-old-carryover (old_entries)

"Delete all carryover entries from the previous day's journal.

If the parent heading has no more content, delete it as well."

(mapc (lambda (x)

(unless (save-excursion

(goto-char (1- (cadr x)))

(org-goto-first-child))

(delete-region (car x) (cadr x))))

(reverse old_entries)))

(defun org-journal-carryover-items (text entries prev-buffer)

"Carryover items.

Will insert `entries', and run `org-journal-handle-old-carryover' function

to process the carryover entries in `prev-buffer'."

(when entries

(if (org-journal--is-date-prefix-org-heading-p)

(progn

(while (org-up-heading-safe))

(outline-end-of-subtree))

(goto-char (point-max)))

;; Insure `view-mode' is not active

(view-mode -1)

(unless (eq (current-column) 0) (insert "\n"))

(insert text)

(save-excursion

(if (org-journal--daily-p)

(goto-char (point-min))

(while (org-up-heading-safe)))

(unless (null org-journal-skip-carryover-drawers)

(org-journal--remove-drawer))

(save-excursion

(while (re-search-forward "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\( [a-z]+\\)?\\)>" nil t)

(unless (save-excursion

(goto-char (point-at-bol))

(re-search-forward "\\<\\(SCHEDULED\\|DEADLINE\\):" (point-at-eol) t))

(replace-match

(format-time-string "%Y-%m-%d %a"

(org-journal--calendar-date->time

(save-match-data

(if (org-journal--daily-p)

(org-journal--file-name->calendar-date (buffer-file-name))

(save-excursion

(while (org-up-heading-safe))

(org-journal--entry-date->calendar-date))))))

nil nil nil 1)))))

(outline-end-of-subtree)

;; Process carryover entries in the previous day's journal

(with-current-buffer prev-buffer

(funcall org-journal-handle-old-carryover entries))))

(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)

(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-paths prev-buffer)

;; Get carryover paths

(save-excursion

(save-restriction

(when (org-journal--open-entry t t)

(setq prev-buffer (current-buffer))

(unless (org-journal--daily-p)

(org-narrow-to-subtree))

(setq carryover-paths (org-map-entries mapper org-journal-carryover-items)))))

(when (and prev-buffer carryover-paths)

(let (cleared-carryover-paths text)

;; Construct the text to carryover, and remove any duplicate elements from carryover-paths

(cl-loop

for paths in carryover-paths

with prev-paths

do (cl-loop

for path in paths

with cleared-paths

count t into counter

do (when (or (not (and prev-paths (nth counter prev-paths)))

(> (car path) (car (nth counter prev-paths))))

(setq text (concat text (cddr path)))

(if cleared-paths

(setcdr (last cleared-paths) (list path))

(setq cleared-paths (list path))))

finally (if cleared-carryover-paths

(setcdr (last cleared-carryover-paths) cleared-paths)

(setq cleared-carryover-paths cleared-paths))

(setq prev-paths paths)))

(org-journal-carryover-items text cleared-carryover-paths prev-buffer))

(org-journal--carryover-delete-empty-journal prev-buffer))

(when org-journal--kill-buffer

(mapc 'kill-buffer org-journal--kill-buffer)

(setq org-journal--kill-buffer nil))))

(defun org-journal--carryover-item-with-parents ()

"Return carryover item inclusive the parents.

The parents ... The carryover item

;; ((START END . \"TEXT\") ... (START END . \"TEXT\"))

"

(let (start end text carryover-item-with-parents)

(save-excursion