summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-mail.el12
-rw-r--r--lisp/acdw-org.el69
-rw-r--r--lisp/acdw.el129
3 files changed, 199 insertions, 11 deletions
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index d0ee28e..9545808 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el
@@ -3,6 +3,7 @@
3;;; Code: 3;;; Code:
4 4
5(require 'cl-lib) 5(require 'cl-lib)
6(require 'message)
6 7
7;;; Variables 8;;; Variables
8 9
@@ -56,6 +57,7 @@ Useful in `message-send-hook'."
56 "Concatenate `notmuch' QUERIES with AND." 57 "Concatenate `notmuch' QUERIES with AND."
57 (mapconcat #'identity queries " AND ")) 58 (mapconcat #'identity queries " AND "))
58 59
60;;;###autoload
59(defun +notmuch-goto (&optional prefix) 61(defun +notmuch-goto (&optional prefix)
60 "Perform a saved `notmuch' search. 62 "Perform a saved `notmuch' search.
61Without a PREFIX argument, perform the first search in 63Without a PREFIX argument, perform the first search in
@@ -91,7 +93,7 @@ reversing the tag changes."
91 (when (eq start end) 93 (when (eq start end)
92 (notmuch-search-next-thread))) 94 (notmuch-search-next-thread)))
93 95
94(defun +notmuch-tree-mark-spam (&optional ham) 96(defun +notmuch-tree-mark-spam (&optional ham _ _)
95 "Mark the current message as spam. 97 "Mark the current message as spam.
96That is, add the tags in `+notmuch-spam-tags' to the message. 98That is, add the tags in `+notmuch-spam-tags' to the message.
97With an optional HAM argument (interactively, 99With an optional HAM argument (interactively,
@@ -152,6 +154,7 @@ the saved search as well."
152 :preface (defdir notmuch/ (sync/ "emacs/notmuch/") 154 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
153 "Notmuch configuration directory." 155 "Notmuch configuration directory."
154 :makedir) 156 :makedir)
157 :bind (("C-c m" . notmuch-mua-new-mail))
155 :config 158 :config
156 ;; Options 159 ;; Options
157 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) 160 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
@@ -172,8 +175,6 @@ the saved search as well."
172 message-envelope-from 'header 175 message-envelope-from 'header
173 notmuch-saved-searches nil) 176 notmuch-saved-searches nil)
174 ;; Key bindings 177 ;; 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 "!" #'+notmuch-search-mark-spam)
178 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) 179 (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-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
@@ -197,7 +198,7 @@ the saved search as well."
197 "tag:draft") 198 "tag:draft")
198 (+notmuch-define-saved-search "all mail" "a" 'tree "*") 199 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
199 ;; Hooks and advice 200 ;; Hooks and advice
200 (add-hook 'message-send-hook #'+message-send-dispatch-rules) 201 (add-hook 'message-send-hook #'+message-send-set-variables)
201 (add-hook 'message-setup-hook #'+message-signature-setup) 202 (add-hook 'message-setup-hook #'+message-signature-setup)
202 (autoload 'visual-fill-column-mode "visual-fill-column" nil t) 203 (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-message-mode-hook #'visual-fill-column-mode)
@@ -214,13 +215,14 @@ This version doesn't add any initial-input."
214 "Make `notmuch-mua-new-reply' list-aware." 215 "Make `notmuch-mua-new-reply' list-aware."
215 (let ((ml (notmuch-show-get-header :List-Post))) 216 (let ((ml (notmuch-show-get-header :List-Post)))
216 (apply orig r) 217 (apply orig r)
218 (require 'message)
217 (when ml 219 (when ml
218 (with-buffer-modified-unmodified 220 (with-buffer-modified-unmodified
219 (message-remove-header "To") 221 (message-remove-header "To")
220 (message-add-header 222 (message-add-header
221 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" 223 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
222 ml))) 224 ml)))
223 (messgage-goto-body))))) 225 (message-goto-body)))))
224 226
225 (define-advice notmuch-tag (:filter-args (args) trim) 227 (define-advice notmuch-tag (:filter-args (args) trim)
226 "Trim whitespace from ends of tags." 228 "Trim whitespace from ends of tags."
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 8a63d04..5255a50 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -222,6 +222,25 @@ If LIST is non-nil, return the result as a list instead of a string."
222 222
223(use-package org 223(use-package org
224 :defer t 224 :defer t
225 :custom-face
226 (org-level-1 ((t :inherit fixed-pitch
227 :weight bold
228 :height 1.2)))
229 (org-level-2 ((t :inherit fixed-pitch
230 :weight bold
231 :height 1.1)))
232 (org-level-3 ((t :inherit fixed-pitch
233 :weight bold
234 :height 1.0)))
235 (org-level-4 ((t :inherit org-level-3)))
236 (org-level-5 ((t :inherit org-level-4)))
237 (org-level-6 ((t :inherit org-level-5)))
238 (org-level-7 ((t :inherit org-level-6)))
239 (org-level-8 ((t :inherit org-level-7)))
240 (org-drawer ((t :inherit fixed-pitch)))
241 (org-property-value ((t :inherit fixed-pitch)))
242 (org-special-keyword ((t :inherit fixed-pitch)))
243 (org-indent ((t :inherit fixed-pitch)))
225 :config 244 :config
226 ;; Options 245 ;; Options
227 (setopt org-adapt-indentation nil 246 (setopt org-adapt-indentation nil
@@ -273,7 +292,7 @@ If LIST is non-nil, return the result as a list instead of a string."
273 org-src-window-setup 'current-window 292 org-src-window-setup 'current-window
274 org-startup-truncated nil 293 org-startup-truncated nil
275 org-startup-with-inline-images t 294 org-startup-with-inline-images t
276 org-tags-column 0 295 org-tags-column 0 ;(- 0 fill-column -3)
277 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" 296 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
278 "|" "DONE(d!)" "ASSIGNED(a@/!)") 297 "|" "DONE(d!)" "ASSIGNED(a@/!)")
279 (sequence "|" "CANCELED(k@)") 298 (sequence "|" "CANCELED(k@)")
@@ -292,9 +311,25 @@ If LIST is non-nil, return the result as a list instead of a string."
292 (add-hook 'org-mode-hook #'turn-off-auto-fill) 311 (add-hook 'org-mode-hook #'turn-off-auto-fill)
293 (add-hook 'org-mode-hook #'org-indent-mode) 312 (add-hook 'org-mode-hook #'org-indent-mode)
294 (add-hook 'org-mode-hook #'abbrev-mode) 313 (add-hook 'org-mode-hook #'abbrev-mode)
295 (add-hook 'org-mode-hook (defun before-save@org-mode () 314 (add-hook 'org-mode-hook
296 (org-align-tags 'all) 315 (defun before-save@org-mode ()
297 (+org-hide-drawers-except-point)))) 316 (add-hook 'before-save-hook
317 (defun before-save@org-mode@before-save ()
318 (org-align-tags 'all)
319 (+org-hide-drawers-except-point))
320 nil :local)))
321 ;; Extra font-lock keywords
322 (font-lock-add-keywords
323 'org-mode
324 `(;; List markers => org-indent
325 (,(concat
326 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
327 "\\(?:[ ]+\\|$\\)\\)"
328 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
329 "[ ]*\\)?"
330 "\\(?:\\(\\[[ X-]\\]\\)"
331 "\\(?:[ ]+\\|$\\)\\)?")
332 0 'org-indent))))
298 333
299(use-package org-agenda 334(use-package org-agenda
300 :bind (("C-c a" . org-agenda)) 335 :bind (("C-c a" . org-agenda))
@@ -316,7 +351,10 @@ If LIST is non-nil, return the result as a list instead of a string."
316 org-deadline-warning-days 0 351 org-deadline-warning-days 0
317 org-agenda-show-future-repeats 'next 352 org-agenda-show-future-repeats 'next
318 org-agenda-window-setup 'current-window 353 org-agenda-window-setup 'current-window
319 org-agenda-skip-file-regexp "sync-conflict") 354 org-agenda-skip-file-regexp "sync-conflict"
355 org-agenda-inhibit-startup t
356 org-agenda-sticky t
357 org-agenda-follow-indirect t)
320 ;; Hooks and advice 358 ;; Hooks and advice
321 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) 359 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
322 (add-hook 'org-agenda-mode-hook #'hl-line-mode) 360 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
@@ -329,7 +367,13 @@ If LIST is non-nil, return the result as a list instead of a string."
329 (string-match-p org-agenda-skip-file-regexp 367 (string-match-p org-agenda-skip-file-regexp
330 file)) 368 file))
331 files))) 369 files)))
332 files)) 370 files)
371 (define-advice org-agenda (:around (orig &rest r) inhibit-hooks)
372 (let ((org-mode-hook nil))
373 (apply orig r)))
374 (define-advice org-agenda-switch-to (:after (&rest _) do-hooks)
375 (run-hooks 'org-mode-hook))
376 (progress@around org-agenda-list "Building agenda"))
333 377
334(use-package org-capture 378(use-package org-capture
335 :bind (("C-c c" . org-capture))) 379 :bind (("C-c c" . org-capture)))
@@ -373,5 +417,18 @@ effect for exporting link types)."
373 :load-path "~/src/emacs/org-word-count/" 417 :load-path "~/src/emacs/org-word-count/"
374 :hook org-mode-hook) 418 :hook org-mode-hook)
375 419
420(use-package org-modern
421 :ensure t
422 :custom-face
423 (org-modern-label ((t :inherit fixed-pitch
424 :height 1.0)))
425 :config
426 (setopt org-modern-star nil
427 org-hide-leading-stars nil
428 org-modern-hide-stars nil
429 org-tags-column 0
430 org-modern-keyword nil)
431 (global-org-modern-mode))
432
376(provide 'acdw-org) 433(provide 'acdw-org)
377;;; acdw-org.el ends here 434;;; acdw-org.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 6729759..a05295c 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -85,5 +85,134 @@ If `:separator' is the first of STRINGS, the next string will be
85used as a separator." 85used as a separator."
86 (++concat #'format strings)) 86 (++concat #'format strings))
87 87
88(defun mapc-buffers (func &optional predicate)
89 "Map FUNC over buffers matching PREDICATE.
90Both FUNC and PREDICATE will be executed with no arguments and in
91the context of each buffer.
92
93If PREDICATE is nil or not given, map FUNC over all buffers."
94 (cl-loop for buf being the buffers
95 do (with-current-buffer buf
96 (when (and predicate
97 (funcall predicate))
98 (funcall func)))))
99
100(defun mapc-buffers-modes (func &rest modes)
101 "Map FUNC over buffers derived from MODES.
102FUNC will be executed with no arguments and in the context of
103each buffer."
104 (mapc-buffers func
105 (lambda ()
106 (apply #'derived-mode-p modes))))
107
108(defun find-font (&rest fonts)
109 "Return the first font of FONTS that is installed."
110 (cl-loop with ffl = (font-family-list)
111 for font in fonts
112 if (member font ffl)
113 return font))
114
115(defmacro progress@around (fn message &optional name)
116 "Define :around advice for functions adding a simple progress reporter."
117 (let ((orig (gensym))
118 (args (gensym))
119 (prog (gensym)))
120 `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress))
121 ,(format "Add a simple progress reporter to %s." fn)
122 (let ((,prog (make-progress-reporter
123 ,(format "%s..." (string-remove-suffix "..." message)))))
124 (apply ,orig ,args)
125 (progress-reporter-done ,prog)))))
126
127
128;;; Comment-or-uncomment-sexp
129;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
130
131(defun +lisp-uncomment-sexp (&optional n)
132 "Uncomment N sexps around point."
133 (interactive "P")
134 (let* ((initial-point (point-marker))
135 (inhibit-field-text-motion t)
136 (p)
137 (end (save-excursion
138 (when (elt (syntax-ppss) 4)
139 (re-search-backward comment-start-skip
140 (line-beginning-position)
141 t))
142 (setq p (point-marker))
143 (comment-forward (point-max))
144 (point-marker)))
145 (beg (save-excursion
146 (forward-line 0)
147 (while (and (not (bobp))
148 (= end (save-excursion
149 (comment-forward (point-max))
150 (point))))
151 (forward-line -1))
152 (goto-char (line-end-position))
153 (re-search-backward comment-start-skip
154 (line-beginning-position)
155 t)
156 (ignore-errors
157 (while (looking-at-p comment-start-skip)
158 (forward-char -1)))
159 (point-marker))))
160 (unless (= beg end)
161 (uncomment-region beg end)
162 (goto-char p)
163 ;; Indentify the "top-level" sexp inside the comment.
164 (while (and (ignore-errors (backward-up-list) t)
165 (>= (point) beg))
166 (skip-chars-backward (rx (syntax expression-prefix)))
167 (setq p (point-marker)))
168 ;; Re-comment everything before it.
169 (ignore-errors
170 (comment-region beg p))
171 ;; And everything after it.
172 (goto-char p)
173 (forward-sexp (or n 1))
174 (skip-chars-forward "\r\n[:blank:]")
175 (if (< (point) end)
176 (ignore-errors
177 (comment-region (point) end))
178 ;; If this is a closing delimiter, pull it up.
179 (goto-char end)
180 (skip-chars-forward "\r\n[:blank:]")
181 (when (eq 5 (car (syntax-after (point))))
182 (delete-indentation))))
183 ;; Without a prefix, it's more useful to leave point where
184 ;; it was.
185 (unless n
186 (goto-char initial-point))))
187
188(defun +lisp-comment-sexp--raw ()
189 "Comment the sexp at point or ahead of point."
190 (pcase (or (bounds-of-thing-at-point 'sexp)
191 (save-excursion
192 (skip-chars-forward "\r\n[:blank:]")
193 (bounds-of-thing-at-point 'sexp)))
194 (`(,l . ,r)
195 (goto-char r)
196 (skip-chars-forward "\r\n[:blank:]")
197 (save-excursion
198 (comment-region l r))
199 (skip-chars-forward "\r\n[:blank:]"))))
200
201(defun +lisp-comment-or-uncomment-sexp (&optional n)
202 "Comment the sexp at point and move past it.
203If already inside (or before) a comment, uncomment instead.
204With a prefix argument N, (un)comment that many sexps."
205 (interactive "P")
206 (if (or (elt (syntax-ppss) 4)
207 (< (save-excursion
208 (skip-chars-forward "\r\n[:blank:]")
209 (point))
210 (save-excursion
211 (comment-forward 1)
212 (point))))
213 (+lisp-uncomment-sexp n)
214 (dotimes (_ (or n 1))
215 (+lisp-comment-sexp--raw))))
216
88(provide 'acdw) 217(provide 'acdw)
89;;; acdw.el ends here 218;;; acdw.el ends here