Fleoo

5 files changed, 279 insertions, 26 deletions

@@ -290,6 +290,17 @@ N spaces."
 (global-set-key (kbd "C-/") #'undo-only)
 (global-set-key (kbd "C-?") #'undo-redo)
 
+(global-set-key [f10] #'tmm-menubar)
+(advice-add 'tmm-add-prompt :after 'minibuffer-hide-completions)
+
+(when (fboundp '+lisp-comment-or-uncomment-sexp)
+  (define-key lisp-mode-map (kbd "C-M-;") #'+lisp-comment-or-uncomment-sexp)
+  (define-key emacs-lisp-mode-map (kbd "C-M-;")
+              #'+lisp-comment-or-uncomment-sexp)
+  (with-eval-after-load 'scheme
+    (define-key scheme-mode-map (kbd "C-M-;")
+                #'+lisp-comment-or-uncomment-sexp)))
+
 (define-key emacs-lisp-mode-map (kbd "C-c C-c")
             #'eval-defun)
 (define-key emacs-lisp-mode-map (kbd "C-c C-k")
@@ -415,14 +426,18 @@ See also `with-region-or-to-eol'."
   :ensure t :demand t
   :config
   (setq vertico-cycle t)
+  (add-hook 'vertico-mode-hook
+            (defun vertico-mode@fix-completions ()
+              (setopt completion-in-region-function
+                      (if vertico-mode
+                          #'consult-completion-in-region
+                        #'completion--in-region))))
   (vertico-mode))
 
 (use-package vertico-directory
   :after vertico
   :bind (:map vertico-map
-              ("RET" . vertico-directory-enter)
-              ("DEL" . vertico-directory-delete-char)
-              ("M-DEL" . vertico-directory-delete-word))
+              ("C-DEL" . vertico-directory-delete-word))
   :hook (rfn-shadow-update-overlay-hook . vertico-directory-tidy))
 
 (use-package vertico-mouse
@@ -10,12 +10,20 @@
 
 (use-package emacs                      ; Misc. config
   :custom-face
-  (default ((t :family "Comic Code"
+  (fixed-pitch ((t :family ,(find-font "Comic Code"
+                                       "DejaVu Sans Mono")
+                   :height 100)))
+  (variable-pitch ((t :family ,(find-font "Atkinson Hyperlegible"
+                                          "DejaVu Serif")
+                      :height 1.4)))
+  (default ((t :family ,(find-font "Comic Code"
+                                   "DejaVu Sans Mono")
                :height 100)))
-  (variable-pitch ((t :family "Comic Code")))
+  (font-lock-comment-face ((t :slant italic)))
   :config
   (setopt tab-bar-show 1
-          recenter-positions '(top middle bottom)))
+          recenter-positions '(top middle bottom))
+  (keymap-global-unset "C-\\"))
 
 (use-package faces
   :defer 2                              ; This is sort of expensive
@@ -272,7 +280,9 @@ With prefix ARG, toggle the value of
     (visual-fill-column-mode)
     (electric-pair-local-mode -1)
     (auto-fill-mode -1)
-    (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20)))
+    (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20)
+                visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width)
+                                                      . 1)))
   :custom-face
   (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
                             :foreground unspecified
@@ -294,12 +304,13 @@ With prefix ARG, toggle the value of
   :config
   (setopt jabber-account-list '(("acdw@hmm.st"))
           jabber-auto-reconnect t
-          jabber-last-read-marker (make-string 40 ?-)
+          jabber-last-read-marker (make-string (- fill-column 8) ?—)
           jabber-muc-decorate-presence-patterns
-          '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
+          '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
+            ("Mode #.*" . jabber-muc-presence-dim)
             ("." . jabber-muc-presence-dim))
           jabber-activity-make-strings #'jabber-activity-make-strings-shorten
-          jabber-last-read-marker (make-string (- fill-column 8) ?-)
+          jabber-last-read-marker (make-string fill-column ?-)
           jabber-rare-time-format  " - - - - - - %H:%M %F"
           ;; buffer name formats
           jabber-chat-buffer-format "%n <xmpp>"
@@ -341,6 +352,11 @@ With prefix ARG, toggle the value of
 
 ;;; External packages
 
+(use-package form-feed
+  :ensure t
+  :hook (emacs-lisp-mode-hook
+         jabber-chat-mode-hook))
+
 (use-package minions
   :ensure t
   :config (minions-mode))
@@ -349,7 +365,7 @@ With prefix ARG, toggle the value of
   :ensure t
   :init
   (setopt visual-fill-column-center-text t
-          visual-fill-column-extra-text-width '(1 . 1))
+          visual-fill-column-extra-text-width '(3 . 3))
   :config
   (add-hook 'visual-fill-column-mode-hook #'visual-line-mode)
   (add-hook 'eww-mode-hook #'visual-fill-column-mode)
@@ -620,7 +636,7 @@ With prefix ARG, toggle the value of
                       (push (cons (format "%s - %s" name tags) url) chans)))))))))
 
 (use-package wiki-abbrev
-  :defer 5                              ; Allow for network to come up
+  :after org                            ; Don't need abbrevs til I load org.
   :load-path "~/src/emacs/wiki-abbrev.el/"
   :config
   (setopt wiki-abbrev-file (etc/ "wiki-abbrevs"))
@@ -651,8 +667,8 @@ With PREFIX, prompt to change the current dictionary."
   :ensure t
   :after dired
   :bind (:map dired-mode-map
-             (("TAB" . dired-subtree-cycle)
-              ("i" . dired-subtree-toggle))))
+              (("TAB" . dired-subtree-cycle)
+               ("i" . dired-subtree-toggle))))
 
 (use-package dired-hide-dotfiles
   ;; I could maybe use a more general package for this ... see
@@ -661,11 +677,45 @@ With PREFIX, prompt to change the current dictionary."
   :bind (:map dired-mode-map
               ("." . dired-hide-dotfiles-mode)))
 
+(use-package embrace
+  :ensure t
+  :preface
+  (defmacro org-insert-or-embrace (char)
+    "Define a function to insert CHAR, or `embrace' the region with it."
+    (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char)))
+           (char (cond ((characterp char) char)
+                       ((stringp char) (string-to-char char))
+                       (t (user-error "Bad format for char: %S" char)))))
+      `(defun ,fn-name (n)
+         ,(format "Insert N %ss, or surround the region with them."
+                  (char-to-string char))
+         (interactive "p")
+         (if (region-active-p)
+             (dotimes (_ n)
+               (embrace--add-internal (region-beginning) (region-end) ,char)
+               (forward-char 1))
+           (self-insert-command n ,char)))))
+  (with-eval-after-load 'org
+    (require 'embrace)
+    (keymap-set org-mode-map "*" (org-insert-or-embrace "*"))
+    (keymap-set org-mode-map "/" (org-insert-or-embrace "/"))
+    (keymap-set org-mode-map "_" (org-insert-or-embrace "_"))
+    (keymap-set org-mode-map "=" (org-insert-or-embrace "="))
+    (keymap-set org-mode-map "~" (org-insert-or-embrace "~"))
+    (keymap-set org-mode-map "+" (org-insert-or-embrace "+")))
+  :bind (("C-\"" . embrace-commander))
+  :hook ((org-mode-hook . embrace-org-mode-hook)
+         (ruby-mode-hook . embrace-ruby-mode-hook)
+         (emacs-lisp-mode-hook . embrace-emacs-lisp-mode-hook)
+         (latex-mode-hook . embrace-LaTeX-mode-hook)))
+
 
 ;;; Applications
 
 (use-package acdw-mail
-  :load-path "lisp/")
+  :load-path "lisp/"
+  :demand t
+  :bind (("C-c n" . +notmuch-goto)))
 
 (use-package acdw-org
   :load-path "lisp/")
@@ -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