summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-01-12 16:39:38 -0600
committerCase Duckworth2023-01-12 16:39:38 -0600
commit22b0a6b56ffe8c423047ee25440dce79a990610c (patch)
treee6aa91334f4d9f74009fcb83f04165fe04468afe
parentMeh (diff)
downloademacs-22b0a6b56ffe8c423047ee25440dce79a990610c.tar.gz
emacs-22b0a6b56ffe8c423047ee25440dce79a990610c.zip
Make it work for ... $work
-rw-r--r--init.el91
-rw-r--r--lisp/+org-capture.el49
-rw-r--r--lisp/acdw-mail.el233
-rw-r--r--lisp/acdw-org.el377
4 files changed, 749 insertions, 1 deletions
diff --git a/init.el b/init.el index 5ce5cdb..da4b537 100644 --- a/init.el +++ b/init.el
@@ -135,6 +135,26 @@
135 :config 135 :config
136 (fringe-mode '(nil . 0))) 136 (fringe-mode '(nil . 0)))
137 137
138(use-package flyspell
139 :hook org-mode-hook)
140
141(use-package browse-url
142 :preface
143 (defcustom +browse-url-other-safe-browser-functions nil
144 "Other safe browser functions."
145 :type '(repeat function))
146 (defun +browse-url-browser-function-safe-p (f)
147 "Return t if F is a safe browser function."
148 (memq f (append +browse-url-other-safe-browser-functions
149 (mapcar (lambda (i)
150 (plist-get (cdr i) :value))
151 (seq-filter (lambda (i)
152 (eq (car i) 'function-item))
153 (cdr (get 'browse-url-browser-function
154 'custom-type)))))))
155 :config
156 (put 'browse-url-browser-function 'safe-local-variable
157 '+browse-url-browser-function-safe-p))
138 158
139(use-package dired 159(use-package dired
140 :bind (("C-x C-j" . dired-jump) 160 :bind (("C-x C-j" . dired-jump)
@@ -192,7 +212,30 @@
192 212
193(use-package titlecase 213(use-package titlecase
194 :load-path "~/src/emacs/titlecase.el/" 214 :load-path "~/src/emacs/titlecase.el/"
195 :after scule 215 :preface
216 (defun +titlecase-sentence-style-dwim (&optional arg)
217 "Titlecase a sentence.
218With prefix ARG, toggle the value of
219`titlecase-downcase-sentences' before sentence-casing."
220 (interactive "P")
221 (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences)
222 titlecase-downcase-sentences)))
223 (titlecase-dwim 'sentence)))
224 (defun +titlecase-org-headings ()
225 (interactive)
226 (require 'org)
227 (save-excursion
228 (goto-char (point-min))
229 ;; See also `org-map-tree'. I'm not using that function because I want to
230 ;; skip the first headline. A better solution would be to patch
231 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
232 (let ((level (funcall outline-level))
233 (org-special-ctrl-a/e t))
234 (while (and (progn (outline-next-heading)
235 (> (funcall outline-level) level))
236 (not (eobp)))
237 (titlecase-region (progn (org-beginning-of-line) (point))
238 (progn (org-end-of-line) (point)))))))
196 :bind (:map scule-map 239 :bind (:map scule-map
197 ("M-t" . titlecase-dwim))) 240 ("M-t" . titlecase-dwim)))
198 241
@@ -583,3 +626,49 @@
583 (setopt wiki-abbrev-file (etc/ "wiki-abbrevs")) 626 (setopt wiki-abbrev-file (etc/ "wiki-abbrevs"))
584 (wiki-abbrev-insinuate)) 627 (wiki-abbrev-insinuate))
585 628
629(use-package flyspell-correct
630 :ensure t
631 :preface
632 (defun +flyspell-correct-buffer (&optional prefix)
633 "Run `flyspell-correct-wrapper' on all misspelled words in the buffer.
634With PREFIX, prompt to change the current dictionary."
635 (interactive "P")
636 (flyspell-buffer)
637 (when prefix
638 (let ((current-prefix-arg nil))
639 (call-interactively #'ispell-change-dictionary)))
640 (flyspell-correct-move (point-min) :forward :rapid))
641 :after flyspell
642 :bind (:map flyspell-mode-map
643 ("C-;" . flyspell-correct-wrapper)
644 ("<f7>" . +flyspell-correct-buffer))
645 :config
646 (setq flyspell-correct--cr-key ";")
647 (keymap-unset flyspell-mode-map "C-," t)
648 (keymap-unset flyspell-mode-map "C-." t))
649
650(use-package dired-subtree
651 :ensure t
652 :after dired
653 :bind (:map dired-mode-map
654 (("TAB" . dired-subtree-cycle)
655 ("i" . dired-subtree-toggle))))
656
657(use-package dired-hide-dotfiles
658 ;; I could maybe use a more general package for this ... see
659 ;; https://emacs.grym.io/#orgbbda609
660 :ensure t
661 :bind (:map dired-mode-map
662 ("." . dired-hide-dotfiles-mode)))
663
664
665;;; Applications
666
667(use-package acdw-mail
668 :load-path "lisp/")
669
670(use-package acdw-org
671 :load-path "lisp/")
672
673(use-package _work
674 :load-path "~/Sync/emacs/private/")
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el new file mode 100644 index 0000000..2f7bf6a --- /dev/null +++ b/lisp/+org-capture.el
@@ -0,0 +1,49 @@
1;;; +org-capture.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll
7;; take a minute. Just let the compiler know that this variable exists.
8(defvar org-capture-templates nil)
9
10;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573
11(defun +org-capture-template-define (description &rest args)
12 "Define a capture template.
13Creates a list and adds it to `org-capture-templates', if it's
14not already there. ARGS is a plist, which in addition to the
15additional options `org-capture-templates' accepts (which see),
16takes the following and puts them in the right spot: `:keys',
17`:description', `:type', `:target', and `:template'."
18 (declare (indent 1))
19 (let* ((keys (plist-get args :keys))
20 (type (plist-get args :type))
21 (target (plist-get args :target))
22 (template (plist-get args :template))
23 (template-value (append
24 (list description)
25 (when (or type target template)
26 (list (or type 'entry) target template))
27 (cl-loop for i from 0 below (length args) by 2
28 unless (member (nth i args)
29 '(:keys :description :type
30 :target :template))
31 append (list (nth i args)
32 (plist-get args (nth i
33 args)))))))
34 ;; The only way I know how to do this properly (add a value to the end of
35 ;; the list, if it exists; otherwise update it) is to do this weird if-setf
36 ;; dance.
37 (if (seq-find (lambda (el) (equal (car el) keys))
38 org-capture-templates)
39 (setf (alist-get keys org-capture-templates nil nil #'equal)
40 template-value)
41 (setf org-capture-templates
42 (append org-capture-templates
43 (list (cons keys template-value)))))
44 ;; Regardless of what we do, return the new value of
45 ;; `org-capture-templates'.
46 org-capture-templates))
47
48(provide '+org-capture)
49;;; +org-capture.el
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el new file mode 100644 index 0000000..d0ee28e --- /dev/null +++ b/lisp/acdw-mail.el
@@ -0,0 +1,233 @@
1;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Variables
8
9(defcustom +message-send-dispatch-rules nil
10 "Alist to set variables based on the current from address."
11 :group 'message
12 :type '(alist :key-type (string :tag "From address")
13 :value-type (alist :tag "Rules"
14 :key-type (symbol :tag "Variable")
15 :value-type (sexp :tag "Value"))))
16
17(defcustom +notmuch-spam-tags '("+spam")
18 "List of tag changes to apply when marking a thread as spam."
19 :group 'notmuch
20 :type '(repeat string))
21
22;;; Functions
23
24(defun +message-send-set-variables ()
25 "Set variables for `message-send' depending on the From: header.
26Useful in `message-send-hook'."
27 (let ((from (message-fetch-field "from")))
28 (cl-loop for (var . val) in (cl-loop for (address . bindings)
29 in +message-send-dispatch-rules
30 if (string-match-p address from)
31 return bindings)
32 do (set (make-local-variable var) val))))
33
34;; Thanks to Alex Schroeder!
35;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
36(defun +message-check-for-signature-change (&rest ignore)
37 "Check for a change in the To: or Cc: fields"
38 (when (and (message--in-tocc-p)
39 (not (buffer-narrowed-p)))
40 (save-excursion
41 (goto-char (point-max))
42 (let ((end (point)))
43 (when (re-search-backward message-signature-separator nil t)
44 (delete-region (1- (match-beginning 0)) end)))
45 (message-insert-signature))))
46
47(defun +message-signature-setup ()
48 (make-local-variable 'after-change-functions)
49 (push '+message-check-for-signature-change after-change-functions))
50
51(defun +notmuch-field-match-p (field regexp)
52 "Return whether message FIELD matches REGEXP."
53 (string-match-p regexp (or (message-fetch-field field) "")))
54
55(defun +notmuch-query-concat (&rest queries)
56 "Concatenate `notmuch' QUERIES with AND."
57 (mapconcat #'identity queries " AND "))
58
59(defun +notmuch-goto (&optional prefix)
60 "Perform a saved `notmuch' search.
61Without a PREFIX argument, perform the first search in
62`notmuch-saved-searches'. With a single PREFIX argument
63(\\[universal-argument]), prompt the user as to which saved
64search to perform. With two PREFIX arguments, prompt the user
65for a free-form search. With any other PREFIX argument, open
66`notmuch-hello'."
67 (interactive "P")
68 (pcase prefix
69 ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
70 ('(4) (notmuch-search
71 (plist-get (cl-find (completing-read "Saved search: "
72 (mapcar (lambda (elt)
73 (plist-get elt :name))
74 notmuch-saved-searches))
75 :key (lambda (elt) (plist-get elt :name))
76 :test #'equal)
77 :query)))
78 ('(16) (notmuch-search))
79 (_ (notmuch-hello))))
80
81(defun +notmuch-search-mark-spam (&optional ham start end)
82 "Mark the current thread or region as spam.
83That is, add the tags in `+notmuch-spam-tags' to the message.
84With an optional HAM argument (interactively,
85\\[universal-argument]), mark the message as not-spam, or ham, by
86reversing the tag changes."
87 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
88 (when +notmuch-spam-tags
89 (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham)
90 start end))
91 (when (eq start end)
92 (notmuch-search-next-thread)))
93
94(defun +notmuch-tree-mark-spam (&optional ham)
95 "Mark the current message as spam.
96That is, add the tags in `+notmuch-spam-tags' to the message.
97With an optional HAM argument (interactively,
98\\[universal-argument]), mark the message as not-spam, or ham, by
99reversing the tag changes."
100 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
101 (when +notmuch-spam-tags
102 (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham)))
103 (notmuch-tree-next-matching-message))
104
105(defun +notmuch-define-saved-search (name key search-type &rest queries)
106 "Wrapper to ease `notmuch-saved-searches' defining.
107NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
108`notmuch-saved-searches', which see. QUERIES are all concatenated together with
109AND. If QUERIES is prepended with more keyword arguments, those are added to
110the saved search as well."
111 (declare (indent 3))
112 (let (extra-keywords)
113 (while (keywordp (car queries))
114 (push (cadr queries) extra-keywords)
115 (push (car queries) extra-keywords)
116 (setf queries (cddr queries)))
117 (add-to-list 'notmuch-saved-searches
118 (append (list :name name
119 :key key
120 :search-type search-type
121 :query (apply #'+notmuch-query-concat queries))
122 (reverse extra-keywords))
123 :append
124 (lambda (a b)
125 (equal (plist-get a :name)
126 (plist-get b :name))))))
127
128;;; Packages
129
130(use-package bbdb
131 :ensure t
132 :config
133 (setopt bbdb-complete-mail-allow-cycling t
134 bbdb-file (private/ "bbdb"))
135 (add-hook 'custom-allowed-after-load-hook
136 (defun bbdb@after-custom ()
137 (require 'bbdb)
138 (require 'bbdb-message)
139 (bbdb-initialize 'message))))
140
141(use-package bbdb-vcard
142 :ensure t
143 :after bbdb)
144
145(use-package notmuch
146 :when (executable-find "notmuch")
147 :load-path "~/usr/share/emacs/site-lisp/"
148 :defer t
149 :commands (notmuch-mua-new-mail
150 notmuch-search
151 notmuch-hello)
152 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
153 "Notmuch configuration directory."
154 :makedir)
155 :config
156 ;; Options
157 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
158 notmuch-address-save-filename (notmuch/ "addresses" t)
159 notmuch-address-use-company (featurep 'company)
160 notmuch-search-oldest-first nil
161 notmuch-archive-tags '("-inbox" "-unread")
162 notmuch-draft-tags '("+draft" "-inbox" "-unread")
163 +notmuch-spam-tags '("+spam" "+Spam")
164 mail-user-agent 'notmuch-user-agent
165 message-mail-user-agent t
166 notmuch-show-indent-content nil
167 message-kill-buffer-on-exit t
168 message-auto-save-directory nil
169 send-mail-function #'sendmail-send-it
170 mail-specify-envelope-from t
171 message-sendmail-envelope-from 'header
172 message-envelope-from 'header
173 notmuch-saved-searches nil)
174 ;; Key bindings
175 (keymap-global-set "C-c m" #'nomtuch-mua-new-mail)
176 (keymap-global-set "C-c n" #'+notmuch-goto)
177 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
178 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
179 (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
180 (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam)
181 ;; Saved searches
182 (+notmuch-define-saved-search "inbox+unread" "m" 'tree
183 "tag:inbox" "tag:unread" "NOT tag:Spam")
184 (+notmuch-define-saved-search "inbox" "i" 'tree
185 "tag:inbox" "NOT tag:Spam")
186 (+notmuch-define-saved-search "lists+unread" "l" 'tree
187 "tag:/List/" "tag:unread")
188 (+notmuch-define-saved-search "lists" "L" 'tree
189 "tag:/List/")
190 (+notmuch-define-saved-search "unread" "u" 'tree
191 "tag:unread" "NOT tag:Spam")
192 (+notmuch-define-saved-search "flagged" "f" 'tree
193 "tag:flagged")
194 (+notmuch-define-saved-search "sent" "t" 'tree
195 "tag:sent")
196 (+notmuch-define-saved-search "drafts" "d" 'tree
197 "tag:draft")
198 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
199 ;; Hooks and advice
200 (add-hook 'message-send-hook #'+message-send-dispatch-rules)
201 (add-hook 'message-setup-hook #'+message-signature-setup)
202 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
203 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
204 (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
205
206 (define-advice notmuch-address-selection-function
207 (:override (prompt collection _) no-initial-input)
208 "Call `completing-read' with `notmuch-address-history'.
209This version doesn't add any initial-input."
210 (completing-read prompt collection nil nil nil 'notmuch-address-history))
211
212 (add-to-list 'notmuch-message-headers "List-Post" :append #'equal)
213 (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware)
214 "Make `notmuch-mua-new-reply' list-aware."
215 (let ((ml (notmuch-show-get-header :List-Post)))
216 (apply orig r)
217 (when ml
218 (with-buffer-modified-unmodified
219 (message-remove-header "To")
220 (message-add-header
221 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
222 ml)))
223 (messgage-goto-body)))))
224
225 (define-advice notmuch-tag (:filter-args (args) trim)
226 "Trim whitespace from ends of tags."
227 (list (car args) (mapcar #'string-trim (cadr args))))
228 ;; Load init file
229 ;; (load notmuch-init-file 'noerror)
230 )
231
232(provide 'acdw-mail)
233;;; acdw-mail.el ends here
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el new file mode 100644 index 0000000..8a63d04 --- /dev/null +++ b/lisp/acdw-org.el
@@ -0,0 +1,377 @@
1;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Variables
8
9(defcustom org-agenda-skip-file-regexp nil
10 "Files matching this regexp are removed from `org-agenda-files'."
11 :group 'org-agenda
12 :type 'regexp)
13
14;;; Functions
15
16
17;;; DWIM
18
19;; https://github.com/alphapapa/unpackaged.el,
20;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
21(defun +org-return-dwim (&optional arg)
22 "A helpful replacement for `org-return'.
23When called interactively with \\[universal-argument], call `org-return'
24itself. Other values of ARG will call `newline' with that ARG."
25 (interactive "P")
26 ;; Auto-fill if enabled
27 (when auto-fill-function
28 (dolist (func (ensure-list auto-fill-function))
29 (funcall func)))
30 (cl-letf* ((el (org-element-at-point))
31 ((symbol-function 'el-child-of)
32 (lambda (&rest types)
33 (org-element-lineage el types t))))
34 (cond ; Figure out what we're going to do
35 (arg ; Handle prefix ARG
36 (pcase arg
37 ('(4) (org-return t nil t))
38 (_ (newline arg t))))
39 ((and org-return-follows-link ; Open a link
40 (el-child-of 'link))
41 (org-open-at-point-global))
42 ((org-at-heading-p) ; Open a paragraph after a heading
43 (let ((heading-start (org-entry-beginning-position)))
44 (goto-char (org-entry-end-position))
45 (cond ((and (org-at-heading-p) ; Entry is only a heading
46 (= heading-start (org-entry-beginning-position)))
47 (end-of-line)
48 (newline 2))
49 (:else ; Entry is more than a heading
50 (forward-line -1)
51 (end-of-line)
52 (when (org-at-heading-p)
53 ;; Open a paragraph
54 (forward-line)
55 (newline)
56 (forward-line -1))
57 (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
58 (newline))
59 (forward-line -1)))))
60 ((org-at-item-checkbox-p) ; Insert a new checkbox item
61 (end-of-line)
62 (org-insert-todo-heading nil))
63 ((org-in-item-p) ; Insert a new list item
64 (let* ((context (org-element-context el))
65 (first-item-p (eq 'plain-list (car context)))
66 (itemp (eq 'item (car context)))
67 (emptyp (or
68 ;; This (regular) list item is empty
69 (eq (org-element-property :contents-begin context)
70 (org-element-property :contents-end context))
71 ;; This (definition) list item is empty
72 (looking-at " *::")))
73 (item-child-p (el-child-of 'item)))
74 (cond ((and itemp emptyp)
75 ;; This test has to be here even though it's the same as the
76 ;; :else clause, because an item that's empty will also satisfy
77 ;; the next clause.
78 (delete-region (line-beginning-position) (line-end-position))
79 (newline))
80 ((or first-item-p
81 (and itemp (not emptyp))
82 item-child-p)
83 (org-end-of-item)
84 (org-insert-item))
85 (:else
86 (delete-region (line-beginning-position) (line-end-position))
87 (newline)))))
88 ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
89 (org-inlinetask-in-task-p))
90 (org-return))
91 ((org-at-table-p) ; Insert a new table row
92 (cond ((save-excursion ; Empty row: end the table
93 (beginning-of-line)
94 (cl-loop with end = (line-end-position)
95 for cell = (org-element-table-cell-parser)
96 always (eq (org-element-property :contents-begin cell)
97 (org-element-property :contents-end cell))
98 while (re-search-forward "|" end t)))
99 (delete-region (line-beginning-position) (line-end-position))
100 (org-return))
101 (:else ; Non-empty row
102 (org-return))))
103 (:else ; Something else
104 (org-return)))))
105
106(defun +org-table-copy-down|+org-return-dwim (&optional n)
107 "Call `org-table-copy-down' or `+org-return' depending on context."
108 (interactive "P")
109 (if (org-table-check-inside-data-field 'noerror)
110 (org-table-copy-down (or n 1))
111 (+org-return-dwim n)))
112
113
114;;; Buffer view cleanup
115
116(defun +org-hide-drawers-except-point ()
117 "Hide all drawers except for the one point is in."
118 ;; Most of this bit is taken from `org-fold--hide-drawers'.
119 (let ((pt (point))
120 (begin (point-min))
121 (end (point-max)))
122 (save-excursion
123 (goto-char begin)
124 (while (and (< (point) end)
125 (re-search-forward org-drawer-regexp end t))
126 (if (org-fold-folded-p nil 'drawer)
127 (goto-char (org-fold-next-folding-state-change 'drawer nil end))
128 (let* ((drawer (org-element-at-point))
129 (type (org-element-type drawer))
130 (el-begin (org-element-property :begin drawer))
131 (el-end (org-element-property :end drawer)))
132 (when (memq type '(drawer property-drawer))
133 (org-fold-hide-drawer-toggle
134 (if (< el-begin pt el-end) 'off 'on)
135 nil drawer)
136 (goto-char el-end))))))))
137
138
139;;; Copy rich text to the keyboard
140;; Thanks to Oleh Krehel:
141;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
142;; So. Emacs can't do this itself because it doesn't support sending clipboard
143;; or selection contents as text/html. We have to use xclip instead.
144(defun org-to-html-to-clipboard (&rest org-export-args)
145 "Export current org buffer to HTML, then copy it to the clipboard.
146ORG-EXPORT-ARGS are passed to `org-export-to-file'."
147 (let ((f (make-temp-file "org-html-export")))
148 (apply #'org-export-to-file 'html f org-export-args)
149 (start-process "xclip" " *xclip*"
150 "xclip" "-verbose" "-i" f
151 "-t" "text/html" "-selection" "clipboard")
152 (message "HTML pasted to clipboard.")))
153
154(defun org-subtree-to-html-to-clipboard ()
155 "Export current subtree to HTML."
156 (interactive)
157 (org-to-html-to-clipboard nil :subtree))
158
159
160;;; Prompting
161
162(defun +org-prompt-for-property (property &optional clipboardp insert list)
163 "Prompt for PROPERTY and return a properly-formatted string.
164Pre-fill the input with clipboard contents if they match CLIPBOARDP. If
165CLIPBOARDP is nil or missing, don't pre-fill.
166
167If INSERT is non-nil, insert the property into the property
168drawer of the current org tree.
169
170If LIST is non-nil, return the result as a list instead of a string."
171 (let* ((kill (current-kill 0))
172 (value (read-string (concat property ": ")
173 (when (and clipboardp
174 (or (eq clipboardp t)
175 (funcall clipboardp kill)))
176 kill))))
177 (when insert
178 (org-set-property property value))
179 (if list
180 (list property value)
181 (format ":%s: %s" property value))))
182
183(defun +org-prompt-tags (&optional prompt global)
184 (let* ((buffer (org-capture-get :buffer))
185 (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
186 (org-last-tags-completion-table
187 (org-global-tags-completion-table
188 (if global (org-agenda-files) (list file))))
189 (org-add-colon-after-tag-completion t)
190 (ins (mapconcat
191 #'identity
192 (let ((crm-separator "[ \t]*:[ \t]*"))
193 (completing-read-multiple
194 (or prompt "Tags: ")
195 org-last-tags-completion-table nil nil nil
196 'org-tags-history))
197 ":")))
198 (when (org-string-nw-p ins)
199 (prog1 (concat
200 (unless (eq (char-before) ?:) ":")
201 ins
202 (unless (eq (char-after) ?:) ":"))
203 (when (org-at-heading-p) (org-align-tags))))))
204
205
206;;; Faces
207
208(defface org-bold '((t (:weight bold)))
209 "Bold face in `org-mode' documents.")
210
211(defface org-italic '((t (:slant italic)))
212 "Italic face in `org-mode' documents.")
213
214(defface org-underline '((t (:underline t)))
215 "Underline face in `org-mode' documents.")
216
217(defface org-strikethrough '((t (:strike-through t)))
218 "Strike-through face for `org-mode' documents.")
219
220
221;;; Packages
222
223(use-package org
224 :defer t
225 :config
226 ;; Options
227 (setopt org-adapt-indentation nil
228 org-auto-align-tags t
229 org-archive-mark-done t
230 org-fold-catch-invisible-edits 'show-and-error
231 org-clock-clocked-in-display 'mode-line
232 org-clock-string-limit 7 ; just the clock bit
233 org-clock-persist nil
234 org-confirm-babel-evaluate nil
235 org-cycle-separator-lines 0
236 org-deadline-warning-days 0
237 org-directory (sync/ "org/" t)
238 org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…")
239 org-emphasis-alist '(("*" org-bold)
240 ("/" org-italic)
241 ("_" org-underline)
242 ("=" org-verbatim)
243 ("~" org-code)
244 ("+" org-strikethrough))
245 org-fontify-done-headline t
246 org-fontify-quote-and-verse-blocks t
247 org-fontify-whole-heading-line t
248 org-hide-emphasis-markers t
249 org-html-coding-system 'utf-8-unix
250 org-image-actual-width (list (* (window-font-width)
251 (- fill-column 8)))
252 org-imenu-depth 3
253 org-indent-indentation-per-level 0
254 org-indent-mode-turns-on-hiding-stars nil
255 org-insert-heading-respect-content t
256 org-list-demote-modify-bullet '(("-" . "+")
257 ("+" . "-"))
258 org-log-done 'time
259 org-log-into-drawer t
260 org-num-skip-commented t
261 org-num-skip-unnumbered t
262 org-num-skip-footnotes t
263 org-outline-path-complete-in-steps nil
264 org-pretty-entities t
265 org-pretty-entities-include-sub-superscripts nil
266 org-refile-targets '((nil . (:maxlevel . 2))
267 (org-agenda-files . (:maxlevel . 1)))
268 org-refile-use-outline-path 'file
269 org-special-ctrl-a/e t
270 org-special-ctrl-k t
271 org-src-fontify-natively t
272 org-src-tab-acts-natively t
273 org-src-window-setup 'current-window
274 org-startup-truncated nil
275 org-startup-with-inline-images t
276 org-tags-column 0
277 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
278 "|" "DONE(d!)" "ASSIGNED(a@/!)")
279 (sequence "|" "CANCELED(k@)")
280 (sequence "MEETING(m)"))
281 org-use-fast-todo-selection 'auto
282 org-use-speed-commands t)
283 ;; Keys
284 (keymap-set org-mode-map "C-M-k" #'kill-paragraph)
285 (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs)
286 (keymap-set org-mode-map "RET" #'+org-return-dwim)
287 (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim)
288 ;; Hooks
289 (add-hook 'org-mode-hook #'variable-pitch-mode)
290 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
291 (add-hook 'org-mode-hook #'visual-fill-column-mode)
292 (add-hook 'org-mode-hook #'turn-off-auto-fill)
293 (add-hook 'org-mode-hook #'org-indent-mode)
294 (add-hook 'org-mode-hook #'abbrev-mode)
295 (add-hook 'org-mode-hook (defun before-save@org-mode ()
296 (org-align-tags 'all)
297 (+org-hide-drawers-except-point))))
298
299(use-package org-agenda
300 :bind (("C-c a" . org-agenda))
301 :config
302 (setopt org-agenda-skip-deadline-if-done t
303 org-agenda-skip-scheduled-if-done t
304 org-agenda-span 10
305 org-agenda-block-separator ?─
306 org-agenda-time-grid
307 '((daily today require-timed)
308 (800 1000 1200 1400 1600 1800 2000)
309 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
310 org-agenda-current-time-string
311 "← now ─────────────────────────────────────────────────"
312 org-agenda-include-diary nil ; I use the org-diary features
313 org-agenda-todo-ignore-deadlines 'near
314 org-agenda-todo-ignore-scheduled 'future
315 org-agenda-include-deadlines t
316 org-deadline-warning-days 0
317 org-agenda-show-future-repeats 'next
318 org-agenda-window-setup 'current-window
319 org-agenda-skip-file-regexp "sync-conflict")
320 ;; Hooks and advice
321 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
322 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
323 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
324 (define-advice org-agenda-files (:filter-return (files) skip-regexp)
325 "Filter some files from `org-agenda'."
326 (when org-agenda-skip-file-regexp
327 (setq files
328 (cl-remove-if (lambda (file)
329 (string-match-p org-agenda-skip-file-regexp
330 file))
331 files)))
332 files))
333
334(use-package org-capture
335 :bind (("C-c c" . org-capture)))
336
337(use-package ol ; org-link
338 :after org
339 :preface
340 (defmacro +org-link-define-type (type args &rest body)
341 "Define an org link TYPE.
342A function named `+org-link-TYPE-open' will be created, with ARGS
343as its arguments and BODY as its body. BODY can be blank, in
344which case the user will be messaged (This is a good do-nothing
345effect for exporting link types)."
346 (declare (indent 2)
347 (doc-string 3)
348 (debug (sexp sexp def-body)))
349 (let ((fn (intern (format "+org-link-%s-open" type)))
350 (body (or body `((message ,(format "%S: %%S" type)
351 ,(car args)))))
352 (type-string (format "%S" type)))
353 `(prog1
354 (defun ,fn ,args ,@body)
355 (org-link-set-parameters ,type-string :follow #',fn))))
356 :config
357 (+org-link-define-type sms (number _))
358 (+org-link-define-type tel (number _)))
359
360(use-package ox ; org-export
361 :after org
362 :config
363 (require 'ox-md)
364 (setopt org-export-coding-system 'utf-8-unix
365 org-export-headline-levels 8
366 org-export-with-drawers nil
367 org-export-with-section-numbers nil
368 org-export-with-smart-quotes t
369 org-export-with-sub-superscripts t
370 org-export-with-toc nil))
371
372(use-package org-word-count
373 :load-path "~/src/emacs/org-word-count/"
374 :hook org-mode-hook)
375
376(provide 'acdw-org)
377;;; acdw-org.el ends here