Fleoo

3 files changed, 199 insertions, 11 deletions

@@ -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."
@@ -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
@@ -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