From 2d2cab9d97d3e84e5b7158181523fe2c5bbffe85 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 16 Apr 2023 17:06:41 -0500 Subject: uhhh --- basics.el | 62 +++++- early-init.el | 12 +- history | 6 + init.el | 554 +++++++++++++++++++++++++++++++++++------------------ lisp/+link-hint.el | 83 +++++--- lisp/+scratch.el | 75 ++++++++ lisp/acdw-chat.el | 174 +++++++++++++++++ lisp/acdw-mail.el | 113 ++++++++++- lisp/acdw-org.el | 77 +++++--- lisp/acdw-web.el | 101 ++++++++-- lisp/acdw.el | 45 ++++- lisp/ical2org.el | 56 ++++++ places | 2 + recentf | 17 ++ 14 files changed, 1117 insertions(+), 260 deletions(-) create mode 100644 history create mode 100644 lisp/+scratch.el create mode 100644 lisp/acdw-chat.el create mode 100644 lisp/ical2org.el create mode 100644 places create mode 100644 recentf diff --git a/basics.el b/basics.el index 3905003..15831d3 100644 --- a/basics.el +++ b/basics.el @@ -192,7 +192,7 @@ auto-save-interval 1 auto-save-no-message t auto-save-timeout 1 - auto-save-visited-interval 1 + auto-save-visited-interval 10 remote-file-name-inhibit-auto-save-visited t) (add-to-list 'auto-save-file-name-transforms `(".*" ,(etc/ "auto-save/" t) t)) @@ -208,7 +208,8 @@ (setq-default ;; recentf-save-file (etc/ "recentf" t) recentf-max-menu-items 500 recentf-max-saved-items nil ; Save the whole list - recentf-auto-cleanup 'mode) + recentf-auto-cleanup 'mode + recentf-case-fold-search t) (add-to-list 'recentf-exclude etc/) (add-to-list 'recentf-exclude "-autoloads.el\\'") (add-hook 'buffer-list-update-hook #'recentf-track-opened-file) @@ -309,13 +310,62 @@ current line." (list (line-beginning-position) (line-end-position)))))) +(defun +kill-buffer (&optional buffer-or-name) + "Kill the current buffer, or BUFFER-OR-NAME. +When called interactively, prompt the user when given a prefix +argument." + (interactive "P") + (cond + ((bufferp buffer-or-name) + (kill-buffer buffer-or-name)) + ((null buffer-or-name) + (kill-current-buffer)) + (:else + (kill-buffer (read-buffer "Kill: " nil :require-match))))) + +(defun +backward-kill-word (arg) + "Kill ARG words backward unless at the beginning of a line. +When at the beginning of a line, delete blank lines before point." + (interactive "p") + (cond + ((bolp) + ;; This is the first bit of `delete-blank-lines'. -- acdw + (let (thisblank singleblank) + (save-excursion + (beginning-of-line) + (setq thisblank (looking-at "[ \t]*$")) + ;; Set singleblank if there is just one blank line here. + (setq singleblank + (and thisblank + (not (looking-at "[ \t]*\n[ \t]*$")) + (or (bobp) + (progn (forward-line -1) + (not (looking-at "[ \t]*$"))))))) + ;; Delete preceding blank lines, and this one too if it's the only one. + (if thisblank + (progn + (beginning-of-line) + (if singleblank (forward-line 1)) + (delete-region (point) + (if (re-search-backward "[^ \t\n]" nil t) + (progn (forward-line 1) (point)) + (point-min))))) + (if (or (not thisblank) + singleblank) + (progn + (beginning-of-line) + (backward-delete-char 1))))) + (:else + (backward-kill-word arg)))) + (global-set-key [remap eval-expression] #'pp-eval-expression) (global-set-key (kbd "M-o") #'other-window|switch-buffer) (global-set-key [remap delete-window] #'delete-window|bury-buffer) (global-set-key [remap cycle-spacing] #'+cycle-spacing) -(global-set-key (kbd "C-x C-k") #'kill-this-buffer) +(global-set-key (kbd "C-x C-k") #'+kill-buffer) (global-set-key [remap comment-dwim] #'+comment-dwim) (global-set-key [remap undo] #'undo-only) +(global-set-key [remap backward-kill-word] #'+backward-kill-word) (global-set-key [f10] #'tmm-menubar) (advice-add 'tmm-add-prompt :after 'minibuffer-hide-completions) @@ -533,6 +583,12 @@ current line." ;; :preview-key (kbd "M-.") :preview-key '(:debounce 0.4 any)) + ;; (consult-customize consult-line + ;; consult-ripgrep + ;; :initial (when (use-region-p) + ;; (buffer-substring-no-properties + ;; (region-beginning) (region-end)))) + ;; Optionally configure the narrowing key. ;; Both < and C-+ work reasonably well. (setq consult-narrow-key "<") ;; (kbd "C-+") diff --git a/early-init.el b/early-init.el index e024b50..4b67629 100644 --- a/early-init.el +++ b/early-init.el @@ -28,7 +28,9 @@ (setq package-priorities '(("melpa" . 3) ("nongnu" . 2) ("gnu" . 1) - ("melpa-stable" . 0))) + ("melpa-stable" . 0)) + package-enable-at-startup nil) + (package-initialize) (unless package-archive-contents (package-refresh-contents)) @@ -36,9 +38,15 @@ (setq use-package-enable-imenu-support t use-package-hook-name-suffix nil) -(require 'use-package) +(eval-when-compile + (require 'use-package)) (setq use-package-compute-statistics debug-on-error) +(define-advice use-package (:before (name &rest body) select) + "Add NAME to `package-selected-packages'." + (when (memq :ensure body) + (add-to-list 'package-selected-packages name))) + (use-package use-package-vc :load-path "~/src/emacs/use-package-vc.el/" :config diff --git a/history b/history new file mode 100644 index 0000000..4fc776d --- /dev/null +++ b/history @@ -0,0 +1,6 @@ +;; -*- mode: emacs-lisp; coding: utf-8-unix -*- +;; Minibuffer history file, automatically generated by ‘savehist’. + +(setq savehist-minibuffer-history-variables '(extended-command-history file-name-history)) +(setq extended-command-history '("undo")) +(setq file-name-history '("~/etc/emacs/init.el")) diff --git a/init.el b/init.el index c8fb4e7..d6363ea 100644 --- a/init.el +++ b/init.el @@ -22,18 +22,39 @@ (use-package emacs ; Misc. config :config (setopt recenter-positions '(top middle bottom) - initial-scratch-message - (format "%s\n\n" - (mapconcat (lambda (s) (format ";; %s" s)) - (process-lines "fortune" "-s") - "\n"))) + initial-major-mode 'lisp-interaction-mode + initial-scratch-message ";; Emacs!\n\n" + ;; (format "%s\n\n" + ;; (mapconcat (lambda (s) (format ";; %s" s)) + ;; (process-lines "fortune" "-s") + ;; "\n")) + eval-expression-print-level nil + eval-expression-print-length nil + x-select-enable-clipboard-manager nil) + ;; TODO: move this ... elsewhere + (setopt mode-line-format + '("%e" + mode-line-front-space + ;; (:propertize ("" mode-line-mule-info + ;; mode-line-client + ;; mode-line-modified + ;; mode-line-remote) + ;; display (min-width (5.0))) + ("" mode-line-mule-info + mode-line-client + mode-line-modified + mode-line-remote) + mode-line-frame-identification + mode-line-buffer-identification + " " + mode-line-position + (vc-mode vc-mode) + " " + minions-mode-line-modes + mode-line-misc-info + mode-line-end-spaces)) (keymap-global-unset "C-\\") (keymap-global-unset "") - (add-hook 'kill-buffer-query-functions - (defun scratch@immortal () - (if (equal (buffer-name) "*scratch*") - (progn (bury-buffer) nil) - t))) (setf (alist-get "\\*Compile-Log\\*" display-buffer-alist nil nil #'equal) '(display-buffer-no-window)) (add-hook 'after-init-hook @@ -61,20 +82,28 @@ (defun first-frame@set-fonts () (remove-hook 'server-after-make-frame-hook #'first-frame@set-fonts) - (face-spec-set 'fixed-pitch - `((t :family ,(find-font "Comic Code" - "DejaVu Sans Mono") - :height 100))) - (face-spec-set 'variable-pitch - `((t :family ,(find-font "Atkinson Hyperlegible" - "DejaVu Serif") - :height 1.4))) (face-spec-set 'default - `((t :family ,(find-font "Comic Code" - "DejaVu Sans Mono") + `((t :family ,(find-font + "Recursive Mono Casual Static" + "Comic Code" + "DejaVu Sans Mono") :height 100))) + (face-spec-set 'fixed-pitch + `((t :family ,(find-font + "Recursive Mono Casual Static" + "Comic Code" + "DejaVu Sans Mono") + :height 1.0))) + (face-spec-set 'variable-pitch + `((t :family ,(find-font + "Recursive Sans Linear Static" + "Atkinson Hyperlegible" + "DejaVu Serif") + :height 1.0))) (face-spec-set 'font-lock-comment-face - `((t :slant italic))) + `((t :inherit variable-pitch))) + (face-spec-set 'font-lock-string-face + `((t :inherit variable-pitch))) ;; Emojis (cl-loop with ffl = (font-family-list) for font in '("Noto Emoji" "Noto Color Emoji" @@ -85,27 +114,28 @@ do (set-fontset-font t 'symbol font)) ;; International scripts (cl-loop with ffl = (font-family-list) - for (charset . font) in '((latin . "Noto Sans") - (han . "Noto Sans CJK SC Regular") - (kana . "Noto Sans CJK JP Regular") - (hangul . "Noto Sans CJK KR Regular") - (cjk-misc . "Noto Sans CJK KR Regular") - (khmer . "Noto Sans Khmer") - (lao . "Noto Sans Lao") - (burmese . "Noto Sans Myanmar") - (thai . "Noto Sans Thai") - (ethiopic . "Noto Sans Ethiopic") - (hebrew . "Noto Sans Hebrew") - (arabic . "Noto Sans Arabic") - (gujarati . "Noto Sans Gujarati") - (devanagari . "Noto Sans Devanagari") - (kannada . "Noto Sans Kannada") - (malayalam . "Noto Sans Malayalam") - (oriya . "Noto Sans Oriya") - (sinhala . "Noto Sans Sinhala") - (tamil . "Noto Sans Tamil") - (telugu . "Noto Sans Telugu") - (tibetan . "Noto Sans Tibetan")) + for (charset . font) + in '((latin . "Noto Sans") + (han . "Noto Sans CJK SC Regular") + (kana . "Noto Sans CJK JP Regular") + (hangul . "Noto Sans CJK KR Regular") + (cjk-misc . "Noto Sans CJK KR Regular") + (khmer . "Noto Sans Khmer") + (lao . "Noto Sans Lao") + (burmese . "Noto Sans Myanmar") + (thai . "Noto Sans Thai") + (ethiopic . "Noto Sans Ethiopic") + (hebrew . "Noto Sans Hebrew") + (arabic . "Noto Sans Arabic") + (gujarati . "Noto Sans Gujarati") + (devanagari . "Noto Sans Devanagari") + (kannada . "Noto Sans Kannada") + (malayalam . "Noto Sans Malayalam") + (oriya . "Noto Sans Oriya") + (sinhala . "Noto Sans Sinhala") + (tamil . "Noto Sans Tamil") + (telugu . "Noto Sans Telugu") + (tibetan . "Noto Sans Tibetan")) if (member font ffl) do (set-fontset-font t charset font)))) (unless (daemonp) @@ -142,14 +172,11 @@ (use-package ispell :config (setopt ispell-program-name (choose-executable "aspell" "ispell")) - (add-hook 'before-save-hook - #'+ispell-move-buffer-words-to-dir-locals-hook) + ;; (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) - (use-package dired :bind (("C-x C-j" . dired-jump) ([remap list-directory] . dired) @@ -186,7 +213,16 @@ "localhost" "dict.org")) :bind - (("C-c d" . dictionary-search))) + (("C-c w d" . dictionary-search)) + :config + (setf (alist-get "\\*Dictionary\\*" display-buffer-alist nil nil #'equal) + '(display-buffer-in-side-window + (window-width . 80) + (side . right)))) + +(use-package calendar + :custom + (diary-file (private/ "diary"))) (use-package mouse :config @@ -261,9 +297,12 @@ ;; https://www.masteringemacs.org/article/seamlessly-merge-multiple-documentation-sources-eldoc (setq eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly)) :hook - ((bash-ts-mode . eglot)) + ((bash-ts-mode . eglot-ensure) + (scheme-mode . eglot-ensure)) :config - (add-hook 'eglot-managed-mode . +eglot-eldoc)) + (add-to-list 'eglot-server-programs + '(scheme-mode . ("chicken-lsp-server"))) + (add-hook 'eglot-managed-mode #'+eglot-eldoc)) (use-package eldoc :config @@ -273,6 +312,76 @@ (window-height . 4))) (eldoc-add-command-completions "paredit-")) +(use-package pulse + :config + (setopt pulse-flag nil + pulse-delay 1 + pulse-iterations 1)) + +(use-package flyspell + :hook (org-mode-hook)) + +(use-package display-fill-column-indicator + :hook (prog-mode-hook)) + +(use-package package + :config + (defun package-update-async-in-progress (&rest _) + (message "Package async update in progress.")) + + (defun package-update-all-async () + "Update packages asyncronously." + (interactive) + (let ((message "Package update (async)...") + (disable-fns '(package-update + package-update-all + package-update-all-async))) + (dolist (fn disable-fns) + (advice-add fn :override #'package-update-async-in-progress)) + (message "%s" message) + (unwind-protect + (async-start + `(lambda () + (package-initialize) + (package-update-all)) + `(lambda (result) + (message "%s %s" ,message result))) + (dolist (fn ',disable-fns) + (advice-remove fn 'package-update-async-in-progress)))))) + +(use-package ielm + ;; https://www.n16f.net/blog/making-ielm-more-comfortable/ + :preface + (defun +ielm-init-history () + (let ((path (etc/ "ielm/history" t))) + (setq-local comint-input-ring-file-name path)) + (setq-local comint-input-ring-size 10000) + (setq-local comint-input-ignoredups t) + (ignore-errors (comint-read-input-ring))) + (defun +ielm-write-history (&rest _args) + (with-file-modes #o600 + (comint-write-input-ring))) + (defun +ielm (&optional buf-name) + "Interactively evaluate Emacs Lisp expressions. +Switches to the buffer named BUF-NAME if provided (`*ielm*' by default), +or creates it if it does not exist. +See `inferior-emacs-lisp-mode' for details." + (interactive) + (let (old-point + (buf-name (or buf-name "*ielm*"))) + (unless (comint-check-proc buf-name) + (with-current-buffer (get-buffer-create buf-name) + (unless (zerop (buffer-size)) (setq old-point (point))) + (inferior-emacs-lisp-mode))) + (pop-to-buffer buf-name) + (when old-point (push-mark old-point)))) + :bind (:map emacs-lisp-mode-map + ("C-c C-z" . +ielm)) + :config + (add-hook 'ielm-mode-hook #'eldoc-mode) + (add-hook 'ielm-mode-hook #'+ielm-init-history) + (advice-add 'ielm-send-input :after #'+ielm-write-history)) + ;;; Applications @@ -282,7 +391,9 @@ :bind (("C-c n" . +notmuch-goto))) (use-package acdw-org - :load-path "lisp/") + :load-path "lisp/" + :config + (global-set-key [f8] #'org-clock-out)) (use-package acdw-shell :load-path "lisp/") @@ -290,12 +401,33 @@ (use-package acdw-web :load-path "lisp/") +(use-package acdw-chat + :load-path "lisp/") + (use-package _work - :load-path "~/Sync/emacs/private/") + :load-path "~/sync/emacs/private/") ;;; Locally-developed packages +(use-package +scratch + :load-path "lisp/" + :config + (setopt +scratch-save-dir (sync/ "emacs/scratch.d/" t)) + (add-hook 'kill-buffer-query-functions #'+scratch@immortal) + (add-hook 'kill-emacs-hook #'+scratch-save-on-exit) + (with-current-buffer (get-scratch-buffer-create) + (local-set-key (kbd "C-x C-s") #'+scratch-save)) + ;; Save *scratch* every hour + (run-at-time t (* 60 60) #'+scratch-save "%FT%H%z") + ;; Clean old *scratch* saves every day + (run-at-time t (* 60 60 24) #'+scratch-clean)) + +(use-package pulse-location + :load-path "~/src/emacs/pulse-location/" + :config + (pulse-location-mode)) + (use-package dawn :load-path "~/src/emacs/dawn/" :after custom-allowed @@ -303,7 +435,41 @@ (add-hook 'custom-allowed-after-load-hook (defun dawn-modus () (dawn-schedule-themes 'modus-operandi - 'modus-vivendi)))) + 'modus-vivendi))) + (setopt modus-themes-mixed-fonts t) + (load-theme 'modus-vivendi t) + (add-hook 'dawn-after-load-theme-hook + (defun +reset-faces () + (dolist (face '(font-lock-regexp-face + font-lock-variable-name-face + font-lock-preprocessor-face + font-lock-remove-face + font-lock-delimiter-face + font-lock-label-face + font-lock-operator-face + font-lock-property-face + font-lock-builtin-face + font-lock-number-face + font-lock-set-face + font-lock-warning-face + font-lock-punctuation-face + font-lock-constant-face + font-lock-type-face + font-lock-function-name-face + font-lock-reference-face + font-lock-negation-char-face + font-lock-misc-punctuation-face + font-lock-escape-face + font-lock-bracket-face)) + (face-spec-set face '((t :foreground unspecified + :background unspecified)))) + (face-spec-set 'font-lock-keyword-face + '((t :foreground unspecified + :background unspecified + :weight bold))) + (face-spec-set 'font-lock-doc-face + '((t :slant italic))))) + (+reset-faces)) (use-package electric-cursor :load-path "~/src/emacs/electric-cursor/" @@ -345,18 +511,13 @@ With prefix ARG, toggle the value of (titlecase-region (progn (org-beginning-of-line) (point)) (progn (org-end-of-line) (point))))))) :config - (keymap-set scule-map "M-t" #'titlecase-dwim)) + (with-eval-after-load 'scule + (keymap-set scule-map "M-t" #'titlecase-dwim))) (use-package scule :load-path "~/src/emacs/scule/" - :config - (defvar-keymap scule-map - :doc "Keymap to twiddle scules." - :repeat t ; TODO: doesn't work - "M-u" #'scule-upcase - "M-l" #'scule-downcase - "M-c" #'scule-capitalize) - (keymap-global-set "M-c" scule-map) + :bind-keymap ("M-c" . scule-map) + :init ;; Use M-u for prefix keys (keymap-global-set "M-u" #'universal-argument) (keymap-set universal-argument-map "M-u" #'universal-argument-more)) @@ -372,111 +533,6 @@ With prefix ARG, toggle the value of :config (global-frowny-mode)) -(use-package jabber - :load-path "~/src/emacs/jabber/" - :preface - (defvar jabber-prefix-width 10 - "Width of jabber prompts and other prefixes.") - (defun jabber-ui-setup () - "Setup the `jabber' user interface." - (visual-fill-column-mode) - (electric-pair-local-mode -1) - (auto-fill-mode -1) - (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 - :weight normal))) - (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local - :foreground unspecified - :weight bold))) - (jabber-chat-prompt-local ((t :inherit font-lock-warning-face - :foreground unspecified))) - (jabber-chat-prompt-foreign ((t :inherit font-lock-constant-face - :foreground unspecified))) - (jabber-chat-prompt-system ((t :inherit font-lock-doc-face - :foreground unspecified))) - (jabber-rare-time-face ((t :inherit font-lock-comment-face - :foreground unspecified - :underline nil))) - :bind-keymap ("C-c j" . jabber-global-keymap) - :bind (("C-c C-SPC" . jabber-activity-switch-to)) - :config - (setopt jabber-account-list '(("acdw@hmm.st")) - jabber-auto-reconnect t - jabber-last-read-marker (make-string (- fill-column 8) ?—) - jabber-muc-decorate-presence-patterns - '(("\\( 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-rare-time-format " - - - - - - %H:%M %F" - jabber-muc-header-line-format - '(" " (:eval (replace-regexp-in-string "%" "%%" - (jabber-jid-displayname - jabber-group))) - " / " jabber-muc-topic) - ;; buffer name formats - jabber-chat-buffer-format "*xmpp* %n" - jabber-browse-buffer-format "*xmpp-browse* %n" - jabber-groupchat-buffer-format "*xmpp-muc* %n" - jabber-muc-private-buffer-format "*xmpp-muc-private* %n" - ;; "prompt" (speaker) formats - jabber-groupchat-prompt-format (format "%%>%dn | " jabber-prefix-width) - jabber-chat-local-prompt-format (format "%%>%dn | " jabber-prefix-width) - jabber-chat-foreign-prompt-format (format "%%>%dn | " jabber-prefix-width) - jabber-muc-private-foreign-prompt-format "\n%g/%n | ") - ;; jabber muc nick coloring - ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus) - ;; (setopt jabber-muc-nick-value 1.0 - ;; jabber-muc-nick-saturation 1.0 - ;; jabber-muc-colorize-local t - ;; jabber-muc-colorize-foreign t) - ;; When changing the above values, make sure to - ;; (setq jabber-muc-participant-colors nil) - (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup) - (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix - (require 'jabber-httpupload nil t) - (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) - (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) - (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) - (add-hook 'jabber-alert-muc-hooks - (defun jabber@highlight-acdw (&optional _ _ buf _ _) - (when buf - (with-current-buffer buf - (let ((regexp (rx word-boundary - "acdw" ; maybe get from the config? - 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 () - (ignore-errors - (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)) - (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 "M-."))) - (use-package keepassxc-shim :load-path "~/src/emacs/keepassxc-shim/" :config @@ -502,7 +558,7 @@ With prefix ARG, toggle the value of (use-package form-feed :ensure t - :hook (emacs-lisp-mode-hook)) + :hook (prog-mode-hook)) (use-package clean-kill-ring :vc (:url "https://github.com/NicholasBHubbard/clean-kill-ring.el") @@ -548,10 +604,11 @@ The prefix argument is as in `visual-fill-column-widen' but negated." (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 + (setopt visual-fill-column-center-text t + visual-fill-column-extra-text-width '(3 . 3) + visual-fill-column-width (+ fill-column 4)) + (keymap-set toggle-map "v" #'visual-fill-column-mode) (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) @@ -590,12 +647,12 @@ The prefix argument is as in `visual-fill-column-widen' but negated." (use-package avy :ensure t - :init - (setopt avy-background t - avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) :bind (("M-j" . avy-goto-char-timer) :map isearch-mode-map - ("M-j" . avy-isearch))) + ("M-j" . avy-isearch)) + :config + (setopt avy-background t + avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm"))) (use-package zzz-to-char :ensure t @@ -660,8 +717,9 @@ The prefix argument is as in `visual-fill-column-widen' but negated." (call-interactively (if (derived-mode-p 'lisp-interaction-mode) #'eval-print-last-sexp #'paredit-newline)))) - (keymap-set paredit-mode-map "RET" nil) - (keymap-set paredit-mode-map "M-s" nil) + (keymap-unset paredit-mode-map "RET" t) + (keymap-unset paredit-mode-map "M-s" t) + (keymap-unset paredit-mode-map "M-r" t) (add-to-list 'paredit-space-for-delimiter-predicates (defun paredit@dont-space-@ (endp delimiter) "Don't add a space after @ in `paredit-mode'." @@ -717,10 +775,9 @@ The prefix argument is as in `visual-fill-column-widen' but negated." (use-package sly :ensure t + :when inferior-lisp-program :preface (setopt inferior-lisp-program (choose-executable "sbcl")) - :when inferior-lisp-program - :init (defun +sly-start-or-mrepl () (interactive) (if (ignore-errors (sly-connection)) @@ -754,7 +811,11 @@ The prefix argument is as in `visual-fill-column-widen' but negated." "\\.erb\\'" "\\.mustache\\'" "\\.djhtml\\'" - "\\.html?\\'")) + "\\.html?\\'") + :config + (add-hook 'web-mode-hook + (defun web-mode@setup () + (indent-tabs-mode -1)))) (use-package nginx-mode :ensure t @@ -775,6 +836,7 @@ The prefix argument is as in `visual-fill-column-widen' but negated." (pandoc-mode-hook . pandoc-load-default-settings))) (use-package edit-indirect + :ensure :bind (("C-c '" . edit-indirect-region))) (use-package transpose-frame @@ -842,9 +904,9 @@ With PREFIX, prompt to change the current dictionary." (call-interactively #'ispell-change-dictionary))) (flyspell-correct-move (point-min) :forward :rapid)) :after flyspell - :bind (:map flyspell-mode-map - ("C-;" . flyspell-correct-wrapper) - ("" . +flyspell-correct-buffer)) + :bind (("" . +flyspell-correct-buffer) + (:map flyspell-mode-map + ("C-;" . flyspell-correct-wrapper))) :config (setq flyspell-correct--cr-key ";") (keymap-unset flyspell-mode-map "C-," t) @@ -871,6 +933,10 @@ With PREFIX, prompt to change the current dictionary." :config (setopt dgi-auto-hide-details-p nil)) +(use-package expand-region ; needed for embrace anyway + :ensure t + :bind (("C-=" . er/expand-region))) + (use-package embrace :ensure t :preface @@ -961,10 +1027,25 @@ With PREFIX, prompt to change the current dictionary." ;; (setq start (point))) ;; (scheme-send-region-and-go start end)))))) -(use-package geiser-guile ; Let's try using guile instead +(use-package geiser :ensure t :config - (keymap-unset scheme-mode-map "M-o" t)) + (use-package geiser-guile :ensure t) + (use-package geiser-chicken :ensure t) + (use-package geiser-chez :ensure t) + (use-package geiser-gambit :ensure t) + (use-package geiser-chibi :ensure t) + (use-package macrostep-geiser + :ensure t + :config + (eval-after-load 'geiser-mode + '(add-hook 'geiser-mode-hook #'macrostep-geiser-setup)) + (eval-after-load 'geiser-repl + '(add-hook 'geiser-repl-mode-hook #'macrostep-geiser-setup))) + (with-eval-after-load 'geiser-mode + (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go) + (keymap-unset geiser-mode-map "C-." t) + (keymap-unset scheme-mode-map "M-o" t))) (use-package treesit-auto ;; XXX: I don't really get the utility of this package, but I spent a ton of @@ -984,7 +1065,8 @@ With PREFIX, prompt to change the current dictionary." (use-package detached :when (executable-find "dtach") :ensure t - :init (detached-init) + :init + (add-hook 'after-init-hook #'detached-init) :bind (([remap async-shell-command] . detached-shell-command) ([remap compile] . detached-compile) ([remap recompile] . detached-compile-recompile)) @@ -992,3 +1074,103 @@ With PREFIX, prompt to change the current dictionary." (setf detached-terminal-data-command system-type) (with-eval-after-load 'consult (global-set-key [remap detached-open-session] #'detached-consult-session))) + +(use-package lin + :ensure t + :config + (setopt lin-face 'lin-cyan + lin-mode-hooks + '(dired-mode-hook + ;; bongo-mode-hook + ;; elfeed-search-mode-hook + git-rebase-mode-hook + grep-mode-hook + ibuffer-mode-hook + ilist-mode-hook + ;; ledger-report-mode-hook + log-view-mode-hook + magit-log-mode-hook + ;; mu4e-headers-mode-hook + notmuch-search-mode-hook + notmuch-tree-mode-hook + occur-mode-hook + org-agenda-mode-hook + pdf-outline-buffer-mode-hook + proced-mode-hook + tabulated-list-mode-hook)) + (lin-global-mode)) + +(use-package gcmh + :ensure t + :config + (setopt gcmh-idle-delay 'auto + gcmh-verbose nil) + (gcmh-mode)) + +(use-package tmr + :ensure t + :preface + (defun tmr-mode-line () + (if (seq-find (lambda (tmr) + (not (tmr--timer-finishedp tmr))) + tmr--timers) + (propertize "⏲" 'face 'font-lock-warning-face) + "")) + (add-to-list 'global-mode-string + '("" (:eval (tmr-mode-line))) + 'append)) + +;; (use-package elfeed +;; :ensure t +;; :preface +;; ;; https://karthinks.com/software/lazy-elfeed/ +;; (defun elfeed-scroll-up-command (&optional arg) +;; "Scroll up or go to next feed item in Elfeed" +;; (interactive "^P") +;; (let ((scroll-error-top-bottom nil)) +;; (condition-case-unless-debug nil +;; (scroll-up-command arg) +;; (error (elfeed-show-next))))) +;; (defun elfeed-scroll-down-command (&optional arg) +;; "Scroll up or go to next feed item in Elfeed" +;; (interactive "^P") +;; (let ((scroll-error-top-bottom nil)) +;; (condition-case-unless-debug nil +;; (scroll-down-command arg) +;; (error (elfeed-show-prev))))) +;; :bind (("C-c f" . elfeed)) +;; :config +;; (setopt elfeed-enclosure-default-dir "~/var/download/" +;; elfeed-db-directory (sync/ "emacs/elfeed/db" t) +;; elfeed-curl-max-connections 4) +;; (add-hook 'elfeed-search-update-hook #'truncate-lines-local-mode) +;; (keymap-set elfeed-show-mode-map "SPC" #'elfeed-scroll-up-command) +;; (keymap-set elfeed-show-mode-map "S-SPC" #'elfeed-scroll-down-command) +;; (keymap-set elfeed-search-mode-map "a" #'elfeed-search-untag-all-unread) +;; (setq elfeed-feeds nil) ; Always reload the feed list from feeds.opml +;; (elfeed-load-opml "~/var/feeds.opml")) + +(use-package iedit ; XXX: is this necessary? + :ensure t + :init + (customize-set-variable 'iedit-toggle-key-default (kbd "C-'"))) + +(use-package dumb-jump + :ensure t + :hook ((xref-backend-functions . dumb-jump-xref-activate))) + +(use-package le-thesaurus + :ensure t + :bind (("C-c w s" . le-thesaurus-get-synonyms) + ("C-c w a" . le-thesaurus-get-antonyms))) + +(use-package devdocs + :ensure t + ;; not sure what to bind anything to yet ... so M-x it is + ) + +(use-package comment-dwim-2 + :ensure t + :bind (("M-;" . comment-dwim-2) + :map org-mode-map + ("M-;" . org-comment-dwim-2))) diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el index 469ed15..0e0b9b1 100644 --- a/lisp/+link-hint.el +++ b/lisp/+link-hint.el @@ -87,33 +87,62 @@ with the KEYWORD." +link-hint-open-secondary-types :multiple t) -(defun +link-hint-open-secondary-setup (&optional types) - "Define the `:open-secondary' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t))) - -(defun +link-hint-open-secondary () - "Open a link in the secondary browser." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-secondary))) - -(defun +link-hint-open-chrome-setup (&optional types) - "Define the `:open-chrome' link-hint type for TYPES. -If TYPES is nil, define it for `+link-hint-open-secondary-types'." - (dolist (type (or types +link-hint-open-secondary-types)) - (link-hint-define-type type - :open-chrome #'browse-url-chrome - :open-chrome-multiple t))) - -(defun +link-hint-open-chrome () - "Open a link with chrome." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :open-chrome))) +(progn + (dolist + (type + '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link)) + (link-hint-define-type type :download + (function +browse-url-download) + :download-multiple t)) + (defun +link-hint-open:download nil "Download a link to `eww-download-directory'. + +Defined by `+link-hint-define'." + (interactive) + (avy-with link-hint-open-link + (link-hint--one :download))) + (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'. + +Defined by `+link-hint-define'." + (avy-with link-hint-open-multiple-links + (link-hint--multiple :download))) + (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'. + +Defined by `+link-hint-define'." + (avy-with link-hint-open-all-links + (link-hint--all :download)))) + +;; (defun +link-hint-open-secondary-setup (&optional types) +;; "Define the `:open-secondary' link-hint type for TYPES. +;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." +;; (dolist (type (or types +link-hint-open-secondary-types)) +;; (link-hint-define-type type +;; :open-secondary browse-url-secondary-browser-function +;; :open-secondary-multiple t))) + +;; (defun +link-hint-open-secondary () +;; "Open a link in the secondary browser." +;; (interactive) +;; (avy-with link-hint-open-link +;; (link-hint--one :open-secondary))) + +(+link-hint-define-keyword :chrome #'browse-url-chrome + "Open a link with `browse-url-chrome'." + +link-hint-open-secondary-types + :multiple t) + +;; (defun +link-hint-open-chrome-setup (&optional types) +;; "Define the `:open-chrome' link-hint type for TYPES. +;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." +;; (dolist (type (or types +link-hint-open-secondary-types)) +;; (link-hint-define-type type +;; :open-chrome #'browse-url-chrome +;; :open-chrome-multiple t))) + +;; (defun +link-hint-open-chrome () +;; "Open a link with chrome." +;; (interactive) +;; (avy-with link-hint-open-link +;; (link-hint--one :open-chrome))) (defun +link-hint-open-link (prefix) "Open a link. diff --git a/lisp/+scratch.el b/lisp/+scratch.el new file mode 100644 index 0000000..5d749c6 --- /dev/null +++ b/lisp/+scratch.el @@ -0,0 +1,75 @@ +;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Case Duckworth + +;; Author: Case Duckworth +;; Keywords: convenience + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d") + "Where to save scratch files." + :type 'file) + +(defcustom +scratch-max-age (* 60 60 24 365) + "Maximum age of a saved scratch buffer. Default: one year." + :type 'natnum) + +(defun +scratch@immortal () + "Don't kill *scratch* with `kill-buffer'." + (if (equal (buffer-name) "*scratch*") + (progn (bury-buffer) nil) + t)) + +(defun +scratch-save (time-format) + "Save *scratch* buffer to `+scratch-save-dir'. +TIME-FORMAT will be used to name the buffer." + (interactive (list "%FT%H%z")) + (with-current-buffer (get-scratch-buffer-create) + (let ((buffer-file-name (expand-file-name (format "%s.%s" + (format-time-string + time-format) + (pcase major-mode + ('org-mode "org") + ('emacs-lisp-mode "el") + (_ "txt"))) + +scratch-save-dir))) + (unless (string-equal (buffer-substring (point-min) (point-max)) + initial-scratch-message) + (save-buffer 0))))) + +(defun +scratch-save-on-exit () + (+scratch-save "%FT%T%z") + (+scratch-clean)) + +(defun +scratch-clean () + "Clean up saved scratches. +Scratch files older than `+scratch-max-age' will be removed." + (dolist (f (directory-files +scratch-save-dir)) + (when (and (not (equal f ".")) + (not (equal f "..")) + (> (time-convert (file-attribute-modification-time + (file-attributes f)) + 'integer) + +scratch-max-age)) + (delete-file (expand-file-name f +scratch-save-dir) :trash)))) + +(provide '+scratch) +;;; +scratch.el ends here diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el new file mode 100644 index 0000000..62dcf72 --- /dev/null +++ b/lisp/acdw-chat.el @@ -0,0 +1,174 @@ +;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*- + +;;; Code: + +(defcustom jabber-prefix-width 10 + "Width of jabber prompts and other prefixes." + :type 'number + :group 'jabber) + +(defun jabber-ui-setup () + "Setup the `jabber' user interface." + (visual-fill-column-mode) + (electric-pair-local-mode -1) + (auto-fill-mode -1) + (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20) + visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width) + . 1))) + +(defcustom jabber-biboumi-server "localhost" + "Biboumi server for `jabber-biboumi-muc-connect'." + :type 'string + :group 'jabber) + +(defcustom jabber-biboumi-irc-servers '("irc.libera.chat") + "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'." + :type '(repeat string) + :group 'jabber) + +(defcustom jabber-biboumi-default-nick "" + "Default nick for biboumi rooms." + :type 'string + :group 'jabber) + +(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server) + "Connect to a biboumi (IRC gateway) server MUC. +CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to +`jabber-muc-join'. If BIBOUMI-SERVER isn't given, +`jabber-biboumi-server' is used." + (interactive (list (concat "#" (string-remove-prefix "#" (read-string + "Channel: "))) + (completing-read "Server: " jabber-biboumi-irc-servers) + (read-string (format "Nick [%s]: " + jabber-biboumi-default-nick) + nil nil jabber-biboumi-default-nick))) + (let ((room (format "%s%%%s@%s" channel server (or biboumi-server + jabber-biboumi-server)))) + (if (assoc room *jabber-active-groupchats*) + (switch-to-buffer (jabber-muc-get-buffer room)) + (jabber-muc-join (jabber-read-account) + room + nick + 'popup)))) + +(defun jabber-group-yank-join-url () + "Yank a url for joining the focused group." + (interactive) + (let ((s (format "xmpp:%s?join" jabber-group))) + (kill-new s) + (message s))) + + +;;; Packages + +(use-package jabber + :load-path "~/src/emacs/jabber/" + :custom-face + (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign + :foreground unspecified + :weight normal))) + (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local + :foreground unspecified + :weight bold))) + (jabber-chat-prompt-local ((t :inherit minibuffer-prompt + :foreground unspecified + :weight normal + :slant italic))) + (jabber-chat-prompt-foreign ((t :inherit warning + :foreground unspecified + :weight normal))) + (jabber-chat-prompt-system ((t :inherit font-lock-doc-face + :foreground unspecified))) + (jabber-rare-time-face ((t :inherit font-lock-comment-face + :foreground unspecified + :underline nil))) + :bind-keymap ("C-c j" . jabber-global-keymap) + :bind (("C-c C-SPC" . jabber-activity-switch-to)) + :config + (setopt jabber-account-list '(("acdw@hmm.st")) + jabber-auto-reconnect t + jabber-biboumi-server "irc.hmm.st" + jabber-biboumi-irc-servers '("irc.libera.chat" + "irc.tilde.chat" + "tilde.town" + "m455.casa" + "irc.twitch.tv") + jabber-biboumi-default-nick "acdw" + jabber-last-read-marker (make-string fill-column ?.) + jabber-muc-decorate-presence-patterns + '(("\\( 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-rare-time-format " - - - - - - %H:%M %F" + jabber-muc-header-line-format + '(" " (:eval (replace-regexp-in-string "%" "%%" + (jabber-jid-displayname + jabber-group))) + " / " jabber-muc-topic) + ;; buffer name formats + jabber-chat-buffer-format "*xmpp* %n" + jabber-browse-buffer-format "*xmpp-browse* %n" + jabber-groupchat-buffer-format "*xmpp-muc* %n" + jabber-muc-private-buffer-format "*xmpp-muc-private* %n" + ;; "prompt" (speaker) formats + jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width) + jabber-muc-private-foreign-prompt-format "\n%g/%n . ") + ;; jabber muc nick coloring + ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus) + ;; (setopt jabber-muc-nick-value 1.0 + ;; jabber-muc-nick-saturation 1.0 + ;; jabber-muc-colorize-local t + ;; jabber-muc-colorize-foreign t) + ;; When changing the above values, make sure to + ;; (setq jabber-muc-participant-colors nil) + (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup) + (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix + ;; For each binding in `jabber-global-keymap', also bind the non-control + ;; character (lowercase) + (map-keymap (lambda (key command) + (define-key jabber-global-keymap (vector (+ key #x60)) command)) + jabber-global-keymap) + (require 'jabber-httpupload nil t) + (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) + (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) + (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) + (add-hook 'jabber-alert-muc-hooks + (defun jabber@highlight-acdw (&optional _ _ buf _ _) + (when buf + (with-current-buffer buf + (let ((regexp (rx word-boundary + "acdw" ; maybe get from the config? + word-boundary))) + (hi-lock-unface-buffer regexp) + (highlight-regexp regexp 'jabber-chat-prompt-local)))))) + (add-hook 'jabber-chat-mode-hook + (defun jabber-chat@leave-when-kill () + (add-hook 'kill-buffer-hook + (defun @jabber-leave@kill () + (ignore-errors + (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)) + (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 "M-."))) + +(provide 'acdw-chat) +;;; acdw-chat.el ends here diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el index 2a7d128..f8111e7 100644 --- a/lisp/acdw-mail.el +++ b/lisp/acdw-mail.el @@ -25,6 +25,10 @@ (defun +message-send-set-variables () "Set variables for `message-send' depending on the From: header. Useful in `message-send-hook'." + (unless +message-send-dispatch-rules + (load notmuch-init-file) + (or +message-send-dispatch-rules + (error "`+message-send-dispatch-rules' isn't set!"))) (let ((from (message-fetch-field "from"))) (cl-loop for (var . val) in (cl-loop for (address . bindings) in +message-send-dispatch-rules @@ -145,6 +149,112 @@ the saved search as well." ;;(user-error "Feature `async' not found!") (notmuch-poll))) +;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/ + +(defun email-says-attach-p () + "Return t if email suggests there could be an attachment." + (save-excursion + (goto-char (point-min)) + (re-search-forward "attach" nil t))) + +(defun email-has-attachment-p () + "Return t if the currently open email has an attachment." + (save-excursion + (goto-char (point-min)) + (re-search-forward "<#part" nil t))) + +(defun email-pre-send-check-attachment () + (when (and (email-says-attach-p) + (not (email-has-attachment-p))) + (unless + (y-or-n-p + "Your email suggests an attachment, but none was found. Send anyway?") + (error "No attachment. Aborting send.")))) + +;;; Process ical attachments + +(defun notmuch-save-ics () + "Save a .ics file in a message." + (interactive) + (with-current-notmuch-show-message + (notmuch-foreach-mime-part + (lambda (part) + (message "%S" part) + (when (and (listp part) + (or (equal "application/ics" (caadr part)) + ;; (equal "text/calendar" (caadr part)) + )) + (save-window-excursion + (let* ((filename "/tmp/notmuch.ics") + (buf (find-file-noselect filename))) + (delete-file filename) + (kill-buffer (get-file-buffer filename)) + (mm-save-part-to-file part filename) + (icalendar-import-file filename diary-file) + (kill-buffer buf))))) + (mm-dissect-buffer t t)))) + + +;;; Fixes + +;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net + +(defun notmuch--indent-rigidly (start end count) + (cond + ((zerop count) t) + ((< count 0) (indent-rigidly start end count)) + (t + (save-excursion + (let ((startpt (progn (goto-char start) (line-beginning-position))) + (endpt (progn (goto-char end) (line-end-position))) + (spaces (spaces-string count))) + (goto-char startpt) + (while + (progn + (insert spaces) + (cl-incf endpt count) + (and (zerop (forward-line 1)) (bolp) + (<= (point) endpt))))))))) + +(with-eval-after-load 'notmuch-show + ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way + ;; of doing this + (defun notmuch-show-lazy-part (part-args button) + ;; Insert the lazy part after the button for the part. We would just + ;; move to the start of the new line following the button and insert + ;; the part but that point might have text properties (eg colours + ;; from a message header etc) so instead we start from the last + ;; character of the button by adding a newline and finish by + ;; removing the extra newline from the end of the part. + (save-excursion + (goto-char (button-end button)) + (insert "\n") + (let* ((inhibit-read-only t) + ;; We need to use markers for the start and end of the part + ;; because the part insertion functions do not guarantee + ;; to leave point at the end of the part. + (part-beg (copy-marker (point) nil)) + (part-end (copy-marker (point) t)) + ;; We have to save the depth as we can't find the depth + ;; when narrowed. + (depth (notmuch-show-get-depth))) + (save-restriction + (narrow-to-region part-beg part-end) + (delete-region part-beg part-end) + (apply #'notmuch-show-insert-bodypart-internal part-args) + (notmuch--indent-rigidly part-beg + part-end + (* notmuch-show-indent-messages-width depth))) + (goto-char part-end) + (delete-char 1) + (notmuch-show-record-part-information (cadr part-args) + (button-start button) + part-end) + ;; Create the overlay. If the lazy-part turned out to be empty/not + ;; showable this returns nil. + (notmuch-show-create-part-overlays button part-beg part-end)))) + ) + ;;; Packages @@ -173,7 +283,6 @@ 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) @@ -196,6 +305,7 @@ the saved search as well." notmuch-saved-searches nil notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option ) + (load notmuch-init-file) ;; Key bindings (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) @@ -221,6 +331,7 @@ the saved search as well." (+notmuch-define-saved-search "all mail" "a" 'tree "*") ;; Hooks and advice (add-hook 'message-send-hook #'+message-send-set-variables) + (add-hook 'message-send-hook #'email-pre-send-check-attachment) (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) diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 566deed..f961dda 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -202,6 +202,16 @@ If LIST is non-nil, return the result as a list instead of a string." (unless (eq (char-after) ?:) ":")) (when (org-at-heading-p) (org-align-tags)))))) + +;;; Misc. + +(defun org-clock-in-or-out (prefix) + "If clocked in, clock out. Otherwise, clock in." + (interactive "P") + (if (org-clocking-p) + (org-clock-out prefix) + (org-clock-in prefix))) + ;;; Faces @@ -225,10 +235,12 @@ If LIST is non-nil, return the result as a list instead of a string." :custom-face (org-level-1 ((t :inherit fixed-pitch :weight bold - :height 1.2))) + :slant italic + :height 1.0))) (org-level-2 ((t :inherit fixed-pitch :weight bold - :height 1.1))) + :slant italic + :height 1.0))) (org-level-3 ((t :inherit fixed-pitch :weight bold :height 1.0))) @@ -299,17 +311,20 @@ If LIST is non-nil, return the result as a list instead of a string." (sequence "|" "CANCELED(k@)") (sequence "MEETING(m)")) org-use-fast-todo-selection 'auto - org-use-speed-commands t) + org-use-speed-commands t + org-element-use-cache nil) ;; Keys (keymap-set org-mode-map "C-M-k" #'kill-paragraph) (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) (keymap-set org-mode-map "RET" #'+org-return-dwim) (keymap-set org-mode-map "S-" #'+org-table-copy-down|+org-return-dwim) + (keymap-unset org-mode-map "C-'" t) + (keymap-unset org-mode-map "C-," t) ;; Hooks (add-hook 'org-mode-hook (defun org-mode@setup () (when (require 'visual-fill-column nil t) - (setq-local visual-fill-column-extra-text-width '(8 . 8)) + (setq-local visual-fill-column-extra-text-width '(2 . 2)) (visual-fill-column-mode)) (variable-pitch-mode) (turn-off-auto-fill) @@ -325,19 +340,17 @@ If LIST is non-nil, return the result as a list instead of a string." 'org-mode `(;; List markers => org-indent (,(concat - "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" - "\\(?:[ ]+\\|$\\)\\)" + "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" + "\\(?:[ ]+\\|$\\)\\)" "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]" - "[ ]*\\)?" + "[ ]*\\)?" "\\(?:\\(\\[[ X-]\\]\\)" - "\\(?:[ ]+\\|$\\)\\)?") + "\\(?:[ ]+\\|$\\)\\)?") 0 'org-indent)))) (use-package org-clock - :bind (("M-" . org-clock-out) - :map org-mode-map - ("" . org-clock-in) - ("" . org-clock-out)) + :bind (:map org-mode-map + ("" . org-clock-in-or-out)) :config (setopt org-clock-clocked-in-display 'mode-line global-mode-string @@ -355,13 +368,11 @@ If LIST is non-nil, return the result as a list instead of a string." org-agenda-skip-scheduled-if-done t org-agenda-span 10 org-agenda-block-separator ?─ - org-agenda-time-grid - '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string - "← now ─────────────────────────────────────────────────" - org-agenda-include-diary nil ; I use the org-diary features + org-agenda-time-grid '((daily today require-timed) + (800 1000 1200 1400 1600 1800 2000) + " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") + org-agenda-current-time-string "← now ───────────────" + org-agenda-include-diary t ; I use the org-diary features org-agenda-todo-ignore-deadlines 'near org-agenda-todo-ignore-scheduled 'future org-agenda-include-deadlines t @@ -371,7 +382,29 @@ If LIST is non-nil, return the result as a list instead of a string." org-agenda-skip-file-regexp "sync-conflict" org-agenda-inhibit-startup t org-agenda-sticky t - org-agenda-follow-indirect t) + org-agenda-follow-indirect t + org-stuck-projects '("TODO=\"WAIT\"" + ("TODO" "NEXT") + nil + "") + org-agenda-custom-commands + `(("c" "Click Here Digital To-do" + ((agenda "" ((org-agenda-overriding-header "Tasks") + (org-agenda-span 'fortnight) + (org-agenda-start-day "+0") + (org-agenda-skip-function + '(org-agenda-skip-subtree-if 'todo + '("WAIT" "MCKENZIE" "RACHEL"))))) + (stuck "" ((org-agenda-overriding-header "Waiting")))) + ((org-agenda-files ',(list (progn (require 'chd) + (chd/ "inbox-chd.org")))))))) + ;; Speedup agenda generation + ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html + ;; https://orgmode.org/worg/agenda-optimization.html + (setopt org-agenda-dim-blocked-tasks nil + org-agenda-inhibit-startup t + org-agenda-use-tag-inheritance nil + org-agenda-ignore-properties '(effort appt stats category)) ;; Hooks and advice (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) (add-hook 'org-agenda-mode-hook #'hl-line-mode) @@ -440,6 +473,7 @@ effect for exporting link types)." :custom-face (org-modern-label ((t :inherit fixed-pitch :height 1.0))) + :hook (org-mode-hook) :config (setopt org-modern-star nil org-modern-list '((43 . "◦") @@ -449,8 +483,7 @@ effect for exporting link types)." org-modern-hide-stars nil org-tags-column 0 org-modern-keyword nil - org-modern-table nil) - (global-org-modern-mode)) + org-modern-table nil)) (use-package org-taskwise :after org diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el index 36a5ba4..40e1a3d 100644 --- a/lisp/acdw-web.el +++ b/lisp/acdw-web.el @@ -114,6 +114,9 @@ regexp that will not be regexp-quoted when matching against a url." (list :tag "Regexp" regexp) (string :tag "Literal string")))) +(with-eval-after-load 'custom-allowed + (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) + (defun +browse-url-external-url-p (url) "Return t if URL is a member of `+browse-url-external-domains'. This function only tests URL's domain." @@ -125,6 +128,29 @@ This function only tests URL's domain." host) return t))) +(defun +browse-url-external-domain-add (domain &optional regexp?) + "Add DOMAIN to `+browse-url-external-domains'. +If REGEXP? is non-nil, it will note that the domain is a regexp. +This function will also save `custom-file' with the updated value." + (interactive (pcase current-prefix-arg + (`nil + (list (read-from-minibuffer "Domain: ") + nil)) + (`(4) + (list (read-from-minibuffer "Domain regex: ") + t)) + (_ + (list (read-from-minibuffer "Domain: ") + (y-or-n-p "Regex? "))))) + (let ((new (funcall (if regexp? #'list #'identity) + domain))) + (custom-set-variables + `(+browse-url-external-domains + ',(add-to-list '+browse-url-external-domains new))) + (with-current-buffer (find-file-noselect custom-file) + (custom-save-variables)) + (message "%s added to `+browse-url-external-domains'." + domain))) ;;; Downloading @@ -165,6 +191,34 @@ This function only tests URL's domain." ;;; Packages (use-package eww + :preface + (defun bookmark-eww--make () + "Make eww bookmark record." + `((filename . ,(plist-get eww-data :url)) + (title . ,(plist-get eww-data :title)) + (time . ,(current-time-string)) + (handler . ,#'bookmark-eww-handler) + (defaults . (,(concat + ;; url without the https and path + (replace-regexp-in-string + "/.*" "" + (replace-regexp-in-string + "\\`https?://" "" + (plist-get eww-data :url))) + " - " + ;; page title + (replace-regexp-in-string + "\\` +\\| +\\'" "" + (replace-regexp-in-string + "[\n\t\r ]+" " " + (plist-get eww-data :title)))))))) + (defun bookmark-eww-handler (bm) + "Handler for eww bookmarks." + (eww-browse-url (alist-get 'filename bm))) + (defun bookmark-eww--setup () + "Setup eww bookmark integration." + (setq-local bookmark-make-record-function #'bookmark-eww--make)) + :commands (eww eww-browse-url) :config (setopt eww-use-browse-url ".") (add-hook 'eww-mode-hook @@ -181,7 +235,12 @@ This function only tests URL's domain." browse-url-secondary-browser-function (or url (plist-get eww-data :url))) (:success (when (null url) (quit-window))) ; Interactive use - (t (signal (car e) (cdr e))))))) + (t (signal (car e) (cdr e)))))) + (add-hook 'eww-mode-hook #'bookmark-eww--setup) + (define-key eww-mode-map "b" #'bookmark-set) + (define-key eww-mode-map "B" #'bookmark-jump) + (define-key eww-mode-map (kbd "M-n") nil) + (define-key eww-mode-map (kbd "M-p") nil)) (use-package browse-url :demand t @@ -204,7 +263,8 @@ This function only tests URL's domain." . +browse-url-with-mpv) ;; Images (,(+browse-url-matches "pbs\\.twimg\\.com" - (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") + (rx "." (or "jpeg" "jpg" "png" "pn" + "bmp" "webp") eos)) . +browse-url-with-mpv-image) ;; Blobs @@ -214,16 +274,18 @@ This function only tests URL's domain." (+browse-url-external-url-p . ,browse-url-secondary-browser-function)) ;; External domains - +browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" - "tildegit.org" "git.tilde.town" - "google.com" "imgur.com" "twitch.tv" - "pixelfed" "instagram.com" - "bibliogram.art" "reddit.com" - "teddit.net" "libreddit.de" - "streamable.com" "spotify.com" - "hetzner.cloud" "melpa.org" - "twitter.com" ("^t\\.co$") - "nitter.snopyta.org" "nitter.net")) + ;; +browse-url-external-domains + ;; '("github.com" "gitlab.com" "codeberg.org" + ;; "tildegit.org" "git.tilde.town" + ;; "google.com" "imgur.com" "twitch.tv" + ;; "pixelfed" "instagram.com" + ;; "bibliogram.art" "reddit.com" + ;; "teddit.net" "libreddit.de" + ;; "streamable.com" "spotify.com" + ;; "hetzner.cloud" "melpa.org" + ;; "twitter.com" ("^t\\.co$") + ;; "nitter.snopyta.org" "nitter.net") + ) ;; External browsers: firefox > chromium > chrome (when-let ((firefox (choose-executable "firefox" "firefox-esr"))) @@ -268,14 +330,16 @@ This function only tests URL's domain." :bind (("M-l M-l" . +link-hint-open-link) ("M-l l" . +link-hint-open-link) - ("M-l M-o" . +link-hint-open-secondary) - ("M-l o" . +link-hint-open-secondary) + ("M-l M-o" . +link-hint-open:secondary) + ("M-l o" . +link-hint-open:secondary) ("M-l M-m" . +link-hint-open-multiple-links) ("M-l m" . +link-hint-open-multiple-links) ("M-l M-w" . link-hint-copy-link) ("M-l w" . link-hint-copy-link) - ("M-l M-c" . +link-hint-open-chrome) - ("M-l c" . +link-hint-open-chrome)) + ("M-l M-c" . +link-hint-open:chrome) + ("M-l c" . +link-hint-open:chrome) + ("M-l M-d" . +link-hint-open:download) + ("M-l d" . +link-hint-open:download)) :config (require '+link-hint) (setopt link-hint-avy-style 'at-full @@ -286,8 +350,9 @@ This function only tests URL's domain." ;; another package's configuration, but I don't care enough to fix it. (setq link-hint-types (delq 'link-hint-completion-list-candidate link-hint-types)) - (+link-hint-open-secondary-setup) - (+link-hint-open-chrome-setup)) + ;; (+link-hint-open-secondary-setup) + ;; (+link-hint-open-chrome-setup) + ) (provide 'acdw-web) ;;; acdw-web.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 46079f6..63291d3 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -184,7 +184,9 @@ prefix ARG is non-nil; then it just saves them." (user-error "Buffer not attached to file")) (hack-dir-local-variables) (let ((print-level nil) - (print-length nil)) + (print-length nil) + (before-save-hook nil) + (after-save-hook nil)) (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA ; where this came from @@ -330,5 +332,46 @@ include the time. When called with \\[universal-argument] (fill-paragraph-function nil)) (fill-paragraph))) +(defun fill-with-double-spaced-sentences-dwim (&optional start end) + "Fill paragraph or region, double-spacing sentences." + (interactive) + (let ((sentence-end-double-space t)) + (unless (region-active-p) + (mark-paragraph)) + (repunctuate-sentences :no-query + (region-beginning) + (region-end)) + (fill-region (region-beginning) + (region-end)))) + +(defun fill-with-double-spaced-sentences-dwim (&optional start end) + "Fill from START to END, double-spacing sentences. +If START to END aren't given, or if a region isn't in use, fill +the current paragraph." + (interactive "*r") + (let ((sentence-end-double-space t)) + (save-mark-and-excursion + (save-restriction + (unless (region-active-p) + (setq start (progn (start-of-paragraph-text) + (point)) + end (progn (end-of-paragraph-text) + (point)))) + (narrow-to-region start end) + (goto-char (point-min)) + (repunctuate-sentences :no-query) + (fill-region (point-min) + (point-max)))))) + +(defun acdw-elisp-package-prepare (&optional file) + "Do all the elisp-package-preparing stuff on FILE. +If FILE is nil or not given, do it on the current buffer." + (with-current-buffer (if file (find-file-noselect file) (current-buffer)) + (check-parens) + (checkdoc) + (package-lint-buffer) + ;; TODO: use `lm-commentary' to write to README.org + )) + (provide 'acdw) ;;; acdw.el ends here diff --git a/lisp/ical2org.el b/lisp/ical2org.el new file mode 100644 index 0000000..2716787 --- /dev/null +++ b/lisp/ical2org.el @@ -0,0 +1,56 @@ +;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*- + +;;; Commentary: + +;; based on code from this reddit thread: +;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/ +;; +;; see also: icalendar.org (converts to diary format, might be all I need) +;; +;; XXX: This code currently imports into gnus, which isn't what I want. + +;;; Code: + +(defun ical2org (&optional replace output-buffer) + "Run ical2org on contents of this buffer. +If REPLACE (interactive prefix argument), replace contents of the +buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to +minibuffer." + (interactive "P") + (shell-command-on-region (point-min) (point-max) + "ical2org" + output-buffer + replace + "*ical2org errors*" + 'display-errors)) + +(defun ical2org-capture () + "Run `ical2org' on this buffer, then `org-capture' the result. +Leaves current buffer as-was afterwards." + (interactive) + (let ((buf (current-buffer)) + (ics (buffer-string))) + (ical2org 'replace) + (mark-whole-buffer) + (call-interactively #'org-capture) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (insert ics)))) + +(defun my-gnus-org-capture-icalendar () + "Capture any text/calendar invites with org." + (interactive) + (with-current-buffer gnus-article-buffer ;;; XXX + (save-excursion + (dolist (part gnus-article-mime-handle-alist) + (when (and (>= (length part) 3) + (listp (caddr part)) + (or (equal "application/ics" (caaddr part)) + (equal "text/calendar" (caaddr part)))) + (save-window-excursion + (gnus-mime-copy-part (cdr part)) + (ical2org-capture))))))) +(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar) + +(provide 'ical2org) +;;; ical2org.el ends here diff --git a/places b/places new file mode 100644 index 0000000..f53c6e7 --- /dev/null +++ b/places @@ -0,0 +1,2 @@ +;;; -*- coding: utf-8; mode: lisp-data -*- +(("/home/case/etc/emacs/init.el" . 35321)) diff --git a/recentf b/recentf new file mode 100644 index 0000000..0df1f93 --- /dev/null +++ b/recentf @@ -0,0 +1,17 @@ +;;; Automatically generated by ‘recentf’ on Mon Mar 20 17:05:48 2023. + +(setq recentf-list + '( + "~/sync/Click Here Digital/inbox-chd.org" + "~/sync/Click Here Digital/chd-clients.json" + "~/sync/Click Here Digital/chd-employees.json" + "~/sync/Click Here Digital/all-tasks.json" + "~/etc/emacs/init.el" + )) + +(setq recentf-filter-changer-current 'nil) + + +;; Local Variables: +;; coding: utf-8-emacs +;; End: -- cgit 1.4.1-21-gabe81