From b89f452564387368b6f7f6fc4ded8ce65c27146d Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 13 Jan 2023 22:52:30 -0600 Subject: Fleoo --- basics.el | 21 +++++++-- init.el | 74 ++++++++++++++++++++++++++----- lisp/acdw-mail.el | 12 ++--- lisp/acdw-org.el | 69 ++++++++++++++++++++++++++--- lisp/acdw.el | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 279 insertions(+), 26 deletions(-) diff --git a/basics.el b/basics.el index 1f64522..3b24a68 100644 --- a/basics.el +++ b/basics.el @@ -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 diff --git a/init.el b/init.el index da4b537..f4eac89 100644 --- a/init.el +++ b/init.el @@ -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 " @@ -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/") 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