diff options
Diffstat (limited to 'lisp/ss-capture.el')
| -rw-r--r-- | lisp/ss-capture.el | 175 |
1 files changed, 175 insertions, 0 deletions
diff --git a/lisp/ss-capture.el b/lisp/ss-capture.el new file mode 100644 index 0000000..f930716 --- /dev/null +++ b/lisp/ss-capture.el @@ -0,0 +1,175 @@ +;;; ss-capture.el --- Capture configuration -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Journal capture helpers and capture templates. + +;;; Code: + +(require 'calendar) +(require 'org) +(require 'org-capture) +(require 'ss-core) +(require 'ss-org) + +(defun ss-journal-capture-time () + "Return the effective timestamp for the current journal capture." + (or org-overriding-default-time + (org-capture-get :default-time) + (current-time))) + +(defun ss-journal-calendar-date (&optional time) + "Return TIME as a Gregorian date list for datetree helpers." + (calendar-gregorian-from-absolute + (time-to-days (or time (current-time))))) + +(defun ss-journal-year-heading (&optional time) + "Return the journal year heading text for TIME." + (format-time-string "%Y" (or time (current-time)))) + +(defun ss-journal-day-heading (&optional time) + "Return the journal day heading text for TIME." + (format-time-string "%Y-%m-%d %A" (or time (current-time)))) + +(defun ss-journal-find-or-create-heading (level heading) + "Move to HEADING at LEVEL, creating it when missing." + (goto-char (point-min)) + (if (re-search-forward + (format "^%s %s$" + (make-string level ?*) + (regexp-quote heading)) + nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (make-string level ?*) " " heading "\n") + (forward-line -1)) + (org-back-to-heading t)) + +(defun ss-journal-goto-date (&optional time create) + "Move to TIME's journal date heading. +When CREATE is non-nil, create the datetree entry when missing." + (goto-char (point-min)) + (if create + (let ((year-heading (ss-journal-year-heading time)) + (day-heading (ss-journal-day-heading time))) + (ss-journal-find-or-create-heading 1 year-heading) + (save-restriction + (org-narrow-to-subtree) + (ss-journal-find-or-create-heading 2 day-heading)) + t) + (when (re-search-forward + (format "^\\*\\* %s$" + (regexp-quote + (ss-journal-day-heading (or time (current-time))))) + nil t) + (goto-char (match-beginning 0)) + t))) + +(defun ss-journal-ensure-day-sections () + "Ensure the standard section headings exist under the current journal day." + (org-back-to-heading t) + (let ((section-level (1+ (org-outline-level)))) + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (dolist (section ss-journal-section-headings) + (goto-char (point-min)) + (unless (org-find-exact-headline-in-buffer section) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (make-string section-level ?*) " " section "\n"))))))) + +(defun ss-journal-goto-section (section &optional time) + "Move to SECTION beneath TIME's journal date, creating structure as needed." + (unless (member section ss-journal-section-headings) + (user-error "Unknown journal section: %s" section)) + (ss-journal-goto-date time 'create) + (ss-journal-ensure-day-sections) + (let ((section-level (1+ (org-outline-level))) + position) + (save-restriction + (org-narrow-to-subtree) + (goto-char (point-min)) + (when (re-search-forward + (format "^%s %s$" + (make-string section-level ?*) + (regexp-quote section)) + nil t) + (setq position (match-beginning 0)))) + (unless position + (user-error "Journal section not found: %s" section)) + (goto-char position) + (org-back-to-heading t))) + +(defun ss-journal-capture-target (section) + "Select SECTION under today's journal datetree entry for capture." + (set-buffer (find-file-noselect (ss-require-existing-file ss-journal-file))) + (widen) + (ss-journal-goto-section section (ss-journal-capture-time))) + +(defun ss-capture--denote-templates () + "Return Denote-backed capture templates when Denote is enabled." + (when (ss-feature-enabled-p 'denote) + `(("n" "Denote") + ("nn" "Generic" plain + (file denote-last-path) + (function + (lambda () + (denote-org-capture-with-prompts :title :keywords :subdirectory))) + :no-save t + :immediate-finish nil + :kill-buffer t + :jump-to-captured t) + ("np" "Project" plain + (file denote-last-path) + (function + (lambda () + (ss-denote-capture-in-directory + ss-org-projects-directory '("project") :title :keywords :subdirectory))) + :no-save t + :immediate-finish nil + :kill-buffer t + :jump-to-captured t) + ("na" "Area" plain + (file denote-last-path) + (function + (lambda () + (ss-denote-capture-in-directory + ss-org-areas-directory nil :title :keywords :subdirectory))) + :no-save t + :immediate-finish nil + :kill-buffer t + :jump-to-captured t) + ("nr" "Resource" plain + (file denote-last-path) + (function + (lambda () + (ss-denote-capture-in-directory + ss-org-resources-directory nil :title :keywords :subdirectory))) + :no-save t + :immediate-finish nil + :kill-buffer t + :jump-to-captured t)))) + +(defun ss-capture-setup () + "Initialize capture templates." + (setq org-capture-templates + (append + '(("j" "Journal") + ("jt" "Task" entry + (function (lambda () (ss-journal-capture-target "Tasks"))) + "* TODO %?") + ("jn" "Note" entry + (function (lambda () (ss-journal-capture-target "Notes"))) + "* %?") + ("jm" "Meeting" entry + (function (lambda () (ss-journal-capture-target "Meetings"))) + "* <%<%Y-%m-%d %H:%M>> %?")) + (ss-capture--denote-templates)))) + +(provide 'ss-capture) + +;;; ss-capture.el ends here |