From d7824cacb2bb9d0b9c15fa24e15ac367effec9a5 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Fri, 20 Jan 2023 13:14:55 -0600 Subject: meh --- basics.el | 17 ++++++-- init.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++------- lisp/acdw-mail.el | 24 ++++++++++- lisp/acdw.el | 119 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 260 insertions(+), 21 deletions(-) diff --git a/basics.el b/basics.el index 428dcd1..68cdc2a 100644 --- a/basics.el +++ b/basics.el @@ -560,12 +560,23 @@ N spaces." :hook (embark-collect-mode . consult-preview-at-point-mode)) +(use-package undo-fu + :ensure t + :init + (setq undo-limit 67108864) ; 64mb. + (setq undo-strong-limit 100663296) ; 96mb. + (setq undo-outer-limit 1006632960) ; 960mb. + :bind (("C-/" . undo-fu-only-undo) + ("C-?" . undo-fu-only-redo))) + (use-package undo-fu-session :ensure t :config - (setq undo-fu-session-incompatible-files - '("/COMMIT_EDITMSG\\'" - "/git-rebase-todo\\'")) + (setopt undo-fu-session-compression (cond + ((executable-find "gunzip") 'gz) + ((executable-find "bzip2") 'bz2)) + undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" + "/git-rebase-todo\\'")) (global-undo-fu-session-mode)) (use-package crux diff --git a/init.el b/init.el index aed189c..864ac1b 100644 --- a/init.el +++ b/init.el @@ -1,6 +1,17 @@ ;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*- + +;; Author: Case Duckworth , with inspo from many others +;; Homepage: https://git.acdw.net/emacs +;; Config-Requires: ((emacs "29.0")) ;; Bankruptcy: 9.4 +;; This configuration is Free Software. Everyone is permitted to do whatever +;; they want with it, without limitation. This software comes without any +;; warranty whatsoever, but with two pieces of advice: +;; +;; - Don't hurt others. +;; - Make good choices. + ;;; Code: (load (locate-user-emacs-file "basics")) ; super basic stuff @@ -106,6 +117,14 @@ :config (fringe-mode '(nil . 0))) +(use-package ispell + :config + (setopt ispell-program-name (choose-executable "ispell" "aspell")) + (add-hook 'before-save-hook + #'+ispell-move-buffer-words-to-dir-locals-hook) + (put 'ispell-buffer-session-localwords 'safe-local-variable + '+ispell-safe-local-p)) + (use-package flyspell :hook org-mode-hook) @@ -164,6 +183,8 @@ (use-package time :config (setopt display-time-format " %H:%M" + display-time-interval 60 + display-time-use-mail-icon t display-time-mail-function (defun +notmuch-new-mail-p () (plist-get (cl-find "inbox+unread" @@ -173,8 +194,24 @@ :test #'equal) :count)) display-time-default-load-average nil) + (with-eval-after-load 'notmuch + (add-hook 'notmuch-after-tag-hook #'display-time-update)) (display-time-mode)) +(use-package tab-bar + :config + (setopt tab-bar-show t + tab-bar-close-button-show t) + ;; (add-to-list 'tab-bar-format 'tab-bar-format-menu-bar) + (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) + (add-to-list 'tab-bar-format 'tab-bar-format-global :append) + (when (daemonp) + (add-hook 'server-after-make-frame-hook + (defun after-frame@tab-bar () + (tab-bar-mode) + (remove-hook 'server-after-make-frame-hook + #'after-frame@tab-bar))))) + ;;; Applications @@ -265,7 +302,9 @@ With prefix ARG, toggle the value of (use-package filldent :load-path "~/src/emacs/filldent/" - :bind ("M-q" . filldent-dwim)) + :bind ("M-q" . filldent-dwim) + :config + (setopt filldent-fill-modes '(web-mode))) (use-package frowny :load-path "~/src/emacs/frowny/" @@ -338,8 +377,30 @@ With prefix ARG, toggle the value of word-boundary))) (hi-lock-unface-buffer regexp) (highlight-regexp regexp 'font-lock-warning-face)))))) + (add-hook 'jabber-chat-mode-hook + (defun jabber-chat@leave-when-kill () + (add-hook 'kill-buffer-hook + (defun @jabber-leave@kill () + (apply #'jabber-muc-leave (jabber-muc-argument-list))) + nil :local))) (when (fboundp 'jabber-chat-update-focus) - (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) + (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)) + (with-eval-after-load 'consult + (defvar jabber-chat-buffer-source + `( :name "Jabber" + :hidden nil + :narrow ?j + :category buffer + :state ,#'consult--buffer-state + :items ,(lambda () + (mapcar #'buffer-name + (seq-filter (lambda (buf) + (with-current-buffer buf + (eq major-mode 'jabber-chat-mode))) + (buffer-list)))))) + (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) + (consult-customize + consult-buffer :preview-key (kbd "M-.")))) (use-package keepassxc-shim :load-path "~/src/emacs/keepassxc-shim/" @@ -349,6 +410,14 @@ With prefix ARG, toggle the value of ;;; External packages +(use-package async + :ensure t + :config + ;; https://github.com/jwiegley/emacs-async/issues/64 + ;; (setopt message-send-mail-function #'async-smtpmail-send-it) + (dired-async-mode) + (async-bytecomp-package-mode)) + (use-package trashed :ensure t) @@ -367,11 +436,45 @@ With prefix ARG, toggle the value of :config (minions-mode)) (use-package visual-fill-column + :preface + (defcustom visual-fill-column-widen-amount 4 + "Amount to widen `fill-column' by in `visual-fill-column-mode'." + :type 'natnum + :group 'visual-fill-column) + (defun visual-fill-column--widen/narrow-handle-arg (cols) + (cond + ((null cols) visual-fill-column-widen-amount) + ((listp cols) (* visual-fill-column-widen-amount + (1+ (/ (car cols) 4)))) + ((eq '- cols) (- visual-fill-column-widen-amount)) + (:else cols))) + (defun visual-fill-column-widen (&optional cols) + "Widen `fill-column' by COLS, and re-display. +If COLS is missing or nil, widen by +`visual-fill-column-widen-amount'. When called with a plain +\\[universal-argument], multiply that amount by 1 + the amount of +\\[universal-argument]s. If called with a numerical prefix +argument, widen by that number of columns." + (interactive "P") + (let ((cols (visual-fill-column--widen/narrow-handle-arg cols))) + (cl-incf fill-column cols) + (visual-fill-column-adjust) + (message "Fill-column: %s" fill-column))) + (defun visual-fill-column-narrow (&optional cols) + "Narrow `fill-column' by COLS, then redisplay. +The prefix argument is as in `visual-fill-column-widen' but negated." + (interactive "P") + (let ((cols (visual-fill-column--widen/narrow-handle-arg cols))) + (cl-decf fill-column cols) + (visual-fill-column-adjust) + (message "Fill-column: %s" fill-column))) :ensure t :init (setopt visual-fill-column-center-text t visual-fill-column-extra-text-width '(3 . 3)) :config + (keymap-set visual-fill-column-mode-map "C-x C->" #'visual-fill-column-widen) + (keymap-set visual-fill-column-mode-map "C-x C-<" #'visual-fill-column-narrow) (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) (add-hook 'eww-mode-hook #'visual-fill-column-mode) (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) @@ -726,15 +829,5 @@ With PREFIX, prompt to change the current dictionary." (use-package php-mode :ensure t) -(use-package tab-bar - :config - (setopt tab-bar-show t) - (add-to-list 'tab-bar-format 'tab-bar-format-menu-bar) - (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) - (add-to-list 'tab-bar-format 'tab-bar-format-global :append) - (with-eval-after-load 'notmuch - - ;; (remove-hook 'notmuch-after-tag-hook #'tab-bar-make-keymap-1) - (define-advice notmuch-update-tags (:after (&rest _) update-tab-bar) - (tab-bar--update-tab-bar-lines))) - (tab-bar-mode)) +(use-package rec-mode + :ensure t) diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index 8b0ab25..ae78fa0 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el @@ -74,6 +74,7 @@ for a free-form search. With any other PREFIX argument, open (mapcar (lambda (elt) (plist-get elt :name)) notmuch-saved-searches)) + notmuch-saved-searches :key (lambda (elt) (plist-get elt :name)) :test #'equal) :query))) @@ -127,6 +128,22 @@ the saved search as well." (equal (plist-get a :name) (plist-get b :name)))))) +(defun notmuch-async-poll () + "Run `notmuch-poll' in an async process." + (interactive) + (if (require 'async nil t) + (progn + (message "Polling mail async...") + (async-start + (lambda () + (push "~/usr/share/emacs/site-lisp/" load-path) + (require 'notmuch-lib) + (notmuch-poll)) + (lambda (result) + (message "%s" result)))) + (user-error "Feature `async' not found!"))) + + ;;; Packages (use-package bbdb @@ -174,7 +191,9 @@ the saved search as well." mail-specify-envelope-from t message-sendmail-envelope-from 'header message-envelope-from 'header - notmuch-saved-searches nil) + notmuch-saved-searches nil + notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option + ) ;; Key bindings (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) @@ -205,6 +224,9 @@ the saved search as well." (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) + (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async) + (notmuch-async-poll)) + (define-advice notmuch-address-selection-function (:override (prompt collection _) no-initial-input) "Call `completing-read' with `notmuch-address-history'. diff --git a/lisp/acdw.el b/lisp/acdw.el index a05295c..3b178db 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -2,6 +2,9 @@ ;;; Code: +(require 'cl-lib) +(require 'seq) + (defmacro defdir (name directory &optional docstring makedir) "Define a variable and a function NAME expanding to DIRECTORY. DOCSTRING is applied to the variable; its default is DIRECTORY's @@ -22,9 +25,9 @@ be created." (make-directory (file-name-directory file-name) :parents)) file-name)) ,(if makedir - `(make-directory ,directory :parents) - `(unless (file-exists-p ,directory) - (warn "Directory `%s' doesn't exist." ,directory))))) + `(make-directory ,directory :parents) + `(unless (file-exists-p ,directory) + (warn "Directory `%s' doesn't exist." ,directory))))) (defun choose-executable (&rest programs) "Return the first of PROGRAMS that exists in the system's $PATH. @@ -85,6 +88,17 @@ If `:separator' is the first of STRINGS, the next string will be used as a separator." (++concat #'format strings)) +(defun list-append-removing-duplicates (&rest lists) + "Append LISTS, removing duplicates from the result. +Any keyword arguments to `cl-remove-duplicates' should come +before the LISTS." + (let (cl-remove-duplicates-args) + (while (keywordp (car lists)) + (push (pop lists) cl-remove-duplicates-args) + (push (pop lists) cl-remove-duplicates-args)) + (apply #'cl-remove-duplicates (apply #'append lists) + (nreverse cl-remove-duplicates-args)))) + (defun mapc-buffers (func &optional predicate) "Map FUNC over buffers matching PREDICATE. Both FUNC and PREDICATE will be executed with no arguments and in @@ -125,6 +139,83 @@ each buffer." (progress-reporter-done ,prog))))) + +;;; Ispell in .dir-locals + +;; Let Emacs know a list of strings is safe +(defun +ispell-safe-local-p (list) + (and (listp list) + (seq-every-p #'stringp list))) + +;; Can I instruct ispell to insert LocalWords in a different file? +;; https://emacs.stackexchange.com/q/31396/2264 + +;; How can I move all my file-local LocalWords to .dir-locals.el? +;; https://emacs.stackexchange.com/q/31419 + +;; Adapted from ispell.el:ispell-buffer-local-words +(defun +ispell-buffer-local-words-list () + (let (words) + (or ispell-buffer-local-name + (setf ispell-buffer-local-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (while (search-forward ispell-words-keyword nil t) + (let ((end (point-at-eol)) + (ispell-casechars (ispell-get-casechars)) + string) + (while (re-search-forward " *\\([^ ]+\\)" end t) + (setf string (match-string-no-properties 1)) + (if (and (< 1 (length string)) + (equal 0 (string-match ispell-casechars string))) + (push string words)))))) + words)) + +;;;###autoload +(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) + "Move the current buffer-local words to .dir-locals.el. +This function prompts the user to save .dir-locals.el, unless +prefix ARG is non-nil; then it just saves them." + (interactive "P") + (unless (buffer-file-name) + (user-error "Buffer not attached to file")) + (hack-dir-local-variables) + (let ((print-level nil) + (print-length nil)) + (when-let ((new-words (cl-remove-if + (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA + ; where this came from + (list-append-removing-duplicates + :test #'string= + ispell-buffer-session-localwords + (alist-get 'ispell-buffer-session-localwords + dir-local-variables-alist) + (alist-get 'ispell-buffer-session-localwords + file-local-variables-alist) + (+ispell-buffer-local-words-list))))) + (save-excursion + (add-dir-local-variable + major-mode + 'ispell-buffer-session-localwords + (setf ispell-buffer-session-localwords + new-words)) + (when (or arg + (y-or-n-p "Save .dir-locals.el?")) + (save-buffer)) + (bury-buffer)) + (or ispell-buffer-local-name + (setf ispell-buffer-local-name (buffer-name))) + (save-excursion + (goto-char (point-min)) + (while (search-forward ispell-words-keyword nil t) + (delete-region (point-at-bol) (1+ (point-at-eol)))))))) + +;;;###autoload +(defun +ispell-move-buffer-words-to-dir-locals-hook () + "Convenience function for binding to a hook." + (+ispell-move-buffer-words-to-dir-locals t)) + + ;;; Comment-or-uncomment-sexp ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html @@ -214,5 +305,27 @@ With a prefix argument N, (un)comment that many sexps." (dotimes (_ (or n 1)) (+lisp-comment-sexp--raw)))) + +;;; Random shit + +(defun insert-iso-date (&optional arg) + "Insert current date formatted ISO-8601 style. +When called with \\[universal-argument] \\[insert-iso-date], +include the time. When called with \\[universal-argument] +\\[universal-argument] \\[insert-iso-date], prompt the user for the +`format-time-string' format to use." + (interactive "P") + (insert (format-time-string (pcase arg + ('nil "%F") + ('(4) "%FT%T%z") + (_ (read-string "Time format: ")))))) + +(defun unfill-paragraph () + "Unfill the current paragraph." + (interactive) + (let ((fill-column most-positive-fixnum) + (fill-paragraph-function nil)) + (fill-paragraph))) + (provide 'acdw) ;;; acdw.el ends here -- cgit 1.4.1-21-gabe81