From b89f452564387368b6f7f6fc4ded8ce65c27146d Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Fri, 13 Jan 2023 22:52:30 -0600
Subject: Fleoo
---
lisp/acdw-mail.el | 12 ++---
lisp/acdw-org.el | 69 ++++++++++++++++++++++++++---
lisp/acdw.el | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 199 insertions(+), 11 deletions(-)
(limited to 'lisp')
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 @@
;;; Code:
(require 'cl-lib)
+(require 'message)
;;; Variables
@@ -56,6 +57,7 @@ Useful in `message-send-hook'."
"Concatenate `notmuch' QUERIES with AND."
(mapconcat #'identity queries " AND "))
+;;;###autoload
(defun +notmuch-goto (&optional prefix)
"Perform a saved `notmuch' search.
Without a PREFIX argument, perform the first search in
@@ -91,7 +93,7 @@ reversing the tag changes."
(when (eq start end)
(notmuch-search-next-thread)))
-(defun +notmuch-tree-mark-spam (&optional ham)
+(defun +notmuch-tree-mark-spam (&optional ham _ _)
"Mark the current message as spam.
That is, add the tags in `+notmuch-spam-tags' to the message.
With an optional HAM argument (interactively,
@@ -152,6 +154,7 @@ the saved search as well."
:preface (defdir notmuch/ (sync/ "emacs/notmuch/")
"Notmuch configuration directory."
:makedir)
+ :bind (("C-c m" . notmuch-mua-new-mail))
:config
;; Options
(setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
@@ -172,8 +175,6 @@ the saved search as well."
message-envelope-from 'header
notmuch-saved-searches nil)
;; Key bindings
- (keymap-global-set "C-c m" #'nomtuch-mua-new-mail)
- (keymap-global-set "C-c n" #'+notmuch-goto)
(keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
(keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
(keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
@@ -197,7 +198,7 @@ the saved search as well."
"tag:draft")
(+notmuch-define-saved-search "all mail" "a" 'tree "*")
;; Hooks and advice
- (add-hook 'message-send-hook #'+message-send-dispatch-rules)
+ (add-hook 'message-send-hook #'+message-send-set-variables)
(add-hook 'message-setup-hook #'+message-signature-setup)
(autoload 'visual-fill-column-mode "visual-fill-column" nil t)
(add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
@@ -214,13 +215,14 @@ This version doesn't add any initial-input."
"Make `notmuch-mua-new-reply' list-aware."
(let ((ml (notmuch-show-get-header :List-Post)))
(apply orig r)
+ (require 'message)
(when ml
(with-buffer-modified-unmodified
(message-remove-header "To")
(message-add-header
(format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
ml)))
- (messgage-goto-body)))))
+ (message-goto-body)))))
(define-advice notmuch-tag (:filter-args (args) trim)
"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."
(use-package org
:defer t
+ :custom-face
+ (org-level-1 ((t :inherit fixed-pitch
+ :weight bold
+ :height 1.2)))
+ (org-level-2 ((t :inherit fixed-pitch
+ :weight bold
+ :height 1.1)))
+ (org-level-3 ((t :inherit fixed-pitch
+ :weight bold
+ :height 1.0)))
+ (org-level-4 ((t :inherit org-level-3)))
+ (org-level-5 ((t :inherit org-level-4)))
+ (org-level-6 ((t :inherit org-level-5)))
+ (org-level-7 ((t :inherit org-level-6)))
+ (org-level-8 ((t :inherit org-level-7)))
+ (org-drawer ((t :inherit fixed-pitch)))
+ (org-property-value ((t :inherit fixed-pitch)))
+ (org-special-keyword ((t :inherit fixed-pitch)))
+ (org-indent ((t :inherit fixed-pitch)))
:config
;; Options
(setopt org-adapt-indentation nil
@@ -273,7 +292,7 @@ If LIST is non-nil, return the result as a list instead of a string."
org-src-window-setup 'current-window
org-startup-truncated nil
org-startup-with-inline-images t
- org-tags-column 0
+ org-tags-column 0 ;(- 0 fill-column -3)
org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
"|" "DONE(d!)" "ASSIGNED(a@/!)")
(sequence "|" "CANCELED(k@)")
@@ -292,9 +311,25 @@ If LIST is non-nil, return the result as a list instead of a string."
(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))))
+ (add-hook 'org-mode-hook
+ (defun before-save@org-mode ()
+ (add-hook 'before-save-hook
+ (defun before-save@org-mode@before-save ()
+ (org-align-tags 'all)
+ (+org-hide-drawers-except-point))
+ nil :local)))
+ ;; Extra font-lock keywords
+ (font-lock-add-keywords
+ 'org-mode
+ `(;; List markers => org-indent
+ (,(concat
+ "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
+ "\\(?:[ ]+\\|$\\)\\)"
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
+ "[ ]*\\)?"
+ "\\(?:\\(\\[[ X-]\\]\\)"
+ "\\(?:[ ]+\\|$\\)\\)?")
+ 0 'org-indent))))
(use-package org-agenda
: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."
org-deadline-warning-days 0
org-agenda-show-future-repeats 'next
org-agenda-window-setup 'current-window
- org-agenda-skip-file-regexp "sync-conflict")
+ org-agenda-skip-file-regexp "sync-conflict"
+ org-agenda-inhibit-startup t
+ org-agenda-sticky t
+ org-agenda-follow-indirect t)
;; Hooks and advice
(add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
(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."
(string-match-p org-agenda-skip-file-regexp
file))
files)))
- files))
+ files)
+ (define-advice org-agenda (:around (orig &rest r) inhibit-hooks)
+ (let ((org-mode-hook nil))
+ (apply orig r)))
+ (define-advice org-agenda-switch-to (:after (&rest _) do-hooks)
+ (run-hooks 'org-mode-hook))
+ (progress@around org-agenda-list "Building agenda"))
(use-package org-capture
:bind (("C-c c" . org-capture)))
@@ -373,5 +417,18 @@ effect for exporting link types)."
:load-path "~/src/emacs/org-word-count/"
:hook org-mode-hook)
+(use-package org-modern
+ :ensure t
+ :custom-face
+ (org-modern-label ((t :inherit fixed-pitch
+ :height 1.0)))
+ :config
+ (setopt org-modern-star nil
+ org-hide-leading-stars nil
+ org-modern-hide-stars nil
+ org-tags-column 0
+ org-modern-keyword nil)
+ (global-org-modern-mode))
+
(provide 'acdw-org)
;;; 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
used as a separator."
(++concat #'format strings))
+(defun mapc-buffers (func &optional predicate)
+ "Map FUNC over buffers matching PREDICATE.
+Both FUNC and PREDICATE will be executed with no arguments and in
+the context of each buffer.
+
+If PREDICATE is nil or not given, map FUNC over all buffers."
+ (cl-loop for buf being the buffers
+ do (with-current-buffer buf
+ (when (and predicate
+ (funcall predicate))
+ (funcall func)))))
+
+(defun mapc-buffers-modes (func &rest modes)
+ "Map FUNC over buffers derived from MODES.
+FUNC will be executed with no arguments and in the context of
+each buffer."
+ (mapc-buffers func
+ (lambda ()
+ (apply #'derived-mode-p modes))))
+
+(defun find-font (&rest fonts)
+ "Return the first font of FONTS that is installed."
+ (cl-loop with ffl = (font-family-list)
+ for font in fonts
+ if (member font ffl)
+ return font))
+
+(defmacro progress@around (fn message &optional name)
+ "Define :around advice for functions adding a simple progress reporter."
+ (let ((orig (gensym))
+ (args (gensym))
+ (prog (gensym)))
+ `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress))
+ ,(format "Add a simple progress reporter to %s." fn)
+ (let ((,prog (make-progress-reporter
+ ,(format "%s..." (string-remove-suffix "..." message)))))
+ (apply ,orig ,args)
+ (progress-reporter-done ,prog)))))
+
+
+;;; Comment-or-uncomment-sexp
+;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
+
+(defun +lisp-uncomment-sexp (&optional n)
+ "Uncomment N sexps around point."
+ (interactive "P")
+ (let* ((initial-point (point-marker))
+ (inhibit-field-text-motion t)
+ (p)
+ (end (save-excursion
+ (when (elt (syntax-ppss) 4)
+ (re-search-backward comment-start-skip
+ (line-beginning-position)
+ t))
+ (setq p (point-marker))
+ (comment-forward (point-max))
+ (point-marker)))
+ (beg (save-excursion
+ (forward-line 0)
+ (while (and (not (bobp))
+ (= end (save-excursion
+ (comment-forward (point-max))
+ (point))))
+ (forward-line -1))
+ (goto-char (line-end-position))
+ (re-search-backward comment-start-skip
+ (line-beginning-position)
+ t)
+ (ignore-errors
+ (while (looking-at-p comment-start-skip)
+ (forward-char -1)))
+ (point-marker))))
+ (unless (= beg end)
+ (uncomment-region beg end)
+ (goto-char p)
+ ;; Indentify the "top-level" sexp inside the comment.
+ (while (and (ignore-errors (backward-up-list) t)
+ (>= (point) beg))
+ (skip-chars-backward (rx (syntax expression-prefix)))
+ (setq p (point-marker)))
+ ;; Re-comment everything before it.
+ (ignore-errors
+ (comment-region beg p))
+ ;; And everything after it.
+ (goto-char p)
+ (forward-sexp (or n 1))
+ (skip-chars-forward "\r\n[:blank:]")
+ (if (< (point) end)
+ (ignore-errors
+ (comment-region (point) end))
+ ;; If this is a closing delimiter, pull it up.
+ (goto-char end)
+ (skip-chars-forward "\r\n[:blank:]")
+ (when (eq 5 (car (syntax-after (point))))
+ (delete-indentation))))
+ ;; Without a prefix, it's more useful to leave point where
+ ;; it was.
+ (unless n
+ (goto-char initial-point))))
+
+(defun +lisp-comment-sexp--raw ()
+ "Comment the sexp at point or ahead of point."
+ (pcase (or (bounds-of-thing-at-point 'sexp)
+ (save-excursion
+ (skip-chars-forward "\r\n[:blank:]")
+ (bounds-of-thing-at-point 'sexp)))
+ (`(,l . ,r)
+ (goto-char r)
+ (skip-chars-forward "\r\n[:blank:]")
+ (save-excursion
+ (comment-region l r))
+ (skip-chars-forward "\r\n[:blank:]"))))
+
+(defun +lisp-comment-or-uncomment-sexp (&optional n)
+ "Comment the sexp at point and move past it.
+If already inside (or before) a comment, uncomment instead.
+With a prefix argument N, (un)comment that many sexps."
+ (interactive "P")
+ (if (or (elt (syntax-ppss) 4)
+ (< (save-excursion
+ (skip-chars-forward "\r\n[:blank:]")
+ (point))
+ (save-excursion
+ (comment-forward 1)
+ (point))))
+ (+lisp-uncomment-sexp n)
+ (dotimes (_ (or n 1))
+ (+lisp-comment-sexp--raw))))
+
(provide 'acdw)
;;; acdw.el ends here
--
cgit 1.4.1-21-gabe81