path: root/lisp/documents.el

;;; documents.el -*- lexical-binding: t; -*-
;;;
;;; Author:  Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; URL:     https://git.sr.ht/~jakob/.emacs.d/
;;;
;;; Configuration of packages for working with various kinds of text documents.
;;; Spell-checking, and the like.
;;;

;; Ensure that my Aspell "personal dictionary" is included when invoking ispell.

(setq ispell-personal-dictionary "~/.aspell.en.pws")


;;;
;;; Org
;;;

(use-package org
  :straight org-contrib

  ;; File system of hygene.
  :init
  (setq-default org-id-locations-file "~/.cache/emacs/org-id-locations"
                org-preview-latex-image-directory "~/.cache/emacs/ltximg/"
                org-preview-latex-image-directory "~/.cache/emacs/ltximg/")

  ;; General appearance and quality-of-life settings.
  :init
  (setq org-return-follows-link t
        org-startup-folded nil
        org-cycle-separator-lines -1
        org-startup-with-inline-images t
        org-hide-emphasis-markers t
        org-tags-column 100
        org-yank-folded-subtrees nil
        org-link-elisp-confirm-function nil
        org-capture-bookmark nil)

  ;; Keep everything in column zero, instead of indenting according to the depth
  ;; of the preceding headline.

  :init
  (setq org-adapt-indentation nil)

  ;; Have <tab> indent according to the indentation rules of the corresponding
  ;; mode in an =org-src= block, and start indentation on column 0. Taken from
  ;; [1] and [2].
  ;;
  ;; [1]: https://stackoverflow.com/questions/15773354/indent-code-in-org-babel-src-blocks
  ;; [2]: https://emacs.stackexchange.com/questions/9472/org-mode-source-block-doesnt-respect-parent-buffer-indentation
  :init
  (setq org-src-tab-acts-natively t
        org-edit-src-content-indentation 0)

  ;; Reuse the current window when I punch in <C-c '>, rather than mess up my
  ;; window configuration.
  :init
  (setq org-src-window-setup 'current-window)

  ;; Enable Geiser evaluation for Scheme blocks.
  :config
  (org-babel-do-load-languages
   'org-babel-load-languages
   '((scheme . t)))

  ;; Scale up embedded LaTeX. The default size is unreadable.
  :config
  (setq org-format-latex-options
        (plist-put org-format-latex-options :scale 1.5))

  ;; Don't interpret text following underscores as subscript text unless it is
  ;; enclosed in braces.
  :init
  (setq org-use-sub-superscripts "{}")

  ;; Enable Yasnippet and Flyspell.
  :hook
  (org-mode . yas-minor-mode-on)
  (org-mode . flyspell-mode)

  ;; Replace my Imenu binding with `org-goto,' as it allows me to select parent
  ;; headings.
  :init
  (setq org-goto-interface 'outline-path-completionp)
  (setq org-outline-path-complete-in-steps nil)

  :bind
  (:map org-mode-map
        ("C-c s" . org-goto)
        ("C-c M-q" . auto-fill-mode)
        ("C-M-<return>" . log-todo-creation-date))

  ;; Global keybindings for my Org workflow.
  :bind
  ("C-c a" . org-agenda)
  ("C-c c" . (lambda () (interactive) (org-capture nil "c")))
  ("C-c t" . (lambda () (interactive) (org-capture nil "t")))

  :init
  (setq org-todo-keywords
        '((sequence "TODO(t)" "|" "DONE(d)")
          (sequence "IN-PROGRESS(i)" "BLOCKED(b)" "DBE(r)" "|" "OBE(o)")))

  ;; Use Counsel's functionality for adding tags.
  :bind
  (:map org-mode-map ("C-c C-q" . counsel-org-tag))

  ;; I maintain a personal wiki using Org and I like to link between pages. This
  ;; is just a convenience link type, rooted at the base of my notes folder so
  ;; that I can easily refer to other pages from subdirectories of
  ;; `notes-directory'.
  :config
  (defvar notes-directory "~/Notes"
    "Where all the pages of my 'personal wiki' are stored.")

  (defun org-notes-follow (link)
    "Open LINK, an Org link from a notes buffer.
Visits LINK, or if LINK names a subdirectory of
`notes-directory', the 'Index.org' in LINK."
    (let ((directory-p (file-directory-p (expand-file-name link notes-directory))))
      (find-file (expand-file-name (if directory-p "Index.org" (concat link ".org"))
                                   notes-directory))))

  (org-link-set-parameters "note" :follow #'org-notes-follow)

  ;; Code for interactively navigating the personal wiki.
  :config
  (defvar notes-directory-ignore
    '("." ".." ".git" ".gitignore" ".strfolder" "Drill" "GTD")
    "Files and directories in `notes-directory' to exclude from
  wiki interactions.")

  (defun notes-file-is-page (filename)
    "Returns whether or not FILENAME names a page rather than a category."
    (string= (cl-subseq filename (- (length filename) 4)) ".org"))

  (defun notes-file-should-ignore (filename)
    "Returns whether or not a file in `notes-directory' should be ignored.
  Members of `notes-directory-ignore' are ignored."
    (member filename notes-directory-ignore))

  (defun notes-hierarchy-paths (&optional category)
    "Returns page and category paths relative to `notes-directory'.
  The resultant list does not include files that satisfy the
  `notes-file-should-ignore' predicate."
    (let* ((path (if category
                     (concat notes-directory "/" category)
                   notes-directory))
           (contents (cl-remove-if #'notes-file-should-ignore
                                   (directory-files path)))
           (pages (cl-remove-if-not #'notes-file-is-page contents))
           (categories (cl-remove-if-not #'(lambda (subcategory)
                                             (file-directory-p (concat path "/" subcategory)))
                                         contents))
           (categories (if category
                           (mapcar #'(lambda (subcategory) (concat category "/" subcategory))
                                   categories)
                         categories)))
      (append (if category
                  (mapcar #'(lambda (page) (concat category "/" page)) pages)
                pages)
              categories
              (apply #'append (mapcar #'notes-hierarchy-paths categories)))))

  (defun notes-hierarchy ()
    "Returns every page and category in `notes-directory'.
    The result contains lists of the form (NAME PATH IS-PAGE-P), and
    does not include files that satisfy the
    `notes-file-should-ignore' predicate."
    (mapcar #'(lambda (path) (list
                         (cond ((cl-search "Index.org" path)
                                (let ((name (cl-subseq path 0 -9)))
                                  (if (string= name "")
                                      "/"
                                    name)))
                               ((notes-file-is-page path) (cl-subseq path 0 -4))
                               (t path))
                         (concat notes-directory "/" path)
                         (notes-file-is-page path)))
            (notes-hierarchy-paths)))

  (defun notes-page-goto (&optional initial-input)
    "Interactively find a page in `notes-directory'."
    (interactive)
    (let* ((hierarchy (notes-hierarchy))
           (hierarchy (cl-remove-if-not #'cl-third hierarchy))
           (name (completing-read "Find file: " (mapcar #'cl-first hierarchy)
                                  nil nil initial-input))
           (item (cl-find-if #'(lambda (item) (string= name (cl-first item))) hierarchy)))
      (if item
          (find-file (cl-second item))
        (let ((path (concat notes-directory "/" name ".org")))
          (find-file path)))))

  ;; Set up a key binding for quickly querying the wiki.
  :bind
  ("C-c w" . notes-page-goto)
  ("C-c j" . (lambda () (interactive) (notes-page-goto (format-time-string "Journal/%Y-%m-%d "))))
  ("C-c h" . (lambda () (interactive) (notes-page-goto (format-time-string "Work/%Y-%m-%d "))))

  ;; Low-friction means of adding things to my GTD inbox.
  :config
  (setq org-capture-templates
        `(("t" "TODO" entry (file "~/Notes/GTD/Inbox.org")
           "* TODO %?\n")
          ("l" "Ledger" plain (file ,(format "~/Docs/Finance/%s.ledger"
                                             (elt (calendar-current-date) 2)))
           "%(org-read-date) %^{Payee}")))


  ;; A rather convoluted agenda setup, which presents me an option of two
  ;; specialized views.
  ;;
  ;; One is my daily "calendar", which shows
  ;; - My daily habits (implemented as recurring Org TODO's).
  ;; - A view of deadlines and scheduled items for the week ahead.
  ;;
  ;; The other is my flexible TODO list, which shows
  ;; - All tasks I've marked as needing to be done this week.
  ;; - The inbox items I need to process.
  :init
  (setq org-agenda-files '("~/Notes/GTD/Habits.org"
                           "~/Notes/GTD/Inbox.org"
                           "~/Notes/GTD/Actionable.org"))

  (let ((entry-done
         '(lambda () (org-agenda-skip-entry-if 'todo 'done)))
        (subtree-is-not-calendar-item
         '(lambda ()
            (let ((subtree-end (save-excursion (org-end-of-subtree t))))
              (if (or (string= (org-entry-get nil "STYLE") "habit")
                      (not (org-entry-get nil "SCHEDULED")))
                  subtree-end
                nil))))
        (subtree-is-not-habit
         '(lambda ()
            (let ((subtree-end (save-excursion (org-end-of-subtree t))))
              (if (not (string= (org-entry-get nil "STYLE") "habit"))
                  subtree-end
                nil))))
        (subtree-is-not-inbox
         '(lambda ()
            (let ((subtree-end (save-excursion (org-end-of-subtree t))))
              (if (not (cl-search "Inbox.org" (buffer-name)))
                  subtree-end
                nil))))
        (subtree-is-not-flexible
         '(lambda ()
            (let ((subtree-end (save-excursion (org-end-of-subtree t))))
              (if (or (string= (org-entry-get nil "STYLE") "habit")
                      (not (member (org-entry-get nil "TODO")
                                   '("TODO" "IN-PROGRESS")))
                      ;; Ignore if scheduled timestamp has range
                      (and (org-entry-get nil "SCHEDULED")
                           (string-match "[[:digit:]][[:digit:]]:[[:digit:]][[:digit:]]-[[:digit:]][[:digit:]]:[[:digit:]][[:digit:]]" (org-entry-get nil "SCHEDULED")))
                      (cl-search "Inbox.org" (buffer-name)))
                  subtree-end
                nil)))))
    (setq org-agenda-custom-commands
          `(("d" "Daily Calendar"
             ((agenda ""
                      ((org-agenda-span 'week)
                       (org-agenda-skip-function ,subtree-is-not-calendar-item)
                       (org-agenda-overriding-header "Week Ahead:")
                       (org-agenda-prefix-format " %i %-12:c%t %l")
                       (org-agenda-entry-types '(:scheduled*)))))
             ((org-agenda-compact-blocks t)))
            ("D" "Daily Todo"
             ((agenda ""
                      ((org-agenda-span 'day)
                       (org-agenda-skip-function ,subtree-is-not-calendar-item)
                       (org-agenda-overriding-header "Schedule Today:")
                       (org-agenda-prefix-format " %i %-12:c%t %l")))
              (agenda ""
                      ((org-agenda-span 'day)
                       (org-agenda-skip-function ,subtree-is-not-habit)
                       (org-deadline-warning-days 0)
                       (org-agenda-overriding-header "Habits:")))
              (alltodo ""
                       ((org-agenda-span 'week)
                        (org-agenda-skip-function ,subtree-is-not-flexible)
                        (org-agenda-overriding-header "Flexible Tasks:")))
              (alltodo ""
                       ((org-agenda-skip-function ,subtree-is-not-inbox)
                        (org-agenda-overriding-header "Needs Processing:"))))
             ((org-agenda-compact-blocks t)
              (org-agenda-overriding-columns-format "%TODO %EFFORT %ITEM %CATEGORY %TAGS"))))))

  ;; Introduce a "rank" for sorting the TODO agenda in a way which is
  ;; persistent. Specifically, we introduce `user-defined-up' to the sorting
  ;; strategies for `todo'.
  (setq org-agenda-sorting-strategy
        '((agenda habit-down time-up priority-down category-keep)
          (todo user-defined-up priority-down category-keep)
          (tags priority-down category-keep)
          (search category-keep)))

  (defun org-agenda-update-rank ()
    "Interactive command to assign a rank to all agenda entries"
    (interactive)
    (save-excursion
      (let ((i 0))
        (message (format "%s" i))
        (goto-char 0)
        (while (= 0 (forward-line 1))
          (move-beginning-of-line 1)
          (let ((orig (get-text-property (point) 'org-marker)))
            (when orig
              (org-with-point-at orig
                (org-entry-put nil "RANK" (number-to-string i))
                (setq i (+ i (expt 10 (- 4 (org-current-level))))))))
          (message (format "%s" (point)))))))

  (defun org-agenda-clear-rank ()
    "Interactive command to reset the rank on all agenda entries"
    (interactive)
    (save-excursion
      (goto-char 0)
      (while (= 0 (forward-line 1))
        (move-beginning-of-line 1)
        (let ((orig (get-text-property (point) 'org-marker)))
          (when orig
            (org-with-point-at orig
              (org-entry-delete nil "RANK")))))))

  (defun org-agenda-sort-by-rank (a b)
    (let* ((a-pos (get-text-property 0 'org-marker a))
           (b-pos (get-text-property 0 'org-marker b))
           (rank-a (string-to-number (or (org-entry-get a-pos "RANK") "9999")))
           (rank-b (string-to-number (or (org-entry-get b-pos "RANK") "9999"))))
      (cond ((> rank-a rank-b) +1)
            ((< rank-a rank-b) -1)
            (t nil))))
  (setq org-agenda-cmp-user-defined #'org-agenda-sort-by-rank)

  (setq org-agenda-prefix-format
        '((agenda . " %i %-12:c%?-12t%s %l")
          (todo . "%-3e %l")
          (tags . " %i %-12:c")
          (search . " %i %-12:c")))

  ;; Track the date and time that tasks are marked as DONE.
  (setq org-log-done 'time)

  ;; Functionality to add a `CREATED' property -- I don't need something so
  ;; intrusive that it inserts it for every heading. I can use my own
  ;; discretion.
  (defun log-todo-creation-date (&rest ignore)
    "Log TODO creation time in the property drawer under the key 'CREATED'."
    (interactive)
    (when (and (org-get-todo-state)
               (not (org-entry-get nil "CREATED")))
      (org-entry-put nil "CREATED" (format-time-string (cdr org-time-stamp-formats)))))

  ;; Patch in an offset for tag alignment. (Without this, they will warp in a
  ;; way which I do not like.)
  :init
  (el-patch-defun org-agenda-align-tags (&optional line)
    "Align all tags in agenda items to `org-agenda-tags-column'.
    When optional argument LINE is non-nil, align tags only on the
    current line."
    (let ((inhibit-read-only t)
          (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
                                      (el-patch-swap (window-max-chars-per-line) (- 2 (window-max-chars-per-line)))
                                    org-agenda-tags-column))
          (end (and line (line-end-position)))
          l c)
      (save-excursion
        (goto-char (if line (line-beginning-position) (point-min)))
        (while (re-search-forward org-tag-group-re end t)
          (add-text-properties
           (match-beginning 1) (match-end 1)
           (list 'face (delq nil (let ((prop (get-text-property
                                              (match-beginning 1) 'face)))
                                   (or (listp prop) (setq prop (list prop)))
                                   (if (memq 'org-tag prop)
                                       prop
                                     (cons 'org-tag prop))))))
          (setq l (string-width (match-string 1))
                c (if (< org-agenda-tags-column 0)
                      (- (abs org-agenda-tags-column) l)
                    org-agenda-tags-column))
          (goto-char (match-beginning 1))
          (delete-region (save-excursion (skip-chars-backward " \t") (point))
                         (point))
          (insert (org-add-props
                      (make-string (max 1 (- c (current-column))) ?\s)
                      (plist-put (copy-sequence (text-properties-at (point)))
                                 'face nil))))
        (goto-char (point-min))
        (org-font-lock-add-tag-faces (point-max))))))

(use-package org-drill
  ;; org-drill in upstream Org is unmaintained, and as described in [1], no
  ;; longer works with the latest version of Org. I'm was previously using this
  ;; fork [2], but the maintainer has since begun working on another fork [3]
  ;; which is where I am now.
  ;;
  ;; [1]: https://bitbucket.org/eeeickythump/org-drill/issues/62/org-drill-doesnt-work-with-org-mode-92
  ;; [2]: https://bitbucket.org/eeeickythump/org-drill/issues/63/maintainership
  ;; [3]: https://gitlab.com/phillord/org-drill/-/blob/master/org-drill.el
  :straight (org-drill :type git :host gitlab :repo "phillord/org-drill")

  ;; Update LaTeX fragments when showing them to me.
  :init
  (with-eval-after-load 'org-drill
    (defun org-drill--show-latex-fragments ()
      (org-latex-preview '(16))))

    ;; Scan the directory of the current buffer's file for other items, rather
  ;; than just the current buffer. This is so that I can spread my cards across
  ;; multiple files and still be tested on all of them when I run `org-drill'.
  ;; The idea of combining topic during review sessions is suggested in Michael
  ;; Nielsen's article [1].
  ;;
  ;; [1]: http://augmentingcognition.com/ltm.html
  :init
  (setq org-drill-scope 'directory)

  ;; Use the SM-2 algorithm rather than the default SM-5 algorithm. I have faith
  ;; in Anki's analysis of SM-5 [1] in the form that it is available.
  ;;
  ;; [1]: https://apps.ankiweb.net/docs/manual.html#what-about-sm-5
  :init
  (setq org-drill-spaced-repetition-algorithm 'sm2)

  ;; Shut up the nagging "are you studying enough!?" message if I don't get
  ;; enough items right. It's unhelpful and discourages me from being honest
  ;; with the SRS algorithm.
  :init
  (setq org-drill-forgetting-index 100)

  ;; Set up a keybinding for getting quickly starting a drill session.
  :bind
  ("<f11>" . (lambda ()
               (interactive)
               (let* ((drill-directory (concat notes-directory "/" "Drill"))
                      (path (-first #'(lambda (path) (s-ends-with-p ".org" path))
                                    (directory-files drill-directory t))))
                 (find-file path)
                 (org-drill))))

  ;; Kill all org-drill files when the session is over.
  ;;
  ;; n.b. this depends on this PR.
  ;; <https://gitlab.com/phillord/org-drill/-/merge_requests/17>
  :hook
  (org-drill-session-complete .
     (lambda ()
       (dolist (buf (cl-remove-if-not
                     #'(lambda (buf)
                         (cl-search "Notes/Drill" (buffer-file-name buf)))
                     (buffer-list)))
         (kill-buffer buf)))))

;; The org-download package is incredible for quickly pull images into Org
;; documents.

(use-package org-download
  ;; Configure it to use 'scrot' and the 'org-attach' machinery.
  :init
  (setq org-download-screenshot-method "scrot -s %s")
  (setq org-download-method 'attach))

;; Use org-fragatog for sane editing of LaTeX fragments.

(use-package org-fragtog
  :hook (org-mode . org-fragtog-mode))

;; When exporting Org as HTML, include syntax highlighting.

(use-package htmlize
  :config
  (setq org-html-htmlize-output-type 'css))


;;;
;;; Ledger
;;;

(use-package ledger-mode
  :hook
  (ledger-mode . flycheck-mode)
  (ledger-mode . company-mode))

(use-package flycheck-ledger)


;;;
;;; LaTeX
;;;

(use-package latex-mode
  :straight nil
  :hook
  (latex-mode . smartparens-mode)
  (latex-mode . yas-minor-mode))


;;;
;;; PDF
;;;

;; `doc-view' is unbearable for reading PDF's of any considerable size and
;; `pdf-tools' brings a number of significant improvements, so I can justify not
;; using the built-in solution. Even though I can run MuPDF in an EXWM buffer,
;; the integration in terms of searching and viewing attachments that comes with
;; pdf-tools makes for a much more pleasant experience.

(use-package pdf-tools
  :demand t
  :config
  (pdf-tools-install))