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 "" "\\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