1 files changed, 377 insertions, 0 deletions

@@ -0,0 +1,377 @@
+;;; acdw-org.el --- My org customizations  -*- lexical-binding: t; -*-
+
+;;; Code:
+
+(require 'cl-lib)
+
+;;; Variables
+
+(defcustom org-agenda-skip-file-regexp nil
+  "Files matching this regexp are removed from `org-agenda-files'."
+  :group 'org-agenda
+  :type 'regexp)
+
+;;; Functions
+
+
+;;; DWIM
+
+;; https://github.com/alphapapa/unpackaged.el,
+;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
+(defun +org-return-dwim (&optional arg)
+  "A helpful replacement for `org-return'.
+When called interactively with \\[universal-argument], call `org-return'
+itself.  Other values of ARG will call `newline' with that ARG."
+  (interactive "P")
+  ;; Auto-fill if enabled
+  (when auto-fill-function
+    (dolist (func (ensure-list auto-fill-function))
+      (funcall func)))
+  (cl-letf* ((el (org-element-at-point))
+             ((symbol-function 'el-child-of)
+              (lambda (&rest types)
+                (org-element-lineage el types t))))
+    (cond                                ; Figure out what we're going to do
+     (arg                                ; Handle prefix ARG
+      (pcase arg
+        ('(4) (org-return t nil t))
+        (_ (newline arg t))))
+     ((and org-return-follows-link      ; Open a link
+           (el-child-of 'link))
+      (org-open-at-point-global))
+     ((org-at-heading-p)                ; Open a paragraph after a heading
+      (let ((heading-start (org-entry-beginning-position)))
+        (goto-char (org-entry-end-position))
+        (cond ((and (org-at-heading-p)      ; Entry is only a heading
+                    (= heading-start (org-entry-beginning-position)))
+               (end-of-line)
+               (newline 2))
+              (:else                    ; Entry is more than a heading
+               (forward-line -1)
+               (end-of-line)
+               (when (org-at-heading-p)
+                 ;; Open a paragraph
+                 (forward-line)
+                 (newline)
+                 (forward-line -1))
+               (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
+                 (newline))
+               (forward-line -1)))))
+     ((org-at-item-checkbox-p)          ; Insert a new checkbox item
+      (end-of-line)
+      (org-insert-todo-heading nil))
+     ((org-in-item-p)                   ; Insert a new list item
+      (let* ((context (org-element-context el))
+             (first-item-p (eq 'plain-list (car context)))
+             (itemp (eq 'item (car context)))
+             (emptyp (or
+                      ;; This (regular) list item is empty
+                      (eq (org-element-property :contents-begin context)
+                          (org-element-property :contents-end context))
+                      ;; This (definition) list item is empty
+                      (looking-at " *::")))
+             (item-child-p (el-child-of 'item)))
+        (cond ((and itemp emptyp)
+               ;; This test has to be here even though it's the same as the
+               ;; :else clause, because an item that's empty will also satisfy
+               ;; the next clause.
+               (delete-region (line-beginning-position) (line-end-position))
+               (newline))
+              ((or first-item-p
+                   (and itemp (not emptyp))
+                   item-child-p)
+               (org-end-of-item)
+               (org-insert-item))
+              (:else
+               (delete-region (line-beginning-position) (line-end-position))
+               (newline)))))
+     ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
+           (org-inlinetask-in-task-p))
+      (org-return))
+     ((org-at-table-p)                  ; Insert a new table row
+      (cond ((save-excursion            ; Empty row: end the table
+               (beginning-of-line)
+               (cl-loop with end = (line-end-position)
+                        for cell = (org-element-table-cell-parser)
+                        always (eq (org-element-property :contents-begin cell)
+                                   (org-element-property :contents-end cell))
+                        while (re-search-forward "|" end t)))
+             (delete-region (line-beginning-position) (line-end-position))
+             (org-return))
+            (:else                      ; Non-empty row
+             (org-return))))
+     (:else                             ; Something else
+      (org-return)))))
+
+(defun +org-table-copy-down|+org-return-dwim (&optional n)
+  "Call `org-table-copy-down' or `+org-return' depending on context."
+  (interactive "P")
+  (if (org-table-check-inside-data-field 'noerror)
+      (org-table-copy-down (or n 1))
+    (+org-return-dwim n)))
+
+
+;;; Buffer view cleanup
+
+(defun +org-hide-drawers-except-point ()
+  "Hide all drawers except for the one point is in."
+  ;; Most of this bit is taken from `org-fold--hide-drawers'.
+  (let ((pt (point))
+        (begin (point-min))
+        (end (point-max)))
+    (save-excursion
+      (goto-char begin)
+      (while (and (< (point) end)
+                  (re-search-forward org-drawer-regexp end t))
+        (if (org-fold-folded-p nil 'drawer)
+            (goto-char (org-fold-next-folding-state-change 'drawer nil end))
+          (let* ((drawer (org-element-at-point))
+                 (type (org-element-type drawer))
+                 (el-begin (org-element-property :begin drawer))
+                 (el-end (org-element-property :end drawer)))
+            (when (memq type '(drawer property-drawer))
+              (org-fold-hide-drawer-toggle
+               (if (< el-begin pt el-end) 'off 'on)
+               nil drawer)
+              (goto-char el-end))))))))
+
+
+;;; Copy rich text to the keyboard
+;; Thanks to Oleh Krehel:
+;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
+;; So.  Emacs can't do this itself because it doesn't support sending clipboard
+;; or selection contents as text/html.  We have to use xclip instead.
+(defun org-to-html-to-clipboard (&rest org-export-args)
+  "Export current org buffer to HTML, then copy it to the clipboard.
+ORG-EXPORT-ARGS are passed to `org-export-to-file'."
+  (let ((f (make-temp-file "org-html-export")))
+    (apply #'org-export-to-file 'html f org-export-args)
+    (start-process "xclip" " *xclip*"
+                   "xclip" "-verbose" "-i" f
+                   "-t" "text/html" "-selection" "clipboard")
+    (message "HTML pasted to clipboard.")))
+
+(defun org-subtree-to-html-to-clipboard ()
+  "Export current subtree to HTML."
+  (interactive)
+  (org-to-html-to-clipboard nil :subtree))
+
+
+;;; Prompting
+
+(defun +org-prompt-for-property (property &optional clipboardp insert list)
+  "Prompt for PROPERTY and return a properly-formatted string.
+Pre-fill the input with clipboard contents if they match CLIPBOARDP.  If
+CLIPBOARDP is nil or missing, don't pre-fill.
+
+If INSERT is non-nil, insert the property into the property
+drawer of the current org tree.
+
+If LIST is non-nil, return the result as a list instead of a string."
+  (let* ((kill (current-kill 0))
+         (value (read-string (concat property ": ")
+                             (when (and clipboardp
+                                        (or (eq clipboardp t)
+                                            (funcall clipboardp kill)))
+                               kill))))
+    (when insert
+      (org-set-property property value))
+    (if list
+        (list property value)
+      (format ":%s: %s" property value))))
+
+(defun +org-prompt-tags (&optional prompt global)
+  (let* ((buffer (org-capture-get :buffer))
+         (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
+         (org-last-tags-completion-table
+          (org-global-tags-completion-table
+           (if global (org-agenda-files) (list file))))
+         (org-add-colon-after-tag-completion t)
+         (ins (mapconcat
+               #'identity
+               (let ((crm-separator "[ \t]*:[ \t]*"))
+                 (completing-read-multiple
+                  (or prompt "Tags: ")
+                  org-last-tags-completion-table nil nil nil
+                  'org-tags-history))
+               ":")))
+    (when (org-string-nw-p ins)
+      (prog1 (concat
+              (unless (eq (char-before) ?:) ":")
+              ins
+              (unless (eq (char-after) ?:) ":"))
+        (when (org-at-heading-p) (org-align-tags))))))
+
+
+;;; Faces
+
+(defface org-bold '((t (:weight bold)))
+  "Bold face in `org-mode' documents.")
+
+(defface org-italic '((t (:slant italic)))
+  "Italic face in `org-mode' documents.")
+
+(defface org-underline '((t (:underline t)))
+  "Underline face in `org-mode' documents.")
+
+(defface org-strikethrough '((t (:strike-through t)))
+  "Strike-through face for `org-mode' documents.")
+
+
+;;; Packages
+
+(use-package org
+  :defer t
+  :config
+  ;; Options
+  (setopt org-adapt-indentation nil
+          org-auto-align-tags t
+          org-archive-mark-done t
+          org-fold-catch-invisible-edits 'show-and-error
+          org-clock-clocked-in-display 'mode-line
+          org-clock-string-limit 7     ; just the clock bit
+          org-clock-persist nil
+          org-confirm-babel-evaluate nil
+          org-cycle-separator-lines 0
+          org-deadline-warning-days 0
+          org-directory (sync/ "org/" t)
+          org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…")
+          org-emphasis-alist '(("*" org-bold)
+                               ("/" org-italic)
+                               ("_" org-underline)
+                               ("=" org-verbatim)
+                               ("~" org-code)
+                               ("+" org-strikethrough))
+          org-fontify-done-headline t
+          org-fontify-quote-and-verse-blocks t
+          org-fontify-whole-heading-line t
+          org-hide-emphasis-markers t
+          org-html-coding-system 'utf-8-unix
+          org-image-actual-width (list (* (window-font-width)
+                                          (- fill-column 8)))
+          org-imenu-depth 3
+          org-indent-indentation-per-level 0
+          org-indent-mode-turns-on-hiding-stars nil
+          org-insert-heading-respect-content t
+          org-list-demote-modify-bullet '(("-" . "+")
+                                          ("+" . "-"))
+          org-log-done 'time
+          org-log-into-drawer t
+          org-num-skip-commented t
+          org-num-skip-unnumbered t
+          org-num-skip-footnotes t
+          org-outline-path-complete-in-steps nil
+          org-pretty-entities t
+          org-pretty-entities-include-sub-superscripts nil
+          org-refile-targets '((nil . (:maxlevel . 2))
+                               (org-agenda-files . (:maxlevel . 1)))
+          org-refile-use-outline-path 'file
+          org-special-ctrl-a/e t
+          org-special-ctrl-k t
+          org-src-fontify-natively t
+          org-src-tab-acts-natively t
+          org-src-window-setup 'current-window
+          org-startup-truncated nil
+          org-startup-with-inline-images t
+          org-tags-column 0
+          org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
+                                        "|" "DONE(d!)" "ASSIGNED(a@/!)")
+                              (sequence "|" "CANCELED(k@)")
+                              (sequence "MEETING(m)"))
+          org-use-fast-todo-selection 'auto
+          org-use-speed-commands t)
+  ;; Keys
+  (keymap-set org-mode-map "C-M-k" #'kill-paragraph)
+  (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs)
+  (keymap-set org-mode-map "RET" #'+org-return-dwim)
+  (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim)
+  ;; Hooks
+  (add-hook 'org-mode-hook #'variable-pitch-mode)
+  (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
+  (add-hook 'org-mode-hook #'visual-fill-column-mode)
+  (add-hook 'org-mode-hook #'turn-off-auto-fill)
+  (add-hook 'org-mode-hook #'org-indent-mode)
+  (add-hook 'org-mode-hook #'abbrev-mode)
+  (add-hook 'org-mode-hook (defun before-save@org-mode ()
+                             (org-align-tags 'all)
+                             (+org-hide-drawers-except-point))))
+
+(use-package org-agenda
+  :bind (("C-c a" . org-agenda))
+  :config
+  (setopt org-agenda-skip-deadline-if-done t
+          org-agenda-skip-scheduled-if-done t
+          org-agenda-span 10
+          org-agenda-block-separator ?─
+          org-agenda-time-grid
+          '((daily today require-timed)
+            (800 1000 1200 1400 1600 1800 2000)
+            " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
+          org-agenda-current-time-string
+          "← now ─────────────────────────────────────────────────"
+          org-agenda-include-diary nil ; I use the org-diary features
+          org-agenda-todo-ignore-deadlines 'near
+          org-agenda-todo-ignore-scheduled 'future
+          org-agenda-include-deadlines t
+          org-deadline-warning-days 0
+          org-agenda-show-future-repeats 'next
+          org-agenda-window-setup 'current-window
+          org-agenda-skip-file-regexp "sync-conflict")
+  ;; Hooks and advice
+  (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
+  (add-hook 'org-agenda-mode-hook #'hl-line-mode)
+  (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
+  (define-advice org-agenda-files (:filter-return (files) skip-regexp)
+    "Filter some files from `org-agenda'."
+    (when org-agenda-skip-file-regexp
+      (setq files
+            (cl-remove-if (lambda (file)
+                            (string-match-p org-agenda-skip-file-regexp
+                                            file))
+                          files)))
+    files))
+
+(use-package org-capture
+  :bind (("C-c c" . org-capture)))
+
+(use-package ol                         ; org-link
+  :after org
+  :preface
+  (defmacro +org-link-define-type (type args &rest body)
+    "Define an org link TYPE.
+A function named `+org-link-TYPE-open' will be created, with ARGS
+as its arguments and BODY as its body.  BODY can be blank, in
+which case the user will be messaged (This is a good do-nothing
+effect for exporting link types)."
+    (declare (indent 2)
+             (doc-string 3)
+             (debug (sexp sexp def-body)))
+    (let ((fn (intern (format "+org-link-%s-open" type)))
+          (body (or body `((message ,(format "%S: %%S" type)
+                                    ,(car args)))))
+          (type-string (format "%S" type)))
+      `(prog1
+           (defun ,fn ,args ,@body)
+         (org-link-set-parameters ,type-string :follow #',fn))))
+  :config
+  (+org-link-define-type sms (number _))
+  (+org-link-define-type tel (number _)))
+
+(use-package ox                         ; org-export
+  :after org
+  :config
+  (require 'ox-md)
+  (setopt org-export-coding-system 'utf-8-unix
+          org-export-headline-levels 8
+          org-export-with-drawers nil
+          org-export-with-section-numbers nil
+          org-export-with-smart-quotes t
+          org-export-with-sub-superscripts t
+          org-export-with-toc nil))
+
+(use-package org-word-count
+  :load-path "~/src/emacs/org-word-count/"
+  :hook org-mode-hook)
+
+(provide 'acdw-org)
+;;; acdw-org.el ends here