1311 lines
52 KiB
EmacsLisp
1311 lines
52 KiB
EmacsLisp
;;; oni-org.el --- Org mode configuration -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2019 Tom Willemse
|
||
|
||
;; Author: Tom Willemse <tom@ryuslash.org>
|
||
;; Keywords: local
|
||
;; Version: 2024.0509.130831
|
||
;; Package-Requires: (oni-yasnippet oni-alert oni-hydra org org-bullets org-edna diminish all-the-icons olivetti form-feed org-pretty-table ob-async org-ql org-super-agenda)
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Configuration for `org-mode'. The icons used in
|
||
;; ‘org-agenda-category-icon-alist’ are from the following sites:
|
||
|
||
;; - bx*-*.svg: https://boxicons.com/ (bxs for Solid, and bx for not solid)
|
||
;; - mat-*.svg: https://fonts.google.com/icons?selected=Material+Icons
|
||
;; - bs-*.svg: https://icons.getbootstrap.com/
|
||
|
||
;; Add the following to your init file if you want to use this configuration:
|
||
;;
|
||
;; (with-eval-after-load 'org (require 'oni-org))
|
||
|
||
;;; Code:
|
||
|
||
(require 'color)
|
||
(require 'diminish)
|
||
(require 'hydra)
|
||
(require 'ob)
|
||
(require 'ob-async)
|
||
(require 'org)
|
||
(require 'org-clock)
|
||
(require 'org-edna)
|
||
(require 'org-element)
|
||
(require 'org-faces)
|
||
(require 'org-habit)
|
||
(require 'org-protocol)
|
||
(require 'org-ql)
|
||
(require 'org-roam)
|
||
(require 'org-super-agenda)
|
||
(require 'range)
|
||
(require 'subr-x)
|
||
(require 'yasnippet)
|
||
|
||
;;; Constants
|
||
|
||
(defconst oni-org-root
|
||
(file-name-directory
|
||
(or load-file-name
|
||
(buffer-file-name)))
|
||
"The directory where ‘oni-org’ was loaded from.")
|
||
|
||
(defconst oni-org-snippets-dir
|
||
(expand-file-name "snippets" oni-org-root)
|
||
"The directory where ‘oni-org’ stores its snippets.")
|
||
|
||
(defconst oni-org-icons-dir
|
||
(expand-file-name "icons" oni-org-root)
|
||
"The directory where ‘oni-org’ stores its icons.")
|
||
|
||
(defconst oni-org-todo-dir
|
||
(expand-file-name "documents/exocortex-novus/tasks" (getenv "HOME"))
|
||
"The directory where all the TODO notes are stored.")
|
||
|
||
(defconst oni-org-todo-inbox-file
|
||
(expand-file-name "inbox.org" oni-org-todo-dir)
|
||
"The inbox file for any notes.")
|
||
|
||
(defconst oni-org-todo-main-file
|
||
(expand-file-name "todo.org" oni-org-todo-dir)
|
||
"The main file for TODO notes.")
|
||
|
||
(defconst oni-org-todo-someday-file
|
||
(expand-file-name "someday.org" oni-org-todo-dir)
|
||
"The file for TODO notes I will want to do some day, but not today.")
|
||
|
||
(defconst oni-org-todo-tickler-file
|
||
(expand-file-name "tickler.org" oni-org-todo-dir)
|
||
"The tickler file for TODO notes of the future.")
|
||
|
||
;;; Fake org-roam -- oni-org-exocortex
|
||
;; I tried using org-roam v2 with Orgro, but it didn’t work. I’ve only been
|
||
;; using org-roam to more easily find and insert strings. The file renaming in
|
||
;; v1 always seemed to have some issue, so I never really used that. And I
|
||
;; didn’t even look any further into any of the functionality. So these
|
||
;; functions are my re-implementation of the convenience of org-roam. This way
|
||
;; Orgro still works and I can easily build up my knowledge base as well. I call
|
||
;; it fake org-roam for now because I’m too tired to think of anything else,
|
||
;; it’s not actually enough to be a fake anything.
|
||
|
||
(eval-when-compile (require 'cl-macs))
|
||
|
||
(defvar oni-org-exocortex-directory (expand-file-name "~/documents/org"))
|
||
|
||
;; Expected (I need to turn these into tests):
|
||
|
||
;; - C++ :: c
|
||
;; - Crafting Interpreters - 10 - Fucntions - Native Functions :: crafting_interpreters_10_functions_native_functions
|
||
|
||
;; This is a helper function to turn the strings into the same kind of slugs
|
||
;; that org-roam uses so I stay consistent in my naming.
|
||
(defun oni-org--slugify (str)
|
||
"Turn STR into a filesystem-safe slug."
|
||
(let ((regexp (rx (one-or-more (not alphanumeric)))))
|
||
(downcase
|
||
(replace-regexp-in-string regexp "_" (string-trim-right str regexp)))))
|
||
|
||
;; This mimicks the file name pattern of org-roam with a date and time, followed
|
||
;; by a filesystem-safe slug of the actual title.
|
||
(defun oni-org--create-name (title)
|
||
(interactive "MTitle: ")
|
||
(format "%s-%s.org"
|
||
(format-time-string "%Y%m%d%H%M%S")
|
||
(oni-org--slugify title)))
|
||
|
||
;; Collect all of the files under the ‘oni-org-exocortex-directory’. org-roam indexes
|
||
;; all of the files in a database, but I really didn’t want to recreate that
|
||
;; today. For the moment I don’t have so many files that parsing all of them
|
||
;; like this is a huge problem.
|
||
(defun oni-org--get-exocortex-files ()
|
||
(cl-labels ((add-titles (file)
|
||
(list (with-temp-buffer
|
||
(insert-file-contents (expand-file-name file))
|
||
(goto-char (point-min))
|
||
(let ((line-end-position (line-end-position)))
|
||
(when (search-forward ":" line-end-position t)
|
||
(buffer-substring-no-properties (1+ (point)) line-end-position))))
|
||
file))
|
||
(unimportant-file-p (file)
|
||
(or (string-prefix-p "." (file-name-nondirectory file))
|
||
(string-match-p (rx bos "#" (one-or-more any) "#" eos) (file-name-nondirectory file))))
|
||
(unimportant-directory-p (directory)
|
||
(not (string-match-p (rx "/.") directory))))
|
||
(mapcar #'add-titles
|
||
(cl-delete-if #'unimportant-file-p
|
||
(directory-files-recursively oni-org-exocortex-directory (rx bos (repeat 14 digit) "-" (one-or-more (any alphanumeric "_")) ".org") nil #'unimportant-directory-p)))))
|
||
|
||
;; Find and visit a file in the ‘oni-org-exocortex-directory’. If the file doesn’t
|
||
;; exist yet, it’s created and the title is inserted into it.
|
||
(defun oni-org-find-exocortex-file ()
|
||
(interactive)
|
||
(let* ((default-directory oni-org-exocortex-directory)
|
||
(completions (oni-org--get-exocortex-files))
|
||
(pick (completing-read "File: " completions))
|
||
(file (car (alist-get pick completions nil nil #'string=))))
|
||
(if file
|
||
(find-file file)
|
||
(find-file (oni-org--create-name pick))
|
||
(insert "#+TITLE: " pick "\n\n"))))
|
||
|
||
;; Insert a link to a file in the ‘oni-org-exocortex-directory’ into the current
|
||
;; buffer. Don’t visit the file, just insert a link to it.
|
||
(defun oni-org-insert-exocortex-link ()
|
||
(interactive)
|
||
(let* ((completions (oni-org--get-exocortex-files))
|
||
(pick (completing-read "File: " completions))
|
||
(file (car (alist-get pick completions nil nil #'string=))))
|
||
(unless file
|
||
(setq file (oni-org--create-name pick))
|
||
(with-current-buffer (find-file-noselect file)
|
||
(insert "#+TITLE: " pick "\n\n")
|
||
(save-buffer)))
|
||
(insert "[[file:" (file-relative-name file oni-org-exocortex-directory) "][" pick "]]")))
|
||
|
||
;;; Functions
|
||
|
||
(defun oni-org-document-add-inline-images-startup ()
|
||
"Add a line to the current org buffer that will make it load images inline."
|
||
(interactive)
|
||
(unless (derived-mode-p 'org-mode)
|
||
(error "Not currently in an org-mode buffer"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let ((header-end (or (search-forward "\n\n" nil t)
|
||
(point-max)))
|
||
(case-fold-search t))
|
||
(goto-char (point-min))
|
||
(unless (search-forward "#+startup: inlineimages" header-end t)
|
||
(goto-char (1- header-end))
|
||
(insert "#+STARTUP: inlineimages\n")))))
|
||
|
||
(defun oni-org-document-remove-inline-images-startup ()
|
||
"Remove a line to the current org buffer that will make it load images inline."
|
||
(interactive)
|
||
(unless (derived-mode-p 'org-mode)
|
||
(error "Not currently in an org-mode buffer"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let ((header-end (or (search-forward "\n\n" nil t)
|
||
(point-max)))
|
||
(case-fold-search t))
|
||
(goto-char (point-min))
|
||
(when (search-forward "#+startup: inlineimages" header-end t)
|
||
(kill-whole-line)))))
|
||
|
||
(defun oni-org-document-toggle-inline-images-startup ()
|
||
"Add or remove a line to the current org buffer that will make it load images inline."
|
||
(interactive)
|
||
(unless (derived-mode-p 'org-mode)
|
||
(error "Not currently in an org-mode buffer"))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(let ((header-end (or (search-forward "\n\n" nil t)
|
||
(point-max)))
|
||
(case-fold-search t))
|
||
(goto-char (point-min))
|
||
(if (search-forward "#+startup: inlineimages" header-end t)
|
||
(kill-whole-line)
|
||
(goto-char (1- header-end))
|
||
(insert "#+STARTUP: inlineimages\n")))))
|
||
|
||
(defun oni-org-expand-to-home (file-name)
|
||
"Expand FILE-NAME to the base directory for that system.
|
||
The base for all org files on Windows is u:/, but on my linux
|
||
installs it will always be ~."
|
||
(let ((base-dir "~"))
|
||
(expand-file-name file-name base-dir)))
|
||
|
||
(defun oni-org-set-yasnippet-condition ()
|
||
"Change the ‘yas-buffer-local-condition’ variable to work for org.
|
||
This condition requires that the key used for the snippet is
|
||
located at the start of the line."
|
||
(setq-local yas-buffer-local-condition
|
||
'(looking-back (rx line-start (one-or-more (not space))))))
|
||
|
||
(defun oni-org-setup-prettify-symbols-mode ()
|
||
"Set up prettify symbols mode for org mode."
|
||
(setq-local prettify-symbols-alist
|
||
'(("[ ]" . ?)
|
||
("[X]" . ?)
|
||
("#+TITLE: " . "")
|
||
("#+title: " . "")))
|
||
(prettify-symbols-mode))
|
||
|
||
(defun oni-org-snippets-initialize ()
|
||
"Initialize the snippets for ‘oni-org’."
|
||
(when (boundp 'yas-snippet-dirs)
|
||
(add-to-list 'yas-snippet-dirs oni-org-snippets-dir t))
|
||
(yas-load-directory oni-org-snippets-dir))
|
||
|
||
(defun oni-org-maybe-change-todo-state (current-state)
|
||
"Change the state of the current task to in-progress CURRENT-STATE is todo."
|
||
(if (and (not org-capture-mode)
|
||
(member current-state org-todo-heads))
|
||
(cadr (member current-state org-todo-keywords-1))
|
||
current-state))
|
||
|
||
;;;###autoload
|
||
(defun oni-org-open-index ()
|
||
"Open the index of my org-based personal wiki."
|
||
(interactive)
|
||
(find-file (oni-org-expand-to-home "documents/exocortex-novus/index.org")))
|
||
|
||
(defun oni-org-color-for (object)
|
||
"Generate a color for OBJECT by using its hash as a parameter for an LCh color."
|
||
(apply #'color-rgb-to-hex
|
||
(apply #'color-lab-to-srgb
|
||
(color-lch-to-lab 65 30 (mod (sxhash-equal object) 360)))))
|
||
|
||
(defun oni-org-generate-todo-keyword-faces ()
|
||
"Create faces for all todo keywords in the current buffer."
|
||
(if-let ((keywords (cl-remove-if (lambda (tag) (assoc tag org-todo-keyword-faces))
|
||
org-todo-keywords-1)))
|
||
(append org-todo-keyword-faces
|
||
(mapcar (lambda (keyword) (cons keyword (oni-org-color-for keyword)))
|
||
keywords))
|
||
org-todo-keyword-faces))
|
||
|
||
(defun oni-org-generate-tag-faces ()
|
||
"Create faces for all the tags in the current buffer."
|
||
(if-let ((tags (cl-remove-if (lambda (tag) (assoc (car tag) org-tag-faces))
|
||
(org-get-buffer-tags))))
|
||
(append org-tag-faces
|
||
(mapcar (lambda (tag)
|
||
(let ((tag (car tag)))
|
||
(cons tag (oni-org-color-for tag))))
|
||
tags))
|
||
org-tag-faces))
|
||
|
||
(defun oni-org-generate-priority-faces ()
|
||
"Create faces for all the priorities in the current buffer."
|
||
(let (new-faces)
|
||
(range-map
|
||
(lambda (x) (push (cons x (oni-org-color-for x)) new-faces))
|
||
(cons (min org-priority-highest
|
||
org-priority-lowest)
|
||
(max org-priority-lowest
|
||
org-priority-highest)))
|
||
new-faces))
|
||
|
||
(defun oni-org-set-todo-keyword-faces ()
|
||
"Set ‘org-todo-keyword-faces’ to all different colors."
|
||
(setq org-todo-keyword-faces (oni-org-generate-todo-keyword-faces)))
|
||
|
||
(defun oni-org-set-tag-faces ()
|
||
"Set ‘org-tag-faces’ to all different colors."
|
||
(setq org-tag-faces (oni-org-generate-tag-faces))
|
||
(org-set-tag-faces 'org-tag-faces org-tag-faces))
|
||
|
||
(defun oni-org-set-priority-faces ()
|
||
"Set ‘org-priority-faces’ to all different colors."
|
||
(setq org-priority-faces
|
||
(map-merge 'alist org-priority-faces (oni-org-generate-priority-faces))))
|
||
|
||
;;;###autoload(autoload 'oni-hydra-org/body "oni-org")
|
||
(defhydra oni-hydra-org (:color teal :hint nil)
|
||
"
|
||
^Tasks^ ^Buffer^ ^Capture^
|
||
^^^^^^------------------------------------------------------------------------
|
||
_a_: Show Agenda _b_: Switch to org buffer _t_: Note
|
||
_c_: Capture new heading _s_: Save all org buffers _A_: Appointment
|
||
_l_: Store link ^^ _j_: Journal entry
|
||
^^ ^Roam^^^
|
||
^^^^^^------------------------------------------------------------------------
|
||
_f_: Find note _i_: Insert note
|
||
^^ ^Document^^^
|
||
^^^^^^------------------------------------------------------------------------
|
||
_di_: Add inlineimages STARTUP
|
||
"
|
||
("l" org-store-link)
|
||
("a" org-agenda)
|
||
("c" org-capture)
|
||
("b" org-switchb)
|
||
("s" org-save-all-org-buffers)
|
||
("t" (org-capture nil "t"))
|
||
("A" (org-capture nil "a"))
|
||
("j" (org-capture nil "j"))
|
||
("f" org-roam-node-find)
|
||
("i" org-roam-node-insert)
|
||
("di" oni-org-document-add-inline-images-startup))
|
||
|
||
(defun oni-org-in-dblock-p ()
|
||
"Non-nil when point belongs to a dynamic block."
|
||
(save-match-data
|
||
(let ((case-fold-search t)
|
||
(lim-up (save-excursion (outline-previous-heading)))
|
||
(lim-down (save-excursion (outline-next-heading))))
|
||
(org-between-regexps-p
|
||
"^[ \t]*#\\+begin"
|
||
"^[ \t]*#\\+end"
|
||
lim-up lim-down))))
|
||
|
||
(defun oni-org-at-origin-property-p ()
|
||
"Non-nil when point is in an origin property."
|
||
(save-match-data
|
||
(save-excursion
|
||
(goto-char (line-beginning-position))
|
||
(and (looking-at org-property-re)
|
||
(string= (match-string 2) "ORIGIN")))))
|
||
|
||
(defun oni-org-dblock-write-backlinks (_params)
|
||
"Generate backlinks to org headings."
|
||
(let ((current-heading (nth 4 (org-heading-components)))
|
||
(current-heading-id
|
||
(or (alist-get "CUSTOM_ID" (org-entry-properties) nil nil #'string=)
|
||
(org-id-get)))
|
||
backlinks)
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(while (re-search-forward (rx-to-string `(and "*" ,current-heading "]")) nil t)
|
||
(unless (or (oni-org-in-dblock-p)
|
||
(oni-org-at-origin-property-p))
|
||
(let ((components (org-heading-components)))
|
||
(push (cons (nth 2 components) (nth 4 components)) backlinks)))))
|
||
(when (not (null current-heading-id))
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(while (re-search-forward (rx-to-string `(or (seq "[[id:" ,current-heading-id "]")
|
||
(seq "#" ,current-heading-id "]"))) nil t)
|
||
(unless (or (oni-org-in-dblock-p)
|
||
(oni-org-at-origin-property-p))
|
||
(let ((components (org-heading-components)))
|
||
(push (cons (nth 2 components) (nth 4 components)) backlinks))))))
|
||
(insert (string-join
|
||
(mapcar (lambda (link)
|
||
(concat "- [[*" (cdr link) "][" (if (car link) (format "%s - " (car link)) "") (cdr link) "]]"))
|
||
(sort (seq-uniq backlinks (lambda (a b) (string= (cdr a) (cdr b))))
|
||
(lambda (a b) (string< (cdr a) (cdr b)))))
|
||
"\n"))))
|
||
|
||
(defun oni-org-wrap-region-in-block (block-name beginning end)
|
||
"Create a block BLOCK-NAME and wrap the text between BEGINNING and END in there."
|
||
(interactive "sName: \nr")
|
||
(save-excursion
|
||
(goto-char end)
|
||
(unless (looking-back (rx "\n") nil) (insert "\n"))
|
||
(insert "#+end_" block-name)
|
||
(unless (looking-at (rx "\n")) (insert "\n"))
|
||
(goto-char beginning)
|
||
(unless (looking-back (rx "\n") nil) (insert "\n"))
|
||
(insert "#+begin_" block-name)
|
||
(unless (looking-at (rx "\n")) (insert "\n"))))
|
||
|
||
(defalias 'org-dblock-write:oni-backlinks 'oni-org-dblock-write-backlinks)
|
||
|
||
;; Create a new archive for each year. This way archives don't keep growing
|
||
;; indefinitely and opening the archive doesn't load every single language I've
|
||
;; ever used because there are code blocks in there.
|
||
(setq org-archive-location (format-time-string "%%s_archive_%Y::"))
|
||
(setq org-catch-invisible-edits 'error)
|
||
(setq org-clock-in-switch-to-state #'oni-org-maybe-change-todo-state)
|
||
(setq org-extend-today-until 2)
|
||
(setq org-fontify-whole-heading-line t)
|
||
(setq org-fontify-quote-and-verse-blocks t)
|
||
(setq org-footnote-auto-adjust t)
|
||
(setq org-habit-graph-column 60)
|
||
(setq org-hide-emphasis-markers t)
|
||
(setq org-hide-macro-markers t)
|
||
(setq org-pretty-entities t)
|
||
(setq org-return-follows-link t)
|
||
(setq org-return-follows-link t)
|
||
(setq org-special-ctrl-a/e t)
|
||
(setq org-src-fontify-natively t)
|
||
(setq org-tags-column -67)
|
||
(setq org-tags-exclude-from-inheritance '("project"))
|
||
(setq org-tags-sort-function #'string<)
|
||
(setq org-use-fast-todo-selection t)
|
||
(setq org-use-sub-superscripts '{})
|
||
|
||
;; Discovered through
|
||
;; https://github.com/novoid/dot-emacs/blob/23c28944f1991c636ea71ec7d5c3d266e6dbeb8a/config.org#general-org-mode-settings
|
||
(setq org-special-ctrl-k t)
|
||
|
||
;; Generally, for state updates and such, I like to have all of the notes added
|
||
;; into the logbook, but when I want to add a note manually I definitely want it
|
||
;; to show up easily seen in the buffer.
|
||
(setq org-log-into-drawer t)
|
||
|
||
(defun oni-org-logging-outside-drawer (func &rest args)
|
||
"Call FUNC with ARGS.
|
||
Set ‘org-log-into-drawer’ to nil if we’re trying to take a note,
|
||
and not a state update."
|
||
(let ((org-log-into-drawer (not (eql org-log-note-purpose 'note))))
|
||
(apply func args)))
|
||
|
||
(add-function :around (symbol-function 'org-store-log-note)
|
||
#'oni-org-logging-outside-drawer)
|
||
|
||
;; Set the maximum indentation level for description lists to 5 (which is the
|
||
;; seemingly hardcoded value of the indentation it gets when it goes over
|
||
;; ‘org-list-description-max-indent’) so that I don’t get dangling descriptions
|
||
;; when my term is 19 characters long.
|
||
(setq org-list-description-max-indent 5)
|
||
|
||
(setq org-default-notes-file (expand-file-name "inbox.org" oni-org-todo-dir))
|
||
(setq org-bibtex-autogen-keys t)
|
||
|
||
(defun oni-org-find-heading-in-file (heading file &optional move)
|
||
"Try to find HEADING somewhere in FILE.
|
||
This function returns nil if HEADING couldn’t be found, and the
|
||
position where the chapter starts otherwise. If MOVE is non-nil
|
||
also move point to the start of the heading."
|
||
(let ((buffer (find-file-noselect file)))
|
||
(with-current-buffer buffer
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(org-find-exact-headline-in-buffer heading buffer (not move))))))
|
||
|
||
(defun oni-org-create-book-heading (book-title file)
|
||
"Create a new heading for BOOK-TITLE in FILE."
|
||
(let ((buffer (find-file file)))
|
||
(with-current-buffer buffer
|
||
(goto-char (point-max))
|
||
(insert "\n* " book-title "\n\n "))))
|
||
|
||
(defun oni-org-create-chapter-heading (book-title chapter-title file)
|
||
"Create a new heading under BOOK-TITLE for CHAPTER-TITLE in FILE."
|
||
(let ((buffer (find-file file)))
|
||
(with-current-buffer buffer
|
||
(goto-char (point-min))
|
||
(goto-char (oni-org-find-heading-in-file book-title file t))
|
||
(goto-char (org-element-property :end (org-element-at-point)))
|
||
(unless (= (point) (point-max))
|
||
(open-line 2))
|
||
(insert "\n** " chapter-title "\n\n "))))
|
||
|
||
(defun oni-org-create-chapter-section (chapter-title file)
|
||
"Create a new notes section under CHAPTER-TITLE in FILE."
|
||
(let ((buffer (find-file file)))
|
||
(with-current-buffer buffer
|
||
(goto-char (point-min))
|
||
(goto-char (oni-org-find-heading-in-file chapter-title file t))
|
||
(goto-char (org-element-property :contents-end (org-element-at-point)))
|
||
(insert "\n"))))
|
||
|
||
(defun oni-org-reading-note ()
|
||
"Find the org-header associated with the current chapter or page."
|
||
(let* ((headers (split-string (format-mode-line header-line-format) ":" t " "))
|
||
(book-name (car headers))
|
||
(chapter-name (cadr headers))
|
||
(notes-file (oni-org-expand-to-home "documents/gtd/reading-notes.org"))
|
||
(chapter-start (oni-org-find-heading-in-file chapter-name notes-file)))
|
||
(if (not chapter-start)
|
||
(let ((book-start (oni-org-find-heading-in-file book-name notes-file)))
|
||
(unless book-start
|
||
(oni-org-create-book-heading book-name notes-file))
|
||
(oni-org-create-chapter-heading book-name chapter-name notes-file))
|
||
(oni-org-create-chapter-section chapter-name notes-file))))
|
||
|
||
(defun oni-org-todo-maybe-hide-body ()
|
||
"Hide the current outline body if ‘org-state’ is a DONE state."
|
||
(when (member org-state org-done-keywords)
|
||
(outline-hide-body)))
|
||
|
||
(defun oni-org-update-all-dblocks-live ()
|
||
"Call ‘org-update-all-dblocks’ if the current file isn't an archive file."
|
||
(if (not (or (string-suffix-p "_archive" (buffer-file-name))
|
||
(string= "journal.org" (file-name-nondirectory (buffer-file-name)))))
|
||
(org-update-all-dblocks)))
|
||
|
||
(setq org-todo-keywords
|
||
'((sequence "TODO(t)" "WIP" "BLOCKED(b@)" "|" "DONE(d!)")
|
||
(sequence "READ(r)" "READING(!)" "|" "FINISHED(!)" "STOPPED(@)")
|
||
(sequence "WATCH(w)" "WATCHING" "|" "WATCHED(!)")
|
||
(sequence "LISTEN(l)" "LISTENING" "|" "DONE(d!)")
|
||
(sequence "|" "CANCELLED(c@)")))
|
||
|
||
(add-hook 'org-after-todo-state-change-hook 'oni-org-todo-maybe-hide-body)
|
||
|
||
(setf (alist-get 'file org-link-frame-setup) 'find-file)
|
||
|
||
(add-to-list 'org-modules 'org-habit)
|
||
(add-to-list 'org-modules 'org-tempo)
|
||
|
||
(add-to-list 'org-babel-load-languages '(java . t))
|
||
(add-to-list 'org-babel-load-languages '(dot . t))
|
||
(add-to-list 'org-babel-load-languages '(gnuplot . t))
|
||
|
||
(add-to-list 'org-structure-template-alist '("el" . "src emacs-lisp"))
|
||
(add-to-list 'org-structure-template-alist '("sh" . "src shell"))
|
||
|
||
(add-hook 'before-save-hook #'oni-org-update-all-dblocks-live)
|
||
(add-hook 'org-mode-hook #'oni-org-set-tag-faces)
|
||
(add-hook 'org-mode-hook #'oni-org-set-todo-keyword-faces)
|
||
(add-hook 'org-mode-hook #'oni-org-set-priority-faces)
|
||
(add-hook 'org-mode-hook #'oni-org-set-yasnippet-condition)
|
||
(add-hook 'org-mode-hook 'electric-pair-local-mode)
|
||
(add-hook 'org-mode-hook 'electric-quote-local-mode)
|
||
(add-hook 'org-mode-hook 'flyspell-mode)
|
||
(add-hook 'org-mode-hook 'olivetti-mode)
|
||
(add-hook 'org-mode-hook 'org-indent-mode)
|
||
(add-hook 'org-mode-hook 'org-pretty-table-mode)
|
||
(add-hook 'org-mode-hook 'variable-pitch-mode)
|
||
(add-hook 'org-mode-hook 'visual-line-mode)
|
||
(add-hook 'org-mode-hook 'yas-minor-mode)
|
||
|
||
(org-edna-mode)
|
||
(org-super-agenda-mode)
|
||
|
||
(unless (eq system-type 'windows-nt)
|
||
(require 'org-bullets)
|
||
(add-hook 'org-mode-hook 'org-bullets-mode)
|
||
(add-hook 'org-mode-hook #'oni-org-setup-prettify-symbols-mode))
|
||
|
||
;;;###autoload
|
||
(global-set-key (kbd "C-c o") '("Org commands" . oni-hydra-org/body))
|
||
|
||
;;;###autoload
|
||
(global-set-key (kbd "C-<home>") #'oni-org-open-index)
|
||
|
||
(with-eval-after-load 'org
|
||
(with-eval-after-load 'yasnippet
|
||
(oni-org-snippets-initialize)))
|
||
|
||
(with-eval-after-load 'org-edna (diminish 'org-edna-mode))
|
||
|
||
(with-eval-after-load 'org-id
|
||
(setq org-id-link-to-org-use-id 'use-existing))
|
||
|
||
;;;; Agenda
|
||
|
||
(defun oni-org-agenda-window-p (_target _action)
|
||
"Check if the current buffer is the agenda buffer."
|
||
(string= (buffer-name) org-agenda-buffer-name))
|
||
|
||
(defun oni-org-initialize-agenda-category-icons ()
|
||
"Set ‘org-agenda-category-icon-alist’ if it hasn’t already been set."
|
||
(when (and (display-graphic-p)
|
||
(null org-agenda-category-icon-alist))
|
||
(oni-org-set-agenda-category-icons)))
|
||
|
||
(defun oni-org-set-agenda-category-icons ()
|
||
"Set ‘org-agenda-category-icon-alist’."
|
||
(setq org-agenda-category-icon-alist
|
||
(mapcar (lambda (pair) (list (rx string-start (literal (car pair)) string-end)
|
||
(expand-file-name (cdr pair) oni-org-icons-dir)
|
||
'svg nil
|
||
:height (window-default-font-height)
|
||
:ascent 'center))
|
||
'(("task" . "bx-task.svg")
|
||
("inbox" . "bxs-inbox.svg")
|
||
("email" . "mat-email.svg")
|
||
("mail" . "mat-email.svg")
|
||
("life" . "mat-one-up.svg")
|
||
("feature" . "mat-star-circle-outline.svg")
|
||
("work" . "bs-building.svg")
|
||
("game" . "bxs-game.svg")
|
||
("shopping" . "bx-shopping-bag.svg")
|
||
("bug" . "bx-bug.svg")
|
||
("idea" . "bxs-bulb.svg")
|
||
("article" . "mat-post-outline.svg")
|
||
("project" . "bs-kanban.svg")
|
||
("ebook" . "bxs-book-content.svg")
|
||
("book" . "mat-book-open-variant.svg")
|
||
("Morning Cup of Coding" . "bxs-coffee.svg")
|
||
("paper" . "mat-note-text-outline.svg")
|
||
("question" . "mat-head-question.svg")
|
||
("music" . "bxs-music.svg")
|
||
("emacs" . "emacs.svg")
|
||
("guix" . "guix.svg")
|
||
("moving" . "bxs-truck.svg")
|
||
("security" . "mat-security.svg")
|
||
("website" . "mat-web.svg")
|
||
("desktop" . "bx-desktop.svg")
|
||
("maint" . "bs-tools.svg")
|
||
("comm" . "bs-telephone-fill.svg")
|
||
("config" . "bx-cog.svg")
|
||
("blog" . "bx-rss.svg")
|
||
("writing" . "bxs-pencil.svg")
|
||
("code" . "code.svg")
|
||
("list" . "list.svg")
|
||
("video" . "video-fill.svg")
|
||
("album" . "album-fill.svg")))))
|
||
|
||
(defun oni-org-roam-todo-files ()
|
||
"Collect all files that have TODO items in them."
|
||
(mapcar
|
||
#'car
|
||
(org-roam-db-query
|
||
[:select :distinct file :from nodes :where (= todo $s1)] "TODO")))
|
||
|
||
(setq org-agenda-files (list oni-org-todo-main-file))
|
||
(setq org-agenda-tags-todo-honor-ignore-options t)
|
||
(setq org-agenda-todo-ignore-scheduled 'future)
|
||
(setq org-agenda-restore-windows-after-quit t)
|
||
(setq org-agenda-start-with-log-mode t)
|
||
(setq org-agenda-window-setup 'only-window)
|
||
|
||
;; Discovered through
|
||
;; https://github.com/novoid/dot-emacs/blob/23c28944f1991c636ea71ec7d5c3d266e6dbeb8a/config.org#general-org-mode-settings
|
||
(setq org-agenda-dim-blocked-tasks 'invisible)
|
||
|
||
(add-hook 'org-mode-hook #'oni-org-initialize-agenda-category-icons)
|
||
|
||
(add-to-list 'display-buffer-alist
|
||
'(oni-org-agenda-window-p
|
||
display-buffer-in-previous-window
|
||
(inhibit-same-window . t)))
|
||
|
||
;;;; Capture
|
||
|
||
(require 'org-capture)
|
||
|
||
(defconst oni-org-capture-template-directory
|
||
(expand-file-name "capture-templates" oni-org-root)
|
||
"Directory where the template files for ‘org-capture’ are located.")
|
||
|
||
(defun oni-org-delete-frame-once ()
|
||
"Run `delete-frame'.
|
||
|
||
After running it once remove it from `org-capture-after-finalize-hook'."
|
||
(delete-frame)
|
||
(remove-hook 'org-capture-after-finalize-hook 'oni-org-delete-frame-once))
|
||
|
||
(defun oni-org-run-capture-in-dedicated-frame ()
|
||
"Run `org-capture' in a dedicated frame."
|
||
(interactive)
|
||
(with-selected-frame (make-frame '((minibuffer . nil)
|
||
(name . "emacs-org-capture")
|
||
(width . 80)
|
||
(height . 24)))
|
||
(org-capture nil "t")
|
||
(delete-other-windows)
|
||
(set-frame-width nil 80)
|
||
(set-frame-height nil 24)
|
||
(add-hook 'org-capture-after-finalize-hook 'oni-org-delete-frame-once)))
|
||
|
||
(defun oni-org-get-url-title (url)
|
||
"Load URL and parse out the title."
|
||
(with-current-buffer
|
||
(url-retrieve-synchronously url)
|
||
(unwind-protect
|
||
(when (re-search-forward (rx "<title" (zero-or-more (not ">")) ">") nil t)
|
||
(let ((title-start (point)))
|
||
(when (re-search-forward (rx "</title>") nil t)
|
||
(string-trim (buffer-substring title-start (- (point) 8))))))
|
||
(kill-buffer))))
|
||
|
||
(defun oni-org-get-url-link (url)
|
||
"Turn URL into an org link."
|
||
(let ((title (oni-org-get-url-title url)))
|
||
(format "[[%s][%s]]" url title)))
|
||
|
||
(defun oni-org-format-months ()
|
||
(let* ((time (org-timestamp-to-time
|
||
(org-timestamp-from-string (concat "<" (org-read-date) ">"))))
|
||
(decoded (decode-time time))
|
||
(next-month
|
||
(time-add time (days-to-time (date-days-in-month
|
||
(decoded-time-year decoded)
|
||
(decoded-time-month decoded))))))
|
||
(concat (format-time-string "%b " time)
|
||
(format-time-string "%b " next-month)
|
||
(format-time-string "%Y" time))))
|
||
|
||
(defun oni-org-ask-names ()
|
||
(let ((n 1)
|
||
article-name
|
||
names)
|
||
(while (not (string-empty-p (setq article-name (read-string (format "Article Name %d: " n)))))
|
||
(push article-name names)
|
||
(cl-incf n))
|
||
(reverse names)))
|
||
|
||
(defun oni-org-format-names (names)
|
||
(mapconcat (lambda (n) (format "** READ %s" n)) names "\n"))
|
||
|
||
(defun org-edna-finder/next-sibling-first-child ()
|
||
"A finder for ‘org-edna’ to find the first child of the next sibling."
|
||
(save-excursion
|
||
(org-back-to-heading t)
|
||
(org-goto-sibling)
|
||
(org-goto-first-child)
|
||
(list (point-marker))))
|
||
|
||
(defun org-edna-condition/day-of-week? (neg weekday)
|
||
(let ((condition (not (= (string-to-number (format-time-string "%u")) weekday))))
|
||
(when (xor condition neg)
|
||
"Not the right day.")))
|
||
|
||
(defun org-edna-condition/night-time? (neg)
|
||
"A condition for ‘org-edna’ see if it's what I consider nighttime."
|
||
(let* ((hour (nth 2 (decode-time)))
|
||
(condition (or (> hour 20)
|
||
(< hour 8))))
|
||
(when (xor condition neg)
|
||
"Too late!")))
|
||
|
||
(defun org-edna-condition/business-hours? (neg timezone)
|
||
"A condition for ‘org-edna’ to see if it's during regular business hours."
|
||
(let* ((hour (nth 2 (decode-time nil timezone)))
|
||
(condition (> 9 hour 18)))
|
||
(when (xor condition neg)
|
||
(format "Outside of business hours in %s!" timezone))))
|
||
|
||
;;; Refile
|
||
|
||
(defun oni-org-refile-to-top ()
|
||
(interactive)
|
||
(let ((org-reverse-note-order t))
|
||
(org-refile)))
|
||
|
||
;; Set it up so that I can refile easily and still create new nodes when I
|
||
;; refile. Include the file in the outline path so that I can refile into them
|
||
;; and create top-level headings.
|
||
(setq org-refile-use-outline-path 'file
|
||
org-outline-path-complete-in-steps nil
|
||
org-refile-allow-creating-parent-nodes 'confirm
|
||
org-log-refile 'time)
|
||
|
||
;; Refiling can go to any heading in the current file, any heading in
|
||
;; ‘oni-org-todo-main-file', and the top of ‘oni-org-todo-someday-file'.
|
||
(setq org-refile-targets '((nil . (:maxlevel . 10))
|
||
(oni-org-todo-main-file . (:maxlevel . 10))
|
||
(oni-org-todo-someday-file . (:maxlevel . 1))
|
||
(oni-org-todo-tickler-file . (:level . 1))))
|
||
|
||
(define-key org-mode-map (kbd "C-c C-S-w") #'oni-org-refile-to-top)
|
||
|
||
;;; Export
|
||
(require 'ox-html)
|
||
(require 'nxml-mode)
|
||
|
||
;; From https://emacs.stackexchange.com/a/57433
|
||
(defcustom oni-org-html-embed-svg nil
|
||
"Embed SVG images.
|
||
You can set this variable in Org files with
|
||
#+HTML_EMBED_SVG: t
|
||
or
|
||
#+OPTIONS: html-embed-svg:t"
|
||
:type 'boolean
|
||
:group 'org-export-html)
|
||
|
||
(cl-pushnew
|
||
'(:html-embed-svg "HTML_EMBED_SVG" "html-embed-svg" oni-org-html-embed-svg)
|
||
(org-export-backend-options (org-export-get-backend 'html)))
|
||
|
||
(defun oni-org-html-svg-image-embed (fun source attributes info)
|
||
"Make embedding of SVG images possible in org HTML export.
|
||
SVG images are embedded if :html-embed-svg is non-nil in the plist INFO.
|
||
Otherwise FUN called with SOURCE, ATTRIBUTES, and INFO as arguments.
|
||
SOURCE is the file name of the SVG file.
|
||
This is an around advice for ‘org-html--svg-image’ as FUN."
|
||
(if (member (plist-get info :html-embed-svg) '("yes" "t" t))
|
||
(with-temp-buffer
|
||
(insert-file-contents source)
|
||
(with-syntax-table nxml-mode-syntax-table
|
||
(while (and (search-forward "<svg" nil t)
|
||
(nth 8 (syntax-ppss))))
|
||
(delete-region (point-min) (match-beginning 0))
|
||
(buffer-string)))
|
||
(funcall fun source attributes info)))
|
||
|
||
(with-eval-after-load 'ox-html
|
||
(advice-add 'org-html--format-image :around #'oni-org-html-svg-image-embed)
|
||
;; These two I've added because when I try to upload text with either of these
|
||
;; characters to Tekuti I just end up with sending ? for each. This is not an
|
||
;; issue with org-mode, the generated HTML correctly contains these characters
|
||
;; verbatim.
|
||
(add-to-list 'org-html-special-string-regexps (cons (rx "“") "“"))
|
||
(add-to-list 'org-html-special-string-regexps (cons (rx "”") "”")))
|
||
|
||
;;; Pomodoro
|
||
|
||
;; Add my current pomodoro time duration so that I can make estimates in
|
||
;; Pomodoros like 1p.
|
||
(defconst oni-org-pomodoro-duration 25
|
||
"The duration in minutes of a single pomodoro.")
|
||
|
||
(with-eval-after-load 'org-duration
|
||
(add-to-list 'org-duration-units `("p" . ,oni-org-pomodoro-duration))
|
||
(org-duration-set-regexps))
|
||
|
||
;;; Projects
|
||
|
||
(defun oni-org-pick-project (property)
|
||
(when (string= property "PROJECT")
|
||
(org-map-entries (lambda () (concat (buffer-name) ":" (mapconcat (lambda (x) x) (org-get-outline-path t) ":"))) "CATEGORY=\"project\""
|
||
org-agenda-files)))
|
||
|
||
(defun oni-org-link-project (value)
|
||
(let* ((split-value (split-string value ":"))
|
||
(marker (org-find-olp split-value)))
|
||
(save-excursion
|
||
(with-current-buffer (marker-buffer marker)
|
||
(goto-char marker)
|
||
(format "[[id:%s][%s]]" (org-id-get-create) (car (last split-value)))))))
|
||
|
||
(add-to-list 'org-properties-postprocess-alist '("PROJECT" . oni-org-link-project))
|
||
|
||
(add-hook 'org-property-allowed-value-functions #'oni-org-pick-project)
|
||
|
||
(defun oni-org-collect-project-references (heading-id)
|
||
(let ((files (org-add-archive-files (list (buffer-file-name))))
|
||
backlinks)
|
||
(save-excursion
|
||
(mapc (lambda (file)
|
||
(with-current-buffer (or (get-file-buffer file)
|
||
(progn
|
||
(find-file-noselect file)
|
||
(get-file-buffer file)))
|
||
(goto-char (point-min))
|
||
(while (re-search-forward
|
||
(rx (or (seq "[[id:" (literal heading-id) "]")
|
||
(seq "#" (literal heading-id) "]")))
|
||
nil t)
|
||
(unless (or (oni-org-in-dblock-p)
|
||
(oni-org-at-origin-property-p))
|
||
(let ((components (org-heading-components)))
|
||
(push `((done . ,(and (org-entry-is-done-p) t))
|
||
(position . ,(point))
|
||
(title . ,(replace-regexp-in-string (rx (zero-or-more whitespace)
|
||
"[" (or (seq (zero-or-more digit) "%")
|
||
(seq (zero-or-more digit) "/" (zero-or-more digit)))
|
||
"]" eol)
|
||
"" (nth 4 components)))
|
||
(file . ,file))
|
||
backlinks))))))
|
||
files))
|
||
backlinks))
|
||
|
||
(defun oni-org-linkify-backlink (link)
|
||
(format "- [%s] [[%s*%s][%s]]"
|
||
(if (alist-get 'done link) "X" " ")
|
||
(let ((file-name (alist-get 'file link)))
|
||
(if (string-suffix-p "_archive" file-name t)
|
||
(format "file:%s::" (alist-get 'file link))
|
||
""))
|
||
(alist-get 'title link)
|
||
(alist-get 'title link)))
|
||
|
||
(defun oni-org-link= (a b)
|
||
(= (alist-get 'position a)
|
||
(alist-get 'position b)))
|
||
|
||
(defun oni-org-link< (a b)
|
||
(< (alist-get 'position a)
|
||
(alist-get 'position b)))
|
||
|
||
(defun oni-org-dblock-write-project-steps (_params)
|
||
"Generate back-links to org headings."
|
||
(let* ((current-heading-id
|
||
(let ((properties (org-entry-properties)))
|
||
(or (alist-get "CUSTOM_ID" properties nil nil #'string=)
|
||
(org-id-get-create))))
|
||
(backlinks (and (not (null current-heading-id))
|
||
(oni-org-collect-project-references current-heading-id))))
|
||
(insert (string-join
|
||
(mapcar #'oni-org-linkify-backlink
|
||
(sort (seq-uniq backlinks #'oni-org-link=) #'oni-org-link<))
|
||
"\n"))
|
||
(org-update-statistics-cookies nil)))
|
||
|
||
(defun oni-org-insert-project-steps ()
|
||
"Create a dynamic block capturing the steps in a project."
|
||
(interactive)
|
||
(org-create-dblock '(:name "oni-project-steps"))
|
||
(org-update-dblock))
|
||
|
||
(defalias 'org-dblock-write:oni-project-steps 'oni-org-dblock-write-project-steps)
|
||
(org-dynamic-block-define "oni-project-steps" #'oni-org-insert-project-steps)
|
||
|
||
;;; Moving subtrees
|
||
|
||
(defun oni-org-move-subtree (target placement)
|
||
"Move the subtree at point to TARGET and place it at PLACEMENT.
|
||
|
||
TARGET should be a point or a marker in the current buffer.
|
||
|
||
PLACEMENT should be a symbol. If PLACEMENT is above, it'll be
|
||
placed above TARGET. Otherwise it will be placed below it."
|
||
(interactive
|
||
(list (let ((org-refile-targets '((nil :maxlevel . 1)))
|
||
(org-refile-use-outline-path nil))
|
||
(org-refile-get-location "Move subtree to:"))
|
||
(intern (completing-read "Above / Below: " '(above below) nil t))))
|
||
(save-excursion
|
||
(let ((heading-level (car (org-heading-components)))
|
||
(marker (copy-marker (nth 3 target)))
|
||
(this-command t))
|
||
(org-cut-subtree)
|
||
(goto-char marker)
|
||
(unless (eq placement 'above)
|
||
(org-forward-heading-same-level 1)
|
||
(when (= (point) (marker-position marker))
|
||
(goto-char (point-max))))
|
||
(org-paste-subtree heading-level nil nil t))))
|
||
|
||
;;; Pomodoro dynamic block
|
||
|
||
(defun oni-org-dblock-write-pomodoro-overview (params)
|
||
(let* ((date (plist-get params :date))
|
||
(info (org-map-entries (lambda ()
|
||
(let ((components (org-heading-components)))
|
||
(list (cons 'done (and (org-entry-is-done-p) t))
|
||
(cons 'title (nth 4 components))
|
||
(cons 'poms (length (oni-org-pomodoro-times-for-date
|
||
(org-parse-time-string date))))
|
||
(cons 'id (org-id-get-create)))))
|
||
(format "TODO=\"NEXT\"|CLOSED>=\"<%s 0:00>\"+CLOSED<=\"<%s 23:59>\""
|
||
date date)
|
||
'agenda)))
|
||
(insert
|
||
(string-trim-right
|
||
(apply #'concat "| | Task | Effort |\n"
|
||
"|-+------+--------|\n"
|
||
"| | <60> | |\n"
|
||
(mapcar (lambda (itm)
|
||
(let ((emphasis (if (alist-get 'done itm) "+" ""))
|
||
(title (alist-get 'title itm)))
|
||
(format "| | %s[[id:%s][%s]]%s | %s |\n"
|
||
emphasis
|
||
(alist-get 'id itm)
|
||
title
|
||
emphasis
|
||
(make-string (alist-get 'poms itm) ?X))))
|
||
info))))
|
||
(org-table-align)
|
||
(org-table-shrink)))
|
||
|
||
(defun oni-org-insert-pomodoro-overview ()
|
||
"Create a dynamic block showing the Pomodoro overview for today."
|
||
(interactive)
|
||
(org-create-dblock `(:name "oni-pomodoro-overview"
|
||
:date ,(format-time-string "%Y-%m-%d")))
|
||
(org-update-dblock))
|
||
|
||
(defalias 'org-dblock-write:oni-pomodoro-overview 'oni-org-dblock-write-pomodoro-overview)
|
||
(org-dynamic-block-define "oni-pomodoro-overview" #'oni-org-insert-pomodoro-overview)
|
||
|
||
(defun oni-org-increment-property (property)
|
||
(interactive
|
||
(list (org-read-property-name)))
|
||
(let ((value (string-to-number (or (org-entry-get (point) property) "0"))))
|
||
(org-set-property property (number-to-string (1+ value)))))
|
||
|
||
(add-to-list 'org-log-note-headings
|
||
(cons 'pomodoro-finished "Finished a pomodoro on %t"))
|
||
(add-to-list 'org-log-note-headings
|
||
(cons 'pomodoro-planned "Planned to complete pomodoros on %d"))
|
||
|
||
(defun oni-org-pomodoro-add-finished-note ()
|
||
(interactive)
|
||
(org-add-log-setup 'pomodoro-finished nil nil 'time))
|
||
|
||
(defun oni-org-pomodoro-add-planned-note ()
|
||
(interactive)
|
||
(org-add-log-setup 'pomodoro-planned nil nil 'time))
|
||
|
||
(defun oni-org-pomodoro-times ()
|
||
(let ((entry-beginning (org-entry-beginning-position))
|
||
(entry-end (org-entry-end-position))
|
||
results)
|
||
(save-excursion
|
||
(goto-char entry-beginning)
|
||
(save-match-data
|
||
(when (re-search-forward org-logbook-drawer-re entry-end nil)
|
||
(let ((logbook-beginning (match-beginning 0))
|
||
(logbook-end (match-end 0)))
|
||
(goto-char logbook-beginning)
|
||
(while (re-search-forward
|
||
(rx "Finished a pomodoro on "
|
||
(group "[" (one-or-more (not "]")) "]"))
|
||
logbook-end t)
|
||
(push (org-parse-time-string (match-string 1)) results))))))
|
||
results))
|
||
|
||
(defun oni-org-pomodoro-times-for-date (date)
|
||
(let ((day (decoded-time-day date))
|
||
(month (decoded-time-month date))
|
||
(year (decoded-time-year date)))
|
||
(seq-filter (lambda (time) (and (= (decoded-time-day time) day)
|
||
(= (decoded-time-month time) month)
|
||
(= (decoded-time-year time) year)))
|
||
(oni-org-pomodoro-times))))
|
||
|
||
;;; Archive Management
|
||
|
||
(defun oni-org-archive-old-tasks ()
|
||
"Archive tasks in all agenda files that were closed before the current month."
|
||
(interactive)
|
||
(let ((match (format-time-string "CLOSED<\"<%Y-%m-01>\"")))
|
||
(mapc (lambda (p)
|
||
(goto-char p)
|
||
(org-archive-subtree))
|
||
(reverse (org-map-entries #'point match 'agenda)))))
|
||
|
||
;;; Inbox management
|
||
|
||
(defun oni-org-should-dump-tickler-p ()
|
||
(with-current-buffer (find-file-noselect oni-org-todo-tickler-file)
|
||
(goto-char (point-min))
|
||
(search-forward "#+last-dumped: ")
|
||
(let ((dumped-date (org-timestamp-to-time (org-timestamp-from-string (buffer-substring-no-properties (point) (line-end-position)))))
|
||
(current-date (org-timestamp-to-time (org-timestamp-from-string (format-time-string "[%Y-%m-%d]")))))
|
||
(time-less-p dumped-date current-date))))
|
||
|
||
(defun oni-org-update-tickler-dumped-date ()
|
||
(with-current-buffer (find-file-noselect oni-org-todo-tickler-file)
|
||
(goto-char (point-min))
|
||
(search-forward "#+last-dumped: ")
|
||
(delete-region (point) (line-end-position))
|
||
(insert (format-time-string "[%Y-%m-%d]"))))
|
||
|
||
(defun oni-org-dump-tickler-1 ()
|
||
(with-current-buffer (find-file-noselect oni-org-todo-tickler-file)
|
||
(save-excursion
|
||
(goto-char (point-min))
|
||
(org-forward-heading-same-level 1)
|
||
(let* ((element (org-element-at-point-no-context))
|
||
(element-title (org-element-property :raw-value element))
|
||
(contents-begin (org-element-property :contents-begin element))
|
||
(contents-end (org-element-property :contents-end element)))
|
||
(when contents-begin
|
||
(let ((text (buffer-substring-no-properties contents-begin contents-end)))
|
||
(delete-region contents-begin contents-end)
|
||
(with-temp-buffer
|
||
(insert text)
|
||
(org-mode)
|
||
(org-map-entries 'org-promote-subtree)
|
||
(setq text (buffer-substring-no-properties (point-min) (point-max))))
|
||
(with-current-buffer (find-file-noselect oni-org-todo-inbox-file)
|
||
(save-excursion
|
||
(let ((max-point (point-max)))
|
||
(goto-char max-point)
|
||
(insert text)
|
||
(goto-char max-point))))))
|
||
(if (string-match-p (rx (one-or-more digit)) element-title)
|
||
(progn
|
||
(dotimes (_ 31)
|
||
(org-move-subtree-down))
|
||
(unless (string= element-title (format-time-string "%-d"))
|
||
(oni-org-dump-tickler-1)))
|
||
(dotimes (_ 42)
|
||
(org-move-subtree-down))
|
||
(oni-org-dump-tickler-1))))))
|
||
|
||
(defun oni-org-dump-tickler ()
|
||
(interactive)
|
||
(when (oni-org-should-dump-tickler-p)
|
||
(oni-org-dump-tickler-1)
|
||
(oni-org-update-tickler-dumped-date)))
|
||
|
||
(defun oni-org-run-through-inbox ()
|
||
(interactive)
|
||
(oni-org-dump-tickler)
|
||
(catch 'done
|
||
(while t
|
||
(find-file oni-org-todo-inbox-file)
|
||
(goto-char (point-min))
|
||
(org-forward-heading-same-level 1)
|
||
(when (not (org-at-heading-p))
|
||
(throw 'done t))
|
||
(org-fold-save-outline-visibility nil
|
||
(outline-show-entry)
|
||
(org-narrow-to-subtree)
|
||
(unwind-protect
|
||
(catch 'continue
|
||
(while t
|
||
(let ((choice (read-multiple-choice
|
||
"Which action: "
|
||
'((?r "Refile" "Refile heading to a different place")
|
||
(?R "Refile to top" "Refile heading to a different place, placing the note at the top of the heading")
|
||
(?a "Archive" "Archive heading")
|
||
(?d "Remind me later" "Move it into the tickler file")
|
||
(?t "Todo" "Change todo keyword")
|
||
(?T "Tag" "Change tags")
|
||
(?q "Quit" "Stop going through")))))
|
||
(condition-case nil
|
||
(cl-case (car choice)
|
||
(?r (org-refile)
|
||
(throw 'continue t))
|
||
(?R (let ((org-reverse-note-order t))
|
||
(org-refile))
|
||
(throw 'continue t))
|
||
(?a (org-archive-subtree-default)
|
||
(throw 'continue t))
|
||
(?d (let ((org-refile-targets `((,oni-org-todo-tickler-file :maxlevel . 10))))
|
||
(org-refile))
|
||
(throw 'continue t))
|
||
(?t (org-todo))
|
||
(?T (org-set-tags-command))
|
||
(?q (throw 'done t)))
|
||
(quit nil)))))
|
||
(widen)
|
||
(delete-blank-lines))))))
|
||
|
||
(defun oni-org-clock+post-drawer ()
|
||
(if (and (markerp org-clock-hd-marker)
|
||
(marker-buffer org-clock-hd-marker))
|
||
(progn (set-buffer (marker-buffer org-clock-hd-marker))
|
||
(org-capture-put-target-region-and-position)
|
||
(widen)
|
||
(goto-char org-clock-hd-marker)
|
||
(let ((end (org-entry-end-position)))
|
||
(while (search-forward ":END:" end t))))
|
||
(user-error "No running clock that could be used as capture target")))
|
||
|
||
(defun init-find-weekly-review-file ()
|
||
(interactive)
|
||
(find-file (format-time-string "u:/documents/gtd/weekly-reviews/%Y-%W.org"))
|
||
(if (= (point-min) (point-max))
|
||
(progn
|
||
(insert (format-time-string "#+TITLE: Weekly Review Report for Week %-W %Y\n"))
|
||
(insert "\n")
|
||
(insert "See [[file:u:/documents/gtd/checklists/weekly-review.org][Weekly Review Checklist]]\n")
|
||
(insert "\n"))
|
||
(goto-char (point-min))))
|
||
|
||
;;; Add face to file links that show file doesn't exist.
|
||
|
||
(defface oni-org-link-nonexistent-file
|
||
'((t :inherit error :underline t :weight regular))
|
||
"Face to display links that point to nonexistent files in.")
|
||
|
||
(defun oni-org-file-face-selector (path)
|
||
"Return a different face based on whether PATH exists or not.
|
||
When PATH exists just return the face ‘org-link’ as usual,
|
||
otherwise return ‘oni-org-link-nonexistent-file’."
|
||
(if (file-exists-p path)
|
||
'org-link
|
||
'oni-org-link-nonexistent-file))
|
||
|
||
(org-link-set-parameters "file" :face #'oni-org-file-face-selector)
|
||
|
||
;;; Automatically hide code blocks that specify they should be hidden.
|
||
;; Inspired by
|
||
;; https://emacs.stackexchange.com/questions/44914/choose-individual-startup-visibility-of-org-modes-source-blocks
|
||
|
||
(defun oni-org-hide-hidden-code-blocks ()
|
||
"Hide any code blocks that have been marked as hidden.
|
||
This is done by adding a ‘:hidden t’ header argument to the code block."
|
||
(interactive)
|
||
(org-block-map
|
||
(lambda ()
|
||
(let ((element (org-element-at-point)))
|
||
(when (and (equal (org-element-type element) 'src-block)
|
||
(map-elt (nth 2 (org-babel-get-src-block-info)) :hidden))
|
||
(org-fold-hide-block-toggle t nil element))))))
|
||
|
||
(add-hook 'org-mode-hook #'oni-org-hide-hidden-code-blocks)
|
||
|
||
;;; Agenda commands and capture templates
|
||
|
||
(defun oni-org--center-align (text)
|
||
"Return the same TEXT, but with enough space added in front to center align it."
|
||
(format "%s%s"
|
||
(propertize " " 'display `((space :align-to (- ,(/ (window-width) 2)
|
||
,(/ (length text) 2)))))
|
||
text))
|
||
|
||
(defmacro oni-org--map-put (collection key value)
|
||
"The result of ‘(setf (map-elt ...) ...)’ on a list.
|
||
Trying to byte-compile the above form doesn't work at the moment.
|
||
This is a temporary hack to make sure I don't have to repeat this
|
||
same code all the time."
|
||
(declare (indent 2))
|
||
(let ((key-name (gensym))
|
||
(value-name (gensym)))
|
||
`(let ((,key-name ,key)
|
||
(,value-name ,value))
|
||
(condition-case nil
|
||
(with-no-warnings
|
||
(map-put! ,collection ,key-name ,value-name nil))
|
||
(map-not-inplace
|
||
(setq ,collection
|
||
(map-insert ,collection ,key-name ,value-name))
|
||
,value-name)))))
|
||
|
||
(oni-org--map-put org-agenda-custom-commands "P"
|
||
'("Stuck projects" ((org-ql-block '(and (todo) (children) (not (children (todo))))))))
|
||
|
||
(oni-org--map-put org-agenda-custom-commands "o"
|
||
'("Overview" ((org-ql-block '(and (todo)
|
||
(children)
|
||
(not (children (todo))))
|
||
((org-ql-block-header "Stuck projects")))
|
||
(org-ql-block '(and (todo) (not (children)))
|
||
((org-super-agenda-groups '((:auto-parent)))
|
||
(org-ql-block-header "Todo")))
|
||
(agenda ""
|
||
((org-agenda-span 3))))))
|
||
|
||
(oni-org--map-put org-capture-templates "D"
|
||
'("A DONE item for my to-done list." entry (file oni-org-todo-main-file)
|
||
"* DONE %?
|
||
:PROPERTIES:
|
||
:CREATED: %U
|
||
:END:
|
||
:LOGBOOK:
|
||
- State \"DONE\" from \"TODO\" %U
|
||
:END:"))
|
||
|
||
(oni-org--map-put org-capture-templates "t"
|
||
'("A simple TODO item." entry (file "") "* TODO %?
|
||
:PROPERTIES:
|
||
:CREATED: %U
|
||
:END:"))
|
||
|
||
(oni-org--map-put org-capture-templates "U"
|
||
'("A TODO capture from the browser." entry (file "") "* TODO %:description
|
||
:PROPERTIES:
|
||
:CREATED: %U
|
||
:END:
|
||
|
||
%:link"
|
||
:immediate-finish t))
|
||
|
||
;;; Mastodon post dynamic block
|
||
|
||
(defun oni-org-dblock-write-mastodon-post (params)
|
||
(let* ((url (url-generic-parse-url (map-elt params :url)))
|
||
(status-id (car (last (split-string (url-filename url) "/")))))
|
||
(setf (url-filename url) (format "/api/v1/statuses/%s" status-id))
|
||
(let ((json (with-current-buffer (url-retrieve-synchronously url)
|
||
(goto-char (point-min))
|
||
(search-forward "\n\n")
|
||
(json-parse-buffer))))
|
||
(insert (with-temp-buffer
|
||
(insert (map-elt json "content"))
|
||
(let ((dom (libxml-parse-html-region (point-min) (point-max))))
|
||
(erase-buffer)
|
||
(insert "#+begin_quote")
|
||
(let ((start (point)))
|
||
(shr-insert-document dom)
|
||
(forward-char -1)
|
||
(insert " ---" (map-elt (map-elt json "account") "display_name"))
|
||
(org-escape-code-in-region start (point))
|
||
(save-excursion
|
||
(goto-char start)
|
||
(delete-all-space)
|
||
(insert "\n"))
|
||
(let ((fill-column (point-max)))
|
||
(fill-region start (point)))))
|
||
(forward-char)
|
||
(insert "#+end_quote")
|
||
(buffer-string))))))
|
||
|
||
(defun oni-org-insert-mastodon-post (url)
|
||
"Create a dynamic block showing a Mastodon post from URL."
|
||
(interactive "MURL: ")
|
||
(org-create-dblock `(:name "oni-mastodon-post" :url ,url))
|
||
(org-update-dblock))
|
||
|
||
(defalias 'org-dblock-write:oni-mastodon-post 'oni-org-dblock-write-mastodon-post)
|
||
(org-dynamic-block-define "oni-mastodon-post" #'oni-org-insert-mastodon-post)
|
||
|
||
(provide 'oni-org)
|
||
;;; oni-org.el ends here
|