From 88ce9336138822d41b9b03a642bb92be4f54d987 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 Jul 2024 21:17:26 -0500 Subject: Updates! --- emacs.d/early-init.el | 539 ++++++++++++++++++++++++++------------------------ 1 file changed, 276 insertions(+), 263 deletions(-) (limited to 'emacs.d/early-init.el') diff --git a/emacs.d/early-init.el b/emacs.d/early-init.el index bbf9464..1a5d9a5 100644 --- a/emacs.d/early-init.el +++ b/emacs.d/early-init.el @@ -1,40 +1,103 @@ ;;; ~/.emacs.d/early-init.el -*- lexical-binding: t; -*- ;; Author: Case Duckworth +;; In this file there are custom functions and macros and early-init settings, +;; all alphabetically ordered. -(setopt frame-inhibit-implied-resize t) -(setopt frame-resize-pixelwise t) -(setopt window-resize-pixelwise t) -(setopt default-frame-alist - '((menu-bar-lines . 0) - (tool-bar-lines . 0) - ;;(vertical-scroll-bars) - (horizontal-scroll-bars))) +;; There is a bug in M-x finger +(define-advice finger (:override (user host) acdw-fix) + "Finger USER on HOST. +This command uses `finger-X.500-host-regexps' +and `network-connection-service-alist', which see." + ;; One of those great interactive statements that's actually + ;; longer than the function call! The idea is that if the user + ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the + ;; host name. If we don't see an "@", we'll prompt for the host. + (interactive + (let* ((answer (let ((default (ffap-url-at-point))) + (read-string (format-prompt "Finger User" default) + nil nil default))) + (index (string-match (regexp-quote "@") answer))) + (if index + (list (substring answer 0 index) + (substring answer (1+ index))) + (list answer + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "At Host" default) + nil nil default)))))) + (let* ((user-and-host (concat user "@" host)) + (process-name (concat "Finger [" user-and-host "]")) + (regexps finger-X.500-host-regexps) + ) ;; found + (and regexps + (while (not (string-match (car regexps) host)) + (setq regexps (cdr regexps)))) + (when regexps + (setq user-and-host user)) + (run-network-program + process-name + host + (cdr (assoc 'finger network-connection-service-alist)) + user-and-host))) -(when (getenv "IN_EXWM") - (add-to-list 'default-frame-alist '(fullscreen . fullboth))) +(defmacro after (event &rest body) + "Do BODY after EVENT, which can be: +- A feature +- A hook -- if it requires arguments they'll be in the list `args' +- The symbol 'init, which runs on after-init-hook" + (declare (indent 1)) + (let ((lambda-form `(lambda (&rest args) ,@body))) + (pcase event + (`(timer ,ev) `(run-with-timer ,ev nil ,lambda-form)) + (`(idle ,ev) `(run-with-idle-timer ,ev nil ,lambda-form)) + (`(hook ,ev) `(add-hook ',ev ,lambda-form)) + (`init `(after (hook after-init-hook) ,@body)) + ((pred numberp) `(after (timer ,event) ,@body)) + ((pred (lambda (ev) + (and (symbolp ev) + (or (string-suffix-p "-hook" (symbol-name ev)) + (string-suffix-p "-function" (symbol-name ev)) + (string-suffix-p "-functions" (symbol-name ev)))))) + `(after (hook ,event) ,@body)) + ((pred symbolp) `(with-eval-after-load ',event ,@body)) -(defvar *fonts* - (let ((fixed "Recursive Mono Casual Static") - (variable "Recursive Sans Casual Static")) - `((default - :family ,variable - :height 100) - (variable-pitch - :family ,variable) - (fixed-pitch - :family ,fixed) - (fixed-pitch-serif - :family "Recursive Mono Linear Static")))) - -(require 'package) -(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/")) -(package-initialize) - -;;; Custom functions + (_ (error "Can't determine event type" event))))) -(defun pulse@eval (start end &rest _) - "ADVICE: makes `pulse-momentary-highlight-region' accept other arities." - (pulse-momentary-highlight-region start end)) +(defmacro find-user-file (name &optional file-name) + "Template macro to generate user file finding functions." + (declare (indent 1)) + (let ((file-name (or file-name (intern (format "user-%s-file" name)))) + (func-name (intern (format "find-user-%s-file" name)))) + `(defun ,func-name (&optional arg) + ,(format "Edit `%s' in the current window. +With ARG, edit in the other window." file-name) + (interactive "P") + (funcall (if arg #'find-file-other-window #'find-file) + ,file-name)))) + +(defmacro inhibit-messages (&rest body) + "Inhibit all messages in BODY." + (declare (indent defun)) + `(cl-letf (((symbol-function 'message) #'ignore)) + ,@body)) + +;; This needs to be a macro to take advantage of setf magic +(defmacro setf/alist (alist key val &optional testfn) + `(setf (alist-get ,key ,alist nil nil (or ,testfn #'equal)) + ,val)) + +(defun ^local-hook (hook fn) + "Hook FN to HOOK locally in a lambda. +Good for adding to an add-hook." + (lambda () (add-hook hook fn t))) + +(defun ^local-unhook (hook fn) + "Remove FN from HOOK locally." + (lambda () (remove-hook hook fn t))) + +(defun ^turn-off (mode) + "Higher-order function: returns a lambda to turn off MODE." + (lambda () + (funcall mode -1))) (defun create-missing-directories () "Automatically create missing directories." @@ -42,6 +105,20 @@ (unless (file-exists-p target-dir) (make-directory target-dir :parents)))) +(defun custom-show-all-widgets () + "toggle all \"More/Hide\" widgets in the current buffer." + ;; From unpackaged + (interactive) + (widget-map-buttons (lambda (widget _) + (pcase (widget-get widget :off) + ("More" (widget-apply-action widget))) + nil))) + +(defun cycle-spacing* (&optional n) + "Negate N argument on `cycle-spacing'." + (interactive "*p") + (cycle-spacing (- n))) + (defun delete-trailing-whitespace-except-current-line () "Delete all trailing whitespace except current line." (save-excursion @@ -50,6 +127,14 @@ (delete-trailing-whitespace (line-end-position) (point-max)))) +(defun delete-window-dwim () + "Delete the current window or bury its buffer. +If the current window is alone in its frame, bury the buffer +instead." + (interactive) + (unless (ignore-errors (delete-window) t) + (bury-buffer))) + (defun first-found-font (&rest cands) "Return the first font of CANDS that is installed, or nil." (cl-loop with ffl = (font-family-list) @@ -57,56 +142,29 @@ if (member font ffl) return font)) -(defun setup-faces () - "Setup Emacs faces." - ;; Default faces - (cl-loop for (face . spec) in *fonts* - do (set-face-attribute face nil - :family (plist-get spec :family) - :height (or (plist-get spec :height) - 'unspecified))) - ;; Specialized fonts - (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") - ;; emojis - (symbol . "Noto Emoji") - (symbol . "Noto Color Emoji") - (symbol . "Segoe UI Emoji") - (symbol . "Apple Color Emoji") - (symbol . "FreeSans") - (symbol . "FreeMono") - (symbol . "FreeSerif") - (symbol . "Unifont") - (symbol . "Symbola")) - if (member font ffl) - do (set-fontset-font t charset font))) +(defun fixup-whitespace () + "Indent the current buffer and (un)`tabify'. +Whether it tabifies or untabifies depends on `space-indent-modes'." + (interactive) + (save-mark-and-excursion + (indent-region (point-min) (point-max)) + (if indent-tabs-mode + (tabify (point-min) (point-max)) + (untabify (point-min) (point-max))) + (replace-regexp-in-region " $" "" (point-min) (point-max)))) -(defmacro inhibit-messages (&rest body) - "Inhibit all messages in BODY." - (declare (indent defun)) - `(cl-letf (((symbol-function 'message) #'ignore)) - ,@body)) +(defun hide-minor-mode (mode &optional hook) + "Hide MODE from the mode-line. +HOOK is used to trigger the action, and defaults to MODE-hook." + (setf (alist-get mode minor-mode-alist) (list "")) + (add-hook (intern (or hook (format "%s-hook" mode))) + (lambda () (hide-minor-mode mode)))) + +(defun keyboard-quit* (arg) + (interactive "P") + (if arg + (quit-minibuffer) + (keyboard-quit))) (defun kill-buffer-dwim (&optional buffer-or-name) "Kill BUFFER-OR-NAME or the current buffer." @@ -119,6 +177,30 @@ (:else (kill-buffer (read-buffer "Kill: " nil :require-match))))) +(defun minibuffer-delete-directory (&optional n) + "Delete the last directory in a file-completing minibuffer." + ;; Cribbed from `vertico-directory-up' (github.com/minad/vertico) + (interactive "p") + (let ((here (point)) + (meta (completion-metadata + "" minibuffer-completion-table + minibuffer-completion-predicate))) + (when (and (> (point) (minibuffer-prompt-end)) + (eq 'file (completion-metadata-get meta 'category))) + (let ((path (buffer-substring-no-properties (minibuffer-prompt-end) + (point))) + found) + (when (string-match-p "\\`~[^/]*/\\'" path) + (delete-minibuffer-contents) + (insert (expand-file-name path))) + (dotimes (_ (or n 1) found) + (save-excursion + (let ((end (point))) + (goto-char (1- end)) + (when (search-backward "/" (minibuffer-prompt-end) t) + (delete-region (1+ (point)) end) + (setq found t))))))))) + (defun other-window-dwim (&optional arg) "Switch to another window/buffer. Calls `other-window', which see, unless @@ -130,42 +212,6 @@ In these cases, switch to the last-used buffer." (switch-to-buffer (other-buffer) nil t) (other-window 1))) -(defun delete-window-dwim () - "Delete the current window or bury its buffer. -If the current window is alone in its frame, bury the buffer -instead." - (interactive) - (unless (ignore-errors (delete-window) t) - (bury-buffer))) - -(defun cycle-spacing* (&optional n) - "Negate N argument on `cycle-spacing'." - (interactive "*p") - (cycle-spacing (- n))) - -(defmacro find-user-file (name &optional file-name) - "Template macro to generate user file finding functions." - (declare (indent 1)) - (let ((file-name (or file-name (intern (format "user-%s-file" name)))) - (func-name (intern (format "find-user-%s-file" name)))) - `(defun ,func-name (&optional arg) - ,(format "Edit `%s' in the current window. -With ARG, edit in the other window." file-name) - (interactive "P") - (funcall (if arg #'find-file-other-window #'find-file) - ,file-name)))) - -(defun fixup-whitespace () - "Indent the current buffer and (un)`tabify'. -Whether it tabifies or untabifies depends on `space-indent-modes'." - (interactive) - (save-mark-and-excursion - (indent-region (point-min) (point-max)) - (if indent-tabs-mode - (tabify (point-min) (point-max)) - (untabify (point-min) (point-max))) - (replace-regexp-in-region " $" "" (point-min) (point-max)))) - (defun package-ensure (pkgspec &optional require) "Install PKG if it's not already installed. REQUIRE means require it after ensuring it's installed." @@ -190,83 +236,6 @@ REQUIRE means require it after ensuring it's installed." (package-vc-install pkgspec)) (when require (require pkg)))) -(defun minibuffer-delete-directory () - "Delete the last directory in a file-completing minibuffer." - (interactive) - (let ((here (point)) - (meta (completion-metadata - "" minibuffer-completion-table - minibuffer-completion-predicate))) - (if (eq (completion-metadata-get meta 'category) 'file) - (when (search-backward "/" (minibuffer-prompt-end) t) - (delete-region (point) here)) - (backward-kill-word 1)))) - -(defun save-buffers-kill* (arg) - "Save all the buffers and kill ... something. -If ARG is 1 (called normally), kill the current terminal. -If ARG is 4 (with C-u), kill emacs but ask if there are processes running. -If ARG is 16, kill emacs without asking about processes." - (interactive "p") - (pcase arg - (1 (save-buffers-kill-terminal)) - (4 (save-buffers-kill-emacs t)) - (16 (let ((confirm-kill-processes nil) - (kill-emacs-query-functions nil) - (confirm-kill-emacs nil)) - (save-buffers-kill-emacs t))))) - -(defun regexp-concat (&rest regexps) - (string-join regexps "\\|")) - -;; There is a bug in M-x finger -(defun acdw/finger (user host) - "Finger USER on HOST. -This command uses `finger-X.500-host-regexps' -and `network-connection-service-alist', which see." - ;; One of those great interactive statements that's actually - ;; longer than the function call! The idea is that if the user - ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the - ;; host name. If we don't see an "@", we'll prompt for the host. - (interactive - (let* ((answer (let ((default (ffap-url-at-point))) - (read-string (format-prompt "Finger User" default) nil nil default))) - (index (string-match (regexp-quote "@") answer))) - (if index - (list (substring answer 0 index) - (substring answer (1+ index))) - (list answer - (let ((default (ffap-machine-at-point))) - (read-string (format-prompt "At Host" default) nil nil default)))))) - (let* ((user-and-host (concat user "@" host)) - (process-name (concat "Finger [" user-and-host "]")) - (regexps finger-X.500-host-regexps) - ) ;; found - (and regexps - (while (not (string-match (car regexps) host)) - (setq regexps (cdr regexps)))) - (when regexps - (setq user-and-host user)) - (run-network-program - process-name - host - (cdr (assoc 'finger network-connection-service-alist)) - user-and-host))) - -(advice-add 'finger :override #'acdw-finger) - -(defun hide-minor-mode (mode &optional hook) - "Hide MODE from the mode-line. -HOOK is used to trigger the action, and defaults to MODE-hook." - (setf (alist-get mode minor-mode-alist) (list "")) - (add-hook (intern (or hook (format "%s-hook" mode))) - (lambda () (hide-minor-mode mode)))) - -(defun switch-to-other-buffer () - "Switch to the `other-buffer'." - (interactive) - (switch-to-buffer nil)) - (defun popup-eshell (arg) "Popup an eshell buffer in the current window." (interactive "P") @@ -280,34 +249,76 @@ HOOK is used to trigger the action, and defaults to MODE-hook." (insert "# ")) (eshell-send-input)))) -(defun vc-jump (arg) - "Jump to the current project's VC buffer. -With ARG, prompt for the directory." - (interactive "P") - (if arg - (let ((current-prefix-arg nil)) - (call-interactively #'vc-dir)) - (project-vc-dir))) - -(defun custom-show-all-widgets () - "toggle all \"More/Hide\" widgets in the current buffer." - ;; From unpackaged - (interactive) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("More" (widget-apply-action widget))) - nil))) +(defun pulse@eval (start end &rest _) + "ADVICE: makes `pulse-momentary-highlight-region' accept other arities." + (pulse-momentary-highlight-region start end)) (defun quit-minibuffer () (interactive) (switch-to-minibuffer) (minibuffer-keyboard-quit)) -(defun keyboard-quit* (arg) - (interactive "P") - (if arg - (quit-minibuffer) - (keyboard-quit))) +(defun regexp-concat (&rest regexps) + (string-join regexps "\\|")) + +(defun save-buffers-kill* (arg) + "Save all the buffers and kill ... something. +If ARG is 1 (called normally), kill the current terminal. +If ARG is 4 (with C-u), kill emacs but ask if there are processes running. +If ARG is 16, kill emacs without asking about processes." + (interactive "p") + (pcase arg + (1 (save-buffers-kill-terminal)) + (4 (save-buffers-kill-emacs t)) + (16 (let ((confirm-kill-processes nil) + (kill-emacs-query-functions nil) + (confirm-kill-emacs nil)) + (save-buffers-kill-emacs t))))) + +(defun setup-faces () + "Setup Emacs faces." + ;; Default faces + (cl-loop for (face . spec) in *fonts* + do (set-face-attribute face nil + :family (plist-get spec :family) + :height (or (plist-get spec :height) + 'unspecified))) + ;; Specialized fonts + (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") + ;; emojis + (symbol . "Noto Emoji") + ;; (symbol . "Noto Color Emoji") + (symbol . "Segoe UI Emoji") + (symbol . "Apple Color Emoji") + (symbol . "FreeSans") + (symbol . "FreeMono") + (symbol . "FreeSerif") + (symbol . "Unifont") + (symbol . "Symbola")) + if (member font ffl) + do (set-fontset-font t charset font))) (defun sort-sexps (beg end) "Sort sexps in region. @@ -357,34 +368,10 @@ Comments stay with the code below." (insert-before-markers real) (delete-region (point) (marker-position end))))))))) -(defun ^turn-off (mode) - "Higher-order function: returns a lambda to turn off MODE." - (lambda () - (funcall mode -1))) - -(defun ^local-hook (hook fn) - "Hook FN to HOOK locally in a lambda. -Good for adding to an add-hook." - (lambda () (add-hook hook fn t))) - -(defun ^local-unhook (hook fn) - "Remove FN from HOOK locally." - (lambda () (remove-hook hook fn t))) - -;; This needs to be a macro to take advantage of setf magic -(defmacro setf/alist (alist key val &optional testfn) - `(setf (alist-get ,key ,alist nil nil (or ,testfn #'equal)) - ,val)) - -(defun unfill-region (beg end) - (interactive "*r") - (let ((fill-column most-positive-fixnum)) - (fill-region beg end))) - -(defun unfill-paragraph () +(defun switch-to-other-buffer () + "Switch to the `other-buffer'." (interactive) - (let ((fill-column most-positive-fixnum)) - (fill-paragraph beg end))) + (switch-to-buffer nil)) (defun unfill-buffer () (interactive) @@ -396,25 +383,51 @@ Good for adding to an add-hook." (unfill-buffer) (visual-line-mode t))) -(defmacro after (event &rest body) - "Do BODY after EVENT, which can be: -- A feature -- A hook -- if it requires arguments they'll be in the list `args' -- The symbol 'init, which runs on after-init-hook" - (declare (indent 1)) - (let ((lambda-form `(lambda (&rest args) ,@body))) - (pcase event - (`(timer ,ev) `(run-with-timer ,ev nil ,lambda-form)) - (`(idle ,ev) `(run-with-idle-timer ,ev nil ,lambda-form)) - (`(hook ,ev) `(add-hook ',ev ,lambda-form)) - (`init `(after (hook after-init-hook) ,@body)) - ((pred numberp) `(after (timer ,event) ,@body)) - ((pred (lambda (ev) - (and (symbolp ev) - (or (string-suffix-p "-hook" (symbol-name ev)) - (string-suffix-p "-function" (symbol-name ev)) - (string-suffix-p "-functions" (symbol-name ev)))))) - `(after (hook ,event) ,@body)) - ((pred symbolp) `(with-eval-after-load ',event ,@body)) +(defun unfill-paragraph () + (interactive) + (let ((fill-column most-positive-fixnum)) + (fill-paragraph beg end))) - (_ (error "Can't determine event type" event))))) +(defun unfill-region (beg end) + (interactive "*r") + (let ((fill-column most-positive-fixnum)) + (fill-region beg end))) + +(defun vc-jump (arg) + "Jump to the current project's VC buffer. +With ARG, prompt for the directory." + (interactive "P") + (if arg + (let ((current-prefix-arg nil)) + (call-interactively #'vc-dir)) + (project-vc-dir))) + +(progn (defvar *fonts* + (let ((fixed "Recursive Mono Casual Static") + (variable "Recursive Sans Linear Static")) + `((default + :family ,variable + :height 100) + (variable-pitch :family ,variable) + (fixed-pitch :family ,fixed) + (fixed-pitch-serif :family ,fixed) + (font-lock-string-face :family "Recursive Mono Linear Static")))) + ;; (setup-faces) + ) + +(setopt default-frame-alist + '((menu-bar-lines . 0) + (tool-bar-lines . 0) + ;;(vertical-scroll-bars) + (horizontal-scroll-bars))) + +(setopt frame-inhibit-implied-resize t) +(setopt frame-resize-pixelwise t) +(setopt window-resize-pixelwise t) + +(when (getenv "IN_EXWM") + (add-to-list 'default-frame-alist '(fullscreen . fullboth))) + +(when (require 'package) + (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/")) + (package-initialize)) -- cgit 1.4.1-21-gabe81