emacs-config/oni-org/oni-org.el

;;; oni-org.el --- Org mode configuration            -*- lexical-binding: t; -*-

;; Copyright (C) 2019  Tom Willemse

;; Author: Tom Willemse <tom@ryuslash.org>
;; Keywords: local
;; Version: 2021.0329.100019
;; Package-Requires: (oni-yasnippet oni-alert oni-hydra org-plus-contrib org-bullets org-edna diminish all-the-icons org-journal)

;; 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 Gradient Line style of Icons 8.
;; See URL ‘https://icons8.com’.

;;; Code:

(require 'diminish)
(require 'hydra)
(require 'ob)
(require 'ol-man)
(require 'org)
(require 'org-clock)
(require 'org-edna)
(require 'org-element)
(require 'org-faces)
(require 'org-habit)
(require 'org-protocol)
(require 'subr-x)
(require 'yasnippet)

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

(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-setup-prettify-symbols-mode ()
  "Set up prettify symbols mode for org mode."
  (setq-local prettify-symbols-alist
              '(("[ ]" . ?)
                ("[X]" . ?)))
  (prettify-symbols-mode))

;;;###autoload
(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 (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/gtd/index.org")))

(defun oni-org-color-for (object)
  "Generate a hex color by taking the first 6 characters of OBJECT’s MD5 sum."
  (format "#%s" (substring (md5 object) 0 6)))

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

;;;###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
^^                        ^^                         _f_: Add roam note
^^                        ^^                         _i_: Insert other note
"
  ("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" (if (require 'oni-org-roam nil t)
           (call-interactively 'org-roam-find-file)
         (error "Couldn’t load org-roam, you should install ‘oni-org-roam’")))
  ("i" (if (require 'oni-org-roam nil t)
           (call-interactively 'org-roam-insert-immediate)
         (error "Couldn’t load org-roam, you should install ‘oni-org-roam’"))))

(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 (alist-get "CUSTOM_ID" (org-entry-properties) nil nil #'string=))
        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 `(and "#" ,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"))))

(defalias 'org-dblock-write:oni-backlinks 'oni-org-dblock-write-backlinks)

(setq org-catch-invisible-edits 'error)
(setq org-clock-in-switch-to-state #'oni-org-maybe-change-todo-state)
(setq org-fontify-whole-heading-line t)
(setq org-habit-graph-column 60)
(setq org-tags-column -72)
(setq org-tags-sort-function #'string<)
(setq org-hide-emphasis-markers t)
(setq org-hide-macro-markers t)
(setq org-log-into-drawer t)
(setq org-return-follows-link t)
(setq org-return-follows-link t)
(setq org-src-fontify-natively t)
(setq org-use-fast-todo-selection t)

;; 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 "~/documents/gtd/everything.org")
(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))))

(setq org-todo-keywords
      '((sequence "TODO(t)" "NEXT(n)" "BLOCKED(b@)" "IN-PROGRESS(p)"
                  "|" "DONE(d!)" "CANCELLED(c@)")))

(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-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 'electric-quote-local-mode)
(add-hook 'org-mode-hook 'flyspell-mode)
(add-hook 'org-mode-hook 'org-indent-mode)
(add-hook 'org-mode-hook 'visual-line-mode)

(org-edna-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") 'oni-hydra-org/body)

;;;###autoload
(global-set-key (kbd "C-<home>") #'oni-org-open-index)

;;;###autoload
(with-eval-after-load 'org
  (with-eval-after-load 'yasnippet
    (oni-org-snippets-initialize)))

(with-eval-after-load 'org-edna (diminish 'org-edna-mode))

;;;###autoload(with-eval-after-load 'org (require 'oni-org))


;;;; 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’."
  (let* ((icon-height (window-default-font-height))
         (defaults `(png nil :height ,icon-height :ascent center)))
   (setq org-agenda-category-icon-alist
         `((,(rx string-start "task" string-end) ,(expand-file-name "icons8-checkmark-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "inbox" string-end) ,(expand-file-name "icons8-inbox-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "email" string-end) ,(expand-file-name "icons8-email-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "life" string-end) ,(expand-file-name "icons8-sprout-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "feature" string-end) ,(expand-file-name "icons8-code-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "work" string-end) ,(expand-file-name "icons8-workstation-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "game" string-end) ,(expand-file-name "icons8-game-controller-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "shopping" string-end) ,(expand-file-name "icons8-shopping-cart-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "bug" string-end) ,(expand-file-name "icons8-bug-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "idea" string-end) ,(expand-file-name "icons8-light-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "article" string-end) ,(expand-file-name "icons8-blog-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "project" string-end) ,(expand-file-name "icons8-project-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "ebook" string-end) ,(expand-file-name "icons8-ebook-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "book" string-end) ,(expand-file-name "icons8-book-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "Morning Cup of Coding" string-end) ,(expand-file-name "icons8-tea-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "paper" string-end) ,(expand-file-name "icons8-paper-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "question" string-end) ,(expand-file-name "icons8-question-mark-64.png" oni-org-icons-dir) ,@defaults)
           (,(rx string-start "music" string-end) ,(expand-file-name "icons8-musical-notes-64.png" oni-org-icons-dir) ,@defaults)))))

(setq org-agenda-files
      (cons org-default-notes-file
            (when (file-exists-p "~/documents/org/projects/")
              (directory-files "~/documents/org/projects/" t "\\.org\\'"))))
(setq org-agenda-tags-todo-honor-ignore-options t)
(setq org-agenda-todo-ignore-scheduled 'future)

(setq org-agenda-custom-commands
      '(("i" "Inbox" tags "CATEGORY=\"inbox\"")
        ("t" "Todo" tags-todo "TODO=\"TODO\"-CATEGORY=\"inbox\"+SCHEDULED=\"\"")
        ("r" "Reading list" tags-todo "TODO=\"READ\"+SCHEDULED=\"\"")
        ("s" "Someday" tags-todo "TODO=\"TODO\"-CATEGORY=\"inbox\"")
        ("p" "Projects & ideas" tags "CATEGORY=\"project\"|CATEGORY=\"idea\"")
        ("c" "Today's (Current) tasks" tags "SCHEDULED=\"<today>\"")
        ("w" . "Work topics")
        ("wo" "Overview" ((tags-todo "+work+FOR=\"\"")
                          (tags-todo "+work+FOR=\"Jordan\"")
                          (tags-todo "+work+FOR=\"Remy\"")))
        ("wt" "Work todo" tags-todo "+work+FOR=\"\"")
        ("wj" "Topics for Jordan" tags-todo "+work+1o1+FOR=\"Jordan\"")
        ("wr" "Topics for Remy" tags-todo "+work+1o1+FOR=\"Remy\"")
        ("S" "Shopping" tags-todo "+shopping")))

(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."
  (with-selected-frame (make-frame '((minibuffer)))
    (org-capture nil "t")
    (delete-other-windows)
    (setf (frame-width) 80)
    (setf (frame-height) 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)))

(setq org-capture-templates
      `(("i" "Inbox" entry (file "")
         (file ,(expand-file-name "inbox.org" oni-org-capture-template-directory)))
        ("I" "Inbox (add selection)" entry (file "")
         (file ,(expand-file-name "inbox-with-selection.org" oni-org-capture-template-directory)))
        ("t" "Task" entry (file "")
         (file ,(expand-file-name "task.org" oni-org-capture-template-directory)))
        ("a" "Appointment" entry (file "")
         (file ,(expand-file-name "appointment.org" oni-org-capture-template-directory)))
        ("u" "URL to read" entry (file "")
         (file ,(expand-file-name "reading-url.org" oni-org-capture-template-directory))
         :immediate-finish t)
        ("U" "URL to read" entry (file "")
         (file ,(expand-file-name "reading-url-protocol.org" oni-org-capture-template-directory))
         :immediate-finish t)
        ("j" "Journal entry" entry
         (file+olp+datetree
          ,(oni-org-expand-to-home "documents/gtd/journal.org"))
         (file ,(expand-file-name "journal.org" oni-org-capture-template-directory)))
        ("n" "Reading note" item (function oni-org-reading-note)
         (file ,(expand-file-name "reading-note.org" oni-org-capture-template-directory))
         :empty-lines 1)
        ("c" "Add to currently clocked item")
        ("ca" "Note" plain
         (clock)
         (file ,(expand-file-name "clocked/note.org" oni-org-capture-template-directory))
         :empty-lines 1)
        ("ci" "Item to current clocked task" item
         (clock)
         (file ,(expand-file-name "clcoked/item.org" oni-org-capture-template-directory))
         :empty-lines 1)
        ("cc" "Marked code example with notes" plain
         (clock)
         (file ,(expand-file-name "clocked/code-note.org" oni-org-capture-template-directory))
         :empty-lines 1)
        ("cC" "Marked code example" plain
         (clock)
         (file ,(expand-file-name "clocked/code.org" oni-org-capture-template-directory))
         :immediate-finish t
         :empty-lines 1)
        ("ck" "Kill-ring contents" plain
         (clock)
         (file ,(expand-file-name "clocked/kill-ring.org" oni-org-capture-template-directory))
         :immediate-finish t
         :empty-lines 1)))

(setq org-capture-templates-contexts
      '(("n" ((in-mode . "nov-mode")))))

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

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

(setq org-refile-targets '((org-default-notes-file . (:maxlevel . 10))))

;;; org-journal

(setq org-journal-dir (expand-file-name "~/documents/org/journal/"))
(setq org-journal-file-format "%Y%m%d.org")

(provide 'oni-org)
;;; oni-org.el ends here