From 195477d2dba96e8776416c8d5d145a167cf9c1b6 Mon Sep 17 00:00:00 2001 From: Raphael Roberts Date: Sat, 8 Jan 2022 13:51:26 -0600 Subject: [PATCH] Added org journal mode and set up keybindings --- .../org-journal-autoloads.el | 147 ++ elpa/org-journal-2.1.2/org-journal-pkg.el | 2 + elpa/org-journal-2.1.2/org-journal.el | 1886 +++++++++++++++++ settings.org | 6 + 4 files changed, 2041 insertions(+) create mode 100644 elpa/org-journal-2.1.2/org-journal-autoloads.el create mode 100644 elpa/org-journal-2.1.2/org-journal-pkg.el create mode 100644 elpa/org-journal-2.1.2/org-journal.el diff --git a/elpa/org-journal-2.1.2/org-journal-autoloads.el b/elpa/org-journal-2.1.2/org-journal-autoloads.el new file mode 100644 index 0000000..40b40ea --- /dev/null +++ b/elpa/org-journal-2.1.2/org-journal-autoloads.el @@ -0,0 +1,147 @@ +;;; org-journal-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "org-journal" "org-journal.el" (0 0 0 0)) +;;; Generated autoloads from org-journal.el + +(add-hook 'calendar-today-visible-hook 'org-journal-mark-entries) + +(add-hook 'calendar-today-invisible-hook 'org-journal-mark-entries) + +(autoload 'org-journal-mode "org-journal" "\ +Mode for writing or viewing entries written in the journal. + +\(fn)" t nil) + +(define-obsolete-function-alias 'org-journal-open-next-entry 'org-journal-next-entry "2.1.0") + +(define-obsolete-function-alias 'org-journal-open-previous-entry 'org-journal-previous-entry "2.1.0") + +(autoload 'org-journal-convert-created-property-timestamps "org-journal" "\ +Convert CREATED property timestamps to `org-journal-created-property-timestamp-format'. + +\(fn OLD-FORMAT)" t nil) + +(autoload 'org-journal-new-entry "org-journal" "\ +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. + +\(fn PREFIX &optional TIME)" t nil) + +(autoload 'org-journal-new-date-entry "org-journal" "\ +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. + +\(fn PREFIX &optional EVENT)" t nil) + +(autoload 'org-journal-new-scheduled-entry "org-journal" "\ +Create a new entry in the future with an active timestamp. + +With non-nil prefix argument create a regular entry instead of a TODO entry. + +\(fn PREFIX &optional SCHEDULED-TIME)" t nil) + +(autoload 'org-journal-reschedule-scheduled-entry "org-journal" "\ +Reschedule an entry in the future. + +\(fn &optional TIME)" t nil) + +(autoload 'org-journal-open-current-journal-file "org-journal" "\ +Open the current journal file" t nil) + +(autoload 'org-journal-invalidate-cache "org-journal" "\ +Clear `org-journal--dates' hash table, and the cache file." t nil) + +(autoload 'org-journal-mark-entries "org-journal" "\ +Mark days in the calendar for which a journal entry is present." t nil) + +(autoload 'org-journal-read-entry "org-journal" "\ +Open journal entry for selected date for viewing. + +\(fn ARG &optional EVENT)" t nil) + +(autoload 'org-journal-display-entry "org-journal" "\ +Display journal entry for selected date in another window. + +\(fn ARG &optional EVENT)" t nil) + +(autoload 'org-journal-read-or-display-entry "org-journal" "\ +Read an entry for the TIME and either select the new window when NOSELECT +is nil or avoid switching when NOSELECT is non-nil. + +\(fn TIME &optional NOSELECT)" nil nil) + +(autoload 'org-journal-next-entry "org-journal" "\ +Go to the next journal entry." t nil) + +(autoload 'org-journal-previous-entry "org-journal" "\ +Go to the previous journal entry." t nil) + +(autoload 'org-journal-search "org-journal" "\ +Search for a string in the journal files. + +See `org-read-date' for information on ways to specify dates. +If a prefix argument is given, search all dates. + +\(fn STR &optional PERIOD-NAME)" t nil) + +(autoload 'org-journal-search-calendar-week "org-journal" "\ +Search for a string within a current calendar-mode week entries. + +\(fn STR)" t nil) + +(autoload 'org-journal-search-calendar-month "org-journal" "\ +Search for a string within a current calendar-mode month entries. + +\(fn STR)" t nil) + +(autoload 'org-journal-search-calendar-year "org-journal" "\ +Search for a string within a current calendar-mode year entries. + +\(fn STR)" t nil) + +(autoload 'org-journal-search-forever "org-journal" "\ +Search for a string within all entries. + +\(fn STR)" t nil) + +(autoload 'org-journal-search-future "org-journal" "\ +Search for a string within all future entries. + +\(fn STR)" t nil) + +(autoload 'org-journal-search-future-scheduled "org-journal" "\ +Search for TODOs within all future entries." t nil) + +(add-hook 'org-journal-mode-hook (lambda nil (add-hook org-journal-encrypt-on 'org-journal-encryption-hook nil t))) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-journal" '("org-journal-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; org-journal-autoloads.el ends here diff --git a/elpa/org-journal-2.1.2/org-journal-pkg.el b/elpa/org-journal-2.1.2/org-journal-pkg.el new file mode 100644 index 0000000..f6df825 --- /dev/null +++ b/elpa/org-journal-2.1.2/org-journal-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from org-journal.el -*- no-byte-compile: t -*- +(define-package "org-journal" "2.1.2" "a simple org-mode based journaling mode" '((emacs "25.1") (org "9.1")) :commit "c26e73a017963f6638044f1f63354c453f2db54a" :authors '(("Bastian Bechtold") ("Christian Schwarzgruber")) :maintainer '("Bastian Bechtold") :url "http://github.com/bastibe/org-journal") diff --git a/elpa/org-journal-2.1.2/org-journal.el b/elpa/org-journal-2.1.2/org-journal.el new file mode 100644 index 0000000..d380011 --- /dev/null +++ b/elpa/org-journal-2.1.2/org-journal.el @@ -0,0 +1,1886 @@ +;;; org-journal.el --- a simple org-mode based journaling mode -*- lexical-binding: t; -*- + +;; Author: Bastian Bechtold +;; Christian Schwarzgruber + +;; URL: http://github.com/bastibe/org-journal +;; Package-Version: 2.1.2 +;; Package-Commit: c26e73a017963f6638044f1f63354c453f2db54a +;; Version: 2.1.2 +;; Package-Requires: ((emacs "25.1") (org "9.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 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-journalf-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." + (turn-on-visual-line-mode) + (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))) + +(global-set-key (kbd "C-c C-j") 'org-journal-new-entry) + +(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)) + (setq result (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) (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) + (setq format (replace-regexp-in-string "%F" "%Y-%m-%d" format)) + (cl-loop + initially (setq format (regexp-quote format)) + for x in org-journal--format-rx-alist + do (setq format (replace-regexp-in-string (car x) (cdr x) format)) + finally return 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 + (format-time-string + (concat "[ \t]*:CREATED:[ \t]+" + (regexp-quote org-journal-created-property-timestamp-format) + "[ \t]*$") + (org-journal--calendar-date->time date)) + 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 CREATED property timestamps 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)) + (insert (if (functionp org-journal-file-header) + (funcall org-journal-file-header time) + (format-time-string org-journal-file-header time))) + (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 (org-journal--get-entry-path time)) + (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)))) + + ;; 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) + (kill-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)) + (kill-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) + (kill-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)) + (kill-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 + (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)) + (setq carryover-item-with-parents (append carryover-item-with-parents (list (cons start (cons end text))))))) + +(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 (date) + "Convert a date as returned from the calendar (MONTH DAY YEAR) to a time." + (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))) + +(defun org-journal--file-name->calendar-date (file-name) + "Convert an org-journal file name to a calendar date. + +Month and Day capture group default to 1." + (let ((file-pattern (org-journal--dir-and-file-format->pattern)) + (day 1) + (month 1) + year + (file (file-truename file-name))) + (setq year (string-to-number + (replace-regexp-in-string file-pattern "\\1" file))) + (when (= year 0) + (user-error "Failed to extract year from file: %s" file)) + + (if (and (not (integerp (string-match "\(\?2:" file-pattern))) + (member org-journal-file-type '(daily weekly monthly))) + (user-error "Failed to extract month from file: %s" file) + (setq month (string-to-number + (replace-regexp-in-string file-pattern "\\2" file)))) + + (if (and (not (integerp (string-match "\(\?3:" file-pattern))) + (member org-journal-file-type '(daily weekly))) + (user-error "Failed to extract day from file: %s" file) + (setq day (string-to-number + (replace-regexp-in-string file-pattern "\\3" file)))) + + (list month day year))) + +(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 ((re (org-journal--format->regex org-journal-created-property-timestamp-format)) + date) + (setq date (org-entry-get (point) "CREATED")) + (unless (ignore-errors (string-match re date)) + (user-error "Created property timestamp format \"%s\" doesn't match CREATED property value (%s) from entry at line: %s" org-journal-created-property-timestamp-format date (what-line))) + (list (string-to-number (match-string 2 date)) ;; Month + (string-to-number (match-string 3 date)) ;; Day + (string-to-number (match-string 1 date))))) ;; Year + +(defun org-journal--file->calendar-dates (file) + "Return journal dates from FILE." + (org-journal--with-journal + file + (let (dates) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-journal--created-re nil t) + (when (= (save-excursion (org-back-to-heading) (org-outline-level)) 1) + (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 (or (ignore-errors (org-journal--calendar-date->time (calendar-cursor-to-date t event))) + (org-time-string-to-time (org-read-date nil nil nil "Date:"))))) + (if (time-less-p time (current-time)) + (org-journal-new-entry prefix time) + (org-journal-new-scheduled-entry prefix time)))) + +;;;###autoload +(defun org-journal-new-scheduled-entry (prefix &optional scheduled-time) + "Create a new entry in the future with an active timestamp. + +With non-nil prefix argument create a regular entry instead of a TODO entry." + (interactive "P") + (let ((time (or scheduled-time (org-time-string-to-time (org-read-date nil nil nil "Date:")))) + org-journal-carryover-items) + (when (time-less-p time (current-time)) + (user-error "Scheduled time needs to be in the future")) + (org-journal-new-entry nil time) + (unless prefix + (insert "TODO ")) + (save-excursion + (insert "\n") + (org-insert-time-stamp time)))) + +;;;###autoload +(defun org-journal-reschedule-scheduled-entry (&optional time) + "Reschedule an entry in the future." + (interactive "P") + (or time (setq time (org-time-string-to-time (org-read-date nil nil nil "Data:")))) + (when (time-less-p time (current-time)) + (user-error "Scheduled time needs to be in the future")) + (save-excursion + (save-restriction + (org-back-to-heading) + (org-narrow-to-subtree) + (if (re-search-forward org-ts-regexp (line-end-position 2) t) + (replace-match "") + (org-end-of-subtree) + (insert "\n")) + (org-insert-time-stamp time) + (org-cut-subtree)) + (let (org-journal-carryover-items) + (org-save-outline-visibility t + (org-journal-new-entry t time) + (when (looking-back "[^\t ]" (point-at-bol) t) + (insert "\n")) + (org-yank))))) + +(defun org-journal--goto-entry (date) + "Goto DATE entry in current journal file." + (widen) + (goto-char (point-min)) + (if (org-journal--daily-p) + (outline-next-visible-heading 1) + (org-journal--search-forward-created date)) + (org-journal--finalize-view)) + +(defun org-journal-sort-dates (dates calendar-date prev) + "Sorts DATES to determine the order of journal entries. + +Can be advised/replaced by a user." + (unless (member calendar-date dates) + (setq dates (copy-tree dates)) + (cl-loop + for date in dates + while (org-journal--calendar-date-compare date calendar-date) + count t into cnt + finally (if (> cnt 0) + ;; Insert new date into list + (setcdr (nthcdr (1- cnt) dates) (cons calendar-date (nthcdr cnt dates))) + ;; Insert new date at front + (setq dates (cons calendar-date dates))))) + ;; Reverse list for previous search. + (if prev (reverse dates) dates)) + +(defun org-journal--open-entry (&optional prev no-select) + "Open journal entry. + +If PREV is non-nil, open previous entry instead of next. +If NO-SELECT is non-nil, open it, but don't show it." + (let* ((calendar-date (if (org-journal--daily-p) + (org-journal--file-name->calendar-date (file-truename (buffer-file-name))) + (while (org-up-heading-safe)) + (org-journal--entry-date->calendar-date))) + (view-mode-p view-mode) + (dates (org-journal-sort-dates (org-journal--list-dates) calendar-date prev))) + (while (and dates (car dates) + (or (if prev + (org-journal--calendar-date-compare calendar-date (car dates)) + (org-journal--calendar-date-compare (car dates) calendar-date)) + (calendar-date-equal (car dates) calendar-date))) + (setq dates (cdr dates))) + (if (and dates (car dates)) + (let ((filename (org-journal--get-entry-path + (org-journal--calendar-date->time (car dates))))) + (if (get-file-buffer filename) + (progn + (if no-select + (set-buffer (get-file-buffer filename)) + (switch-to-buffer (get-file-buffer filename))) + (setq org-journal--kill-buffer nil)) + (push (if no-select + (set-buffer (find-file-noselect filename)) + (find-file filename)) + org-journal--kill-buffer)) + (org-journal--goto-entry (car dates)) + (view-mode (if view-mode-p 1 -1)) + t) + nil))) + +;;;###autoload +(defun org-journal-open-current-journal-file () + "Open the current journal file" + (interactive) + (let ((org-journal-file (org-journal--get-entry-path))) + (if (file-exists-p org-journal-file) + (progn + (funcall org-journal-find-file org-journal-file) + (unless (org-journal--daily-p) + (let ((last-entry-date (car (org-journal--file->calendar-dates org-journal-file)))) + (when last-entry-date + (org-journal--goto-entry last-entry-date))))) + (message "Journal file %s not found" org-journal-file)))) + +(defun org-journal--list-files () + "Returns a list of all files in the journal directory." + (org-journal--create-journal-dir) + ;; 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--dir-and-file-format->pattern) file-path) + (or org-journal-encrypt-journal + (not (string-match-p "\.gpg$" file-path))))))) + (seq-filter predicate file-list))) + +(defconst org-journal--cache-file + (expand-file-name "org-journal.cache" user-emacs-directory) + "Cache file for `org-journal--dates'.") + +(defvar org-journal--dates (make-hash-table :test 'equal) + "Hash table for journal dates. + +The key is a journal date entry, and the value of the key is of the form +\(FILENAME \(FILE MODIFICATION TIME\)\).") + +;;;###autoload +(defun org-journal-invalidate-cache () + "Clear `org-journal--dates' hash table, and the cache file." + (interactive) + (clrhash org-journal--dates) + (when org-journal-enable-cache + (org-journal--serialize))) + +(defun org-journal--file-modification-time (file) + (nth 5 (file-attributes file))) + +(defun org-journal--dates-puthash (&optional file) + (or file (setq file (buffer-file-name))) + (let ((mtime (org-journal--file-modification-time file))) + (if (org-journal--daily-p) + (puthash (org-journal--file-name->calendar-date file) (list file mtime) org-journal--dates) + ;; Remove any key where (car value) equals FILE + (cl-loop for key being the hash-keys of org-journal--dates + when (string-equal (car (gethash key org-journal--dates)) file) + do (remhash key org-journal--dates)) + (dolist (date (org-journal--file->calendar-dates file)) + (puthash date (list file mtime) org-journal--dates))))) + +(defun org-journal--serialize () + "Write hashmap to file." + (when org-journal-enable-cache + (unless (file-directory-p (file-name-directory org-journal--cache-file)) + (make-directory (file-name-directory org-journal--cache-file) t)) + (if (file-writable-p org-journal--cache-file) + (with-temp-file org-journal--cache-file + (let (print-length) + (insert (prin1-to-string org-journal--dates)))) + (error "%s is not writable" org-journal--cache-file))) + (org-journal--sort-dates)) + +(defun org-journal--deserialize () + "Read hashmap from file." + (when org-journal-enable-cache + (with-demoted-errors + "Error during file deserialization: %S" + (when (file-exists-p org-journal--cache-file) + (with-temp-buffer + (insert-file-contents org-journal--cache-file) + (setq org-journal--dates (read (buffer-substring (point-at-bol) (point-at-eol)))))))) + (org-journal--sort-dates)) + +(defvar org-journal--sorted-dates nil) + +(defun org-journal--sort-dates () + "Flatten and sort dates, and assign the result to `org-journal-flatten-dates'." + (setq org-journal--sorted-dates (sort (hash-table-keys org-journal--dates) 'org-journal--calendar-date-compare))) + +(defun org-journal--list-dates () + "Return all journal dates. + +The list ((month day year) ...) contains calendar dates, and is sorted +from oldest to newest." + (let ((files (org-journal--list-files)) + reparse-files serialize-p + rem-keys) + (when (hash-table-empty-p org-journal--dates) + (org-journal--deserialize) + (when (hash-table-empty-p org-journal--dates) + (dolist (file files) + (org-journal--dates-puthash file)) + (setq serialize-p t))) + ;; Verify modification time is unchanged, if we have already data. + (unless serialize-p + (cl-loop + with (value files-in-hash file) + for key being the hash-keys of org-journal--dates + always (setq value (gethash key org-journal--dates) + file (car value)) + do + (unless (member (car value) files) + (unless (member key rem-keys) + (push key rem-keys))) + (unless (member file files-in-hash) + (push file files-in-hash) + (unless (equal (cadr value) (org-journal--file-modification-time file)) + (when (and (member file files) (not (member file reparse-files))) + (push file reparse-files)))) + finally (dolist (file files) ;; Are there any new files + (unless (member file files-in-hash) + (push file reparse-files))))) + (when rem-keys + (dolist (k rem-keys) + (remhash k org-journal--dates)) + (setq serialize-p t)) + (when reparse-files + (dolist (f reparse-files) + (org-journal--dates-puthash f)) + (setq serialize-p t)) + (when serialize-p + (org-journal--serialize)) + org-journal--sorted-dates)) + +;;;###autoload +(defun org-journal-mark-entries () + "Mark days in the calendar for which a journal entry is present." + (interactive) + (when (file-exists-p org-journal-dir) + (let ((current-time (current-time))) + (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))) + +(defun org-journal--finalize-view () + "Finalize visability of entry." + (org-journal--decrypt) + (if (org-journal--is-date-prefix-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)) + (buf-exists (get-file-buffer org-journal-file)) + buf point) + (if (and (when (file-exists-p org-journal-file) + (setq buf (find-file-noselect org-journal-file))) + ;; If daily continue with than clause of if condition + (or (org-journal--daily-p) + ;; Search for journal entry + (with-current-buffer buf + (save-mark-and-excursion + (goto-char (point-min)) + (setq time (decode-time time)) + (setq point (org-journal--search-forward-created + (list (nth 4 time) (nth 3 time) (nth 5 time)) + nil t)))))) + (progn + ;; Use `find-file-noselect' instead of `view-file' as it does not respect `auto-mode-alist' + (with-current-buffer buf + ;; Open file in view-mode if not opened already. + (unless buf-exists + (view-mode) + (setq view-exit-action 'kill-buffer)) + (set (make-local-variable 'org-hide-emphasis-markers) t) + (if (org-journal--daily-p) + (when (org-journal--is-date-prefix-org-heading-p) + (goto-char (point-min)) + (re-search-forward (concat org-journal-date-prefix + (if (functionp org-journal-date-format) + (funcall org-journal-date-format time) + (format-time-string org-journal-date-format time))))) + (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) + buf) + (message "No journal entry for this date.")))) + +(defun org-journal--next-entry (&optional prev) + "Go to next entry. + +If prev is non-nil open previous entry instead of next." + (unless (cond + ((eq major-mode 'calendar-mode) + (let ((dates (if prev + (reverse (org-journal--list-dates)) + (org-journal--list-dates)))) + (while (and dates + (not (if prev + (org-journal--calendar-date-compare (car dates) (calendar-cursor-to-date)) + (org-journal--calendar-date-compare (calendar-cursor-to-date) (car dates))))) + (setq dates (cdr dates))) + (when dates + (calendar-goto-date (car dates)) + (when org-journal-follow-mode + (org-journal-display-entry nil))))) + ((eq major-mode 'org-journal-mode) + (org-journal--open-entry prev)) + (t + (user-error + (concat "org-journal-" (if prev "previous" "next") + "-entry called outside calendar/org-journal mode")))) + (message (concat "No journal entry " (if prev "before" "after") " this one")))) + +;;;###autoload +(defun org-journal-next-entry () + "Go to the next journal entry." + (interactive) + (org-journal--next-entry)) + +;;;###autoload +(defun org-journal-previous-entry () + "Go to the previous journal entry." + (interactive) + (org-journal--next-entry t)) + +;;; Journal search facilities + +;;;###autoload +(defun org-journal-search (str &optional period-name) + "Search for a string in the journal files. + +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)))) + ;; Including period-start in search + (setcar (cdr start) (1- (cadr start))) + ;; Including period-end in search + (setcar (cdr end) (1+ (cadr end))) + (org-journal--search-by-string str start end))) + +(defvar org-journal-search-history nil) + +;;;###autoload +(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)) + +;;;###autoload +(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)) + +;;;###autoload +(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)) + +;;;###autoload +(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)) + +;;;###autoload +(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)) + +;;;###autoload +(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)." + (declare (indent 1)) + `(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))) +(def-edebug-spec org-journal--with-find-file (form body)) + +(defun org-journal--update-org-agenda-files () + "Adds the current and future journal files to `org-agenda-files' containing TODOs, +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--dir-and-file-format->pattern) fname))) + (org-agenda-files))) + (org-journal-agenda-files + (let* ((future (org-journal--read-period 'future)) + (beg (car future)) + (end (cdr future))) + (setcar (cdr beg) (1- (cadr beg))) ;; Include today; required for `org-journal--search-build-file-list' + (when (< (nth 2 (decode-time (current-time))) org-extend-today-until) + (setq beg (decode-time (apply #'encode-time `(0 59 -1 ,(nth 1 beg) ,(nth 0 beg) ,(nth 2 beg)))) + beg (list (nth 4 beg) (nth 3 beg) (nth 5 beg)))) + (org-journal--search-build-file-list + (org-journal--calendar-date->time beg) + (org-journal--calendar-date->time end))))) + (org-store-new-agenda-file-list (append not-org-journal-agenda-files + org-journal-agenda-files))))) + +(defvar org-journal--schedule-buffer-name "*Org-journal schedule*") + +(defun org-journal-schedule-view () + "Opens a new window with all scheduled journal entries. + +Think of this as a faster, less fancy version of your `org-agenda'." + (interactive) + + (when (get-buffer org-journal--schedule-buffer-name) + (kill-buffer org-journal--schedule-buffer-name)) + + (with-current-buffer (get-buffer-create org-journal--schedule-buffer-name) + (org-mode) + (insert "#+TITLE: Org-Journal Schedule\n\n") + (goto-char (point-max))) + + (cl-loop + with copy-mapper = (lambda () + (let ((subtree (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 + (backward-char) + (setq org-map-continue-from (point)) + subtree)) + with (content-to-copy journal-buffers) + with today = (current-time) + for date in (org-journal--list-dates) + always (setq date (org-journal--calendar-date->time date)) + when (time-less-p today date) + do + (cl-pushnew (org-journal-read-or-display-entry date) journal-buffers) + (with-current-buffer org-journal--schedule-buffer-name + (if (functionp org-journal-date-format) + (insert (funcall org-journal-date-format date)) + (insert org-journal-date-prefix + (format-time-string org-journal-date-format date) + "\n"))) + (save-restriction + (org-narrow-to-subtree) + (setq content-to-copy (org-map-entries + copy-mapper + "+TIMESTAMP>=\"\"|+SCHEDULED>=\"\""))) + (when content-to-copy + (with-current-buffer org-journal--schedule-buffer-name + (insert (mapconcat (lambda (item) (cddar item)) content-to-copy "") + "\n"))) + finally + (mapc (lambda (b) + (with-current-buffer b + (when view-mode + (kill-buffer)))) + journal-buffers)) + + (with-current-buffer org-journal--schedule-buffer-name + (set-buffer-modified-p nil) + (view-mode t) + (goto-char (point-min))) + + (switch-to-buffer org-journal--schedule-buffer-name)) + +(defun org-journal--read-period (period-name) + "Return read period. + +If the PERIOD-NAME is nil, then ask the user for period start/end. +If PERIOD-NAME is 'forever, set the period from the beginning of time +to eternity. If PERIOD-NAME is a symbol equal to 'week, 'month or 'year +then use current week, month or year from the calendar, accordingly." + (cond + ;; no period-name? ask the user for input + ((not period-name) + (let* ((org-read-date-prefer-future nil) + (absolute-start (time-to-days (org-read-date nil t nil "Enter the search start"))) + (absolute-end (time-to-days (org-read-date nil t nil "Enter the search end"))) + (start (calendar-gregorian-from-absolute absolute-start)) + (end (calendar-gregorian-from-absolute absolute-end))) + (cons start end))) + + ;; eternity start/end + ((eq period-name 'forever) + (cons (list 1 1 1971) + (list 12 31 2030))) + + ;; future start/end + ((eq period-name 'future) + (let ((date (decode-time (current-time)))) + (cons (list (nth 4 date) (nth 3 date) (nth 5 date)) + (list 12 31 2030)))) + + ;; extract a year start/end using the calendar curson + ((and (eq period-name 'year) (eq major-mode 'calendar-mode)) + (calendar-cursor-to-nearest-date) + (let* ((date (calendar-cursor-to-date)) + (year (calendar-extract-year date)) + (jan-first (list 1 1 year)) + (dec-31 (list 12 31 year))) + (cons jan-first + dec-31))) + + ;; month start/end + ((and (eq period-name 'month) (eq major-mode 'calendar-mode)) + (calendar-cursor-to-nearest-date) + (let* ((date (calendar-cursor-to-date)) + (year (calendar-extract-year date)) + (month (calendar-extract-month date)) + (last-day (calendar-last-day-of-month month year))) + (cons (list month 1 year) + (list month last-day year)))) + + ;; week start/end + ((and (eq period-name 'week) (eq major-mode 'calendar-mode)) + (calendar-cursor-to-nearest-date) + (let* ((date (calendar-cursor-to-date)) + (absoluteday (calendar-absolute-from-gregorian date)) + (weekday (calendar-day-of-week date)) + (zerobased-weekday (- weekday calendar-week-start-day)) + (absolute-start (- absoluteday zerobased-weekday)) + (absolute-end (+ absoluteday (- 7 zerobased-weekday))) + (start (calendar-gregorian-from-absolute absolute-start)) + (end (calendar-gregorian-from-absolute absolute-end))) + (cons start end))) + + (t (user-error "Wrong period-name given or not in the calendar mode")))) + +(defun org-journal--search-by-string (str &optional period-start period-end) + "Search for a string within a given time interval. + +If STR is empty, search for all entries using `org-journal-time-prefix'." + (when (time-less-p period-end period-start) + (user-error "Period end cannot be before the start")) + (let* ((search-str (if (string= "" str) org-journal-time-prefix str)) + (files (org-journal--search-build-file-list period-start period-end)) + (results (org-journal--search-do-search search-str files)) + (buf (get-buffer-create org-journal--search-buffer)) + (inhibit-read-only t)) + (unless (get-buffer-window buf 0) + (switch-to-buffer buf)) + (with-current-buffer buf + (org-journal-search-mode) + (erase-buffer) + (org-journal--search-print-results str results period-start period-end) + (goto-char (point-min)) + (forward-button 1) + (button-activate (button-at (point)))))) + +(defun org-journal--search-build-file-list (period-start period-end) + "Build a list of journal files within a given time interval." + (unless (and period-start period-end ;; Check for null values + (car period-start) (cdr period-start) + (car period-end) (cdr period-end)) + (user-error "Time `%s' and/or `%s' are not valid" period-start period-end)) + + (let (result filetime) + (dolist (file (org-journal--list-files)) + (setq filetime (org-journal--calendar-date->time + (org-journal--file-name->calendar-date file))) + (when (and + (time-less-p + period-start + ;; Convert to period-start boundary. + (pcase org-journal-file-type + ;; For daily, filetime is period-start boundary. + (`daily filetime) + ;; For weekly, filetime +6 days is period-start boundary. + (`weekly + (let* ((time (decode-time filetime)) + (day (+ 6 (nth 3 time))) ;; End of week + (month (nth 4 time)) + (year (nth 5 time)) + (last-day-of-month (calendar-last-day-of-month month year))) + (when (> day last-day-of-month) + (setq day (- day last-day-of-month)) + (when (= month 12) + (setq month 0) + (setq year (1+ year))) + (setq month (1+ month))) + (org-journal--calendar-date->time (list month day year)))) + ;; For monthly, end of month is period-start boundary. + (`monthly + (let* ((time (decode-time filetime)) + (month (nth 4 time)) + (year (nth 5 time)) + (day (calendar-last-day-of-month month year))) + (org-journal--calendar-date->time (list month day year)))) + ;; For yearly, end of year is period-start boundary. + (`yearly + (org-journal--calendar-date->time (list 12 31 (nth 5 (decode-time filetime))))))) + (time-less-p filetime period-end)) + (push file result))) + result)) + +(defun org-journal--search-do-search (str files) + "Search for a string within a list of files, return match pairs (PATH . LINENUM)." + (let (results result) + (dolist (fname (reverse files)) + (setq result (org-journal--with-journal + fname + (when org-journal-enable-encryption + (goto-char (point-min)) + (while (search-forward ":crypt:" nil t) + (org-decrypt-entry))) + (goto-char (point-min)) + (while (funcall org-journal-search-forward-fn str nil t) + (push + (list + (let ((date + (if (org-journal--daily-p) + (org-journal--file-name->calendar-date fname) + (save-excursion + (when (re-search-backward org-journal--created-re nil t) + (when (= (save-excursion (org-back-to-heading) (org-outline-level)) 1) + (org-journal--entry-date->calendar-date))))))) + (when date + (org-journal--calendar-date->time date))) + (- (point) (length str)) + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + result)) + result)) + (when result + (mapc (lambda (res) (push res results)) result))) + (cond + ((eql org-journal-search-results-order-by :desc) results) + (t (reverse results))))) + +(defun org-journal--search-format-date (time) + "Format TIME according to `org-journal-search-result-date-format'." + (format-time-string org-journal-search-result-date-format time)) + +(defun org-journal--search-next () + (interactive) + (forward-button 1 t) + (button-activate (button-at (point)))) + +(defun org-journal--search-prev () + (interactive) + (backward-button 1 t) + (button-activate (button-at (point)))) + +(defvar org-journal-search-mode-map nil + "Keymap for *Org-journal search* buffers.") +(unless org-journal-search-mode-map + (setq org-journal-search-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'kill-this-buffer) + (define-key map (kbd "") 'org-journal--search-next) + (define-key map (kbd "") 'org-journal--search-prev) + (define-key map "n" 'org-journal--search-next) + (define-key map "p" 'org-journal--search-prev) + map))) +(fset 'org-journal-search-mode-map org-journal-search-mode-map) + +(define-derived-mode org-journal-search-mode special-mode + "org-journal-search" + "Major mode for displaying org-journal search results. +\\{org-journal-search-mode-map}." + (use-local-map org-journal-search-mode-map) + (setq truncate-lines t + buffer-undo-list t) + (hl-line-mode 1)) + +(defun org-journal--search-print-results (str results period-start period-end) + "Print search results using text buttons." + (let ((label-start (org-journal--search-format-date period-start)) + (label-end (org-journal--search-format-date period-end))) + (insert (concat "Search results for \"" str "\" between " + label-start " and " label-end + ": \n\n"))) + (let (point fullstr time label) + (dolist (res results) + (setq time (nth 0 res) + point (nth 1 res) + fullstr (nth 2 res) + label (and time (org-journal--search-format-date time))) + ;; Filter out entries not within period-start/end for weekly/monthly/yearly journal files. + (when (or (org-journal--daily-p) + (and time + (time-less-p period-start time) + (time-less-p time period-end))) + (insert-text-button label + 'action 'org-journal--search-follow-link-action + 'org-journal-link (cons point time)) + (insert "\t" fullstr "\n")))) + (org-journal-highlight str)) + +(defun org-journal--search-follow-link-action (button) + "Follow the link using info saved in button properties." + (let* ((target (button-get button 'org-journal-link)) + (point (car target)) + (time (cdr target)) + (buf (org-journal-read-or-display-entry time t))) + (set-window-point (get-buffer-window buf) point))) + +(defun org-journal-re-encrypt-journals (recipient) + "Re-encrypt journal files." + (interactive (list (epa-select-keys (epg-make-context epa-protocol) + "Select new recipient for encryption. +Only one recipient is supported. "))) + + (unless recipient + (user-error "You need to specify exactly one recipient")) + + (unless org-journal-encrypt-journal + (user-error "org-journal encryption not enabled")) + + (cl-loop + with buf + with kill-buffer + for journal in (org-journal--list-files) + do + (setq buf (get-file-buffer journal) + kill-buffer nil) + + (when (and buf + (buffer-modified-p buf) + (y-or-n-p (format "Journal \"%s\" modified, save before re-encryption?" + (file-name-nondirectory journal)))) + (save-buffer buf)) + + (unless buf + (setq kill-buffer t + buf (find-file-noselect journal))) + + (with-current-buffer buf + (let ((epa-file-encrypt-to (epg-sub-key-id (car (epg-key-sub-key-list (car recipient)))))) + (set-buffer-modified-p t) + (save-buffer) + (when kill-buffer + (kill-buffer)))))) + +(defun org-journal--decrypt () + "Decrypt journal entry at point." + (when org-journal-enable-encryption + (let ((buffer-read-only nil)) + (org-decrypt-entries)))) + +(defun org-journal-encryption-hook () + "The function added to the hook specified by `org-journal-encrypt-on'." + (when org-journal-enable-encryption + (org-encrypt-entries) + (unless (equal org-journal-encrypt-on + 'before-save-hook) + (save-buffer)))) + +;; Setup encryption by default +;;;###autoload +(add-hook 'org-journal-mode-hook + (lambda () (add-hook org-journal-encrypt-on + 'org-journal-encryption-hook + nil t))) + +(provide 'org-journal) + +;;; org-journal.el ends here diff --git a/settings.org b/settings.org index eb56a02..1debec4 100644 --- a/settings.org +++ b/settings.org @@ -415,6 +415,12 @@ This handy function is a customized ripoff of custom-save-all (use-package git-commit :hook (git-commit-setup . git-commit-turn-on-flyspell))) #+end_src +** Org Journal +#+begin_src emacs-lisp + (use-package org-journal + :bind + ("C-c TAB" . org-journal-new-entry)) +#+end_src ** Python *** Platform specific Set python command