diff options
author | Case Duckworth | 2023-01-12 16:39:38 -0600 |
---|---|---|
committer | Case Duckworth | 2023-01-12 16:39:38 -0600 |
commit | 22b0a6b56ffe8c423047ee25440dce79a990610c (patch) | |
tree | e6aa91334f4d9f74009fcb83f04165fe04468afe | |
parent | Meh (diff) | |
download | emacs-22b0a6b56ffe8c423047ee25440dce79a990610c.tar.gz emacs-22b0a6b56ffe8c423047ee25440dce79a990610c.zip |
Make it work for ... $work
-rw-r--r-- | init.el | 91 | ||||
-rw-r--r-- | lisp/+org-capture.el | 49 | ||||
-rw-r--r-- | lisp/acdw-mail.el | 233 | ||||
-rw-r--r-- | lisp/acdw-org.el | 377 |
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. | ||
218 | With 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. | ||
634 | With 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. | ||
13 | Creates a list and adds it to `org-capture-templates', if it's | ||
14 | not already there. ARGS is a plist, which in addition to the | ||
15 | additional options `org-capture-templates' accepts (which see), | ||
16 | takes 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. | ||
26 | Useful 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. | ||
61 | Without 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 | ||
64 | search to perform. With two PREFIX arguments, prompt the user | ||
65 | for 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. | ||
83 | That is, add the tags in `+notmuch-spam-tags' to the message. | ||
84 | With an optional HAM argument (interactively, | ||
85 | \\[universal-argument]), mark the message as not-spam, or ham, by | ||
86 | reversing 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. | ||
96 | That is, add the tags in `+notmuch-spam-tags' to the message. | ||
97 | With an optional HAM argument (interactively, | ||
98 | \\[universal-argument]), mark the message as not-spam, or ham, by | ||
99 | reversing 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. | ||
107 | NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in | ||
108 | `notmuch-saved-searches', which see. QUERIES are all concatenated together with | ||
109 | AND. If QUERIES is prepended with more keyword arguments, those are added to | ||
110 | the 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'. | ||
209 | This 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'. | ||
23 | When called interactively with \\[universal-argument], call `org-return' | ||
24 | itself. 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. | ||
146 | ORG-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. | ||
164 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
165 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
166 | |||
167 | If INSERT is non-nil, insert the property into the property | ||
168 | drawer of the current org tree. | ||
169 | |||
170 | If 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. | ||
342 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
343 | as its arguments and BODY as its body. BODY can be blank, in | ||
344 | which case the user will be messaged (This is a good do-nothing | ||
345 | effect 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 | ||