From 13622da22705d0b41dd9743e7733bd1e1f1435f1 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 22 May 2023 14:33:04 -0500 Subject: Make changes and stuff - Add inhibit-messages macro - Add delete-window-or-bury-buffer - Move stuff around - Add comments - Add persist-settings-mode - Random other shit --- emacs.el | 285 +++++++++++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 216 insertions(+), 69 deletions(-) diff --git a/emacs.el b/emacs.el index e9e658c..6a2e13b 100644 --- a/emacs.el +++ b/emacs.el @@ -22,24 +22,50 @@ ;;; Definitions: -(defmacro autoload-keymap (keymap library &optional parent-keymap) - "Require LIBRARY to load KEYMAP-SYMBOL, then press the buttons again. -This rips off `use-package-autoload-keymap' basically." - `(defun ,(intern (format "autoload-keymap-" keymap)) () - (interactive) - (unless (featurep ',library) - (require ',(cond - ((symbolp library) - library) - ((stringp library) - (intern library)) - (t (user-error "LIBRARY should be a symbol or string: %s" - library)))) - (let ((kv (this-command-keys-vector))) - (define-key ,(or parent-keymap (current-global-map)) kv ,keymap) - (setq unread-command-events - (mapcar (lambda (ev) (cons t ev)) - (listify-key-sequence kv))))))) +(defmacro inhibit-messages (&rest body) + "Inhibit all messages in BODY." + (declare (indent defun)) + `(cl-letf (((symbol-function 'message) #'ignore)) + ,@body)) + +(defmacro comment (message &rest _ignore) + "Comment out lisp forms. +MESSAGE is for documentation purposes." + (declare (indent defun)) + t) + +(defmacro uncomment (message &rest body) + "Uncomment a commented form." + (declare (indent defun)) + `(progn ,@body)) + +(comment + (defun autoload-keymap (keymap library &optional parent-keymap) + "Require LIBRARY to load KEYMAP-SYMBOL, then press the buttons again. +If PARENT-KEYMAP is given, map KEYMAP within it; otherwise, use +`current-global-map'. This rips off `use-package-autoload-keymap' +basically." + (lambda () (interactive) + (unless (featurep library) + (require (cond ((symbolp library) library) + ((stringp library) (intern library)) + (t (user-error "LIBRARY should be a symbol or string: %s" + library))))) + (let ((kv (this-command-keys-vector))) + (define-key (or parent-keymap (current-global-map)) + kv + (symbol-value keymap)) + (setq unread-command-events + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence kv))))))) + +(defun autoload-keymap (keymap-symbol package) + (require package) + (let ((kv (this-command-keys-vector))) + (global-set-key kv (symbol-value keymap-symbol)) + (setq unread-command-events + (mapcar (lambda (ev) (cons t ev)) + (listify-key-sequence kv))))) (defun renz/sort-by-alpha-length (elems) "Sort ELEMS first alphabetically, then by length." @@ -166,6 +192,14 @@ run with \\[universal-argument], unconditionally switch buffer." (switch-to-buffer (other-buffer) nil t) (other-window 1))) +(defun delete-window-or-bury-buffer () + "Delete the current window or bury its buffer. +If the current window is the only window in the frame, bury its +buffer instead." + (interactive) + (unless (ignore-errors (delete-window) t) + (bury-buffer))) + (defun cycle-spacing@ (&optional n) ;; `cycle-spacing' is wildly different in 29.1 over 28. "Negate N argument on `cycle-spacing'. @@ -309,17 +343,6 @@ With prefix ARG, toggle the value of (put 'browse-url-browser-function 'safe-local-variable 'browse-url-browser-function-safe-p) -(defmacro comment (message &rest _ignore) - "Comment out lisp forms. -MESSAGE is for documentation purposes." - (declare (indent 1)) - t) - -(defmacro uncomment (message &rest body) - "Uncomment a commented form." - (declare (indent 1)) - `(progn ,@body)) - ;;; Packages: @@ -359,9 +382,6 @@ If REQUIRE is a non-nil value, require the package after adding it." (ensure-package 'marginalia nil t) (ensure-package 'visual-fill-column) (ensure-package 'adaptive-wrap) -(ensure-package 'geiser) -(when (executable-find "csi") - (ensure-package 'geiser-chicken)) (ensure-package 'avy) (ensure-package 'zzz-to-char) (ensure-package 'hungry-delete) @@ -373,17 +393,11 @@ If REQUIRE is a non-nil value, require the package after adding it." ;; Local packages (ensure-package 'scule t) (ensure-package 'frowny t) -(ensure-package 'hippie-completing-read t) (ensure-package 'mode-line-bell t) (ensure-package 'titlecase t) -(ensure-package 'jabber t) ;;; Jabber - -(ensure-package 'jabber t) -(add-to-list 'load-path - (expand-file-name "jabber-fallback-lib" - "~/src/jabber.el/")) +(ensure-package 'jabber t t) (setopt jabber-chat-buffer-format "*%n*") (setopt jabber-browse-buffer-format "*%n*") @@ -433,6 +447,15 @@ If REQUIRE is a non-nil value, require the package after adding it." (setopt jabber-chat-foreign-prompt-format "%n. ") (setopt jabber-muc-private-foreign-prompt-format "%g/%n. ") +(defun jabber-connect-all* (&optional arg) + "Connect to all defined jabber accounts. +If called with ARG non-nil, or with \\[universal-argument], +disconnect first." + (interactive "P") + (when arg (jabber-disconnect)) + (jabber-connect-all)) +(keymap-global-set "C-c j c" #'jabber-connect-all*) + (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) (with-eval-after-load 'jabber (require 'jabber-httpupload nil t) @@ -440,13 +463,16 @@ If REQUIRE is a non-nil value, require the package after adding it." (define-key jabber-global-keymap (vector (+ key #x60)) command)) jabber-global-keymap) (keymap-global-set "C-x C-j" #'dired-jump)) - -(keymap-global-set "C-c j" (autoload-keymap jabber-global-keymap jabber)) (keymap-global-set "C-x C-j" #'dired-jump) -(add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) +(with-eval-after-load 'dired + (keymap-set dired-mode-map "C-j" #'dired-up-directory)) + +(keymap-global-set "C-c j" jabber-global-keymap) + (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) +(add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) (add-hook 'jabber-chat-mode-hook 'visual-line-mode) (add-hook 'jabber-chat-mode-hook @@ -479,6 +505,7 @@ If REQUIRE is a non-nil value, require the package after adding it." ;;; General keybinding changes (keymap-global-set "M-o" #'other-window-or-switch-buffer) +(keymap-global-set "C-x 0" #'delete-window-or-bury-buffer) (keymap-global-set "M-SPC" #'cycle-spacing@) (keymap-global-set "M-u" #'universal-argument) (keymap-set universal-argument-map "M-u" #'universal-argument-more) @@ -494,6 +521,7 @@ If REQUIRE is a non-nil value, require the package after adding it." (setopt modus-themes-bold-constructs nil) (setopt modus-themes-italic-constructs t) (setopt modus-themes-variable-pitch-ui t) +(setopt modus-themes-disable-other-themes t) (add-hook 'modus-themes-after-load-theme-hook #'reset-faces) (add-hook 'after-init-hook #'reset-faces) @@ -555,13 +583,17 @@ mouse-3: Toggle minor modes" mode-line-end-spaces))) ;; Remove modes from mode-line -(dolist (minor-mode '(frowny-mode - whitespace-mode - hungry-delete-mode)) - (setf (alist-get minor-mode minor-mode-alist) (list "")) - (add-hook (intern (format "%s-hook" minor-mode)) +(defun hide-minor (mode &optional hook) + "Hide MODE from the mode line. +HOOK defaults to MODE-hook, and is used to trigger the hiding." + (setf (alist-get mode minor-mode-alist) (list "")) + (add-hook (intern (or hook (format "%s-hook" mode))) (lambda () - (setf (alist-get minor-mode minor-mode-alist) (list ""))))) + (setf (alist-get mode minor-mode-alist) (list ""))))) + +(hide-minor 'frowny-mode) +(hide-minor 'whitespace-mode) +(hide-minor 'hungry-delete-mode) (scroll-bar-mode -1) (menu-bar-mode -1) @@ -584,16 +616,31 @@ mouse-3: Toggle minor modes" (keymap-global-set "M-=" #'count-words) +;;; Geiser & Scheme + +(ensure-package 'geiser) +(when (executable-find "csi") + (ensure-package 'geiser-chicken)) +(setopt scheme-program-name (or (executable-find "csi") + "scheme")) (with-eval-after-load 'scheme (keymap-unset scheme-mode-map "M-o" t) ;; Comparse "keywords" --- CHICKEN (http://wiki.call-cc.org/eggref/5/comparse) (put 'sequence* 'scheme-indent-function 1) (put 'satisfies 'scheme-indent-function 1) (add-hook 'scheme-mode-hook #'geiser-mode)) + +(setopt gieser-autodoc-delay 0.1) + + (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 geiser-mode-map "C-." t) + (add-hook 'geiser-repl-startup-hook + (defun geiser-add-default-directory-to-load-path () + (geiser-add-to-load-path default-directory)))) +;;; Visual fill column (with-eval-after-load 'visual-fill-column (setopt visual-fill-column-center-text t) @@ -602,6 +649,8 @@ mouse-3: Toggle minor modes" (add-hook 'visual-line-mode-hook #'visual-fill-column-mode) (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode) +;;; Set major mode for non-file buffers + (setopt major-mode (lambda () ; guess major mode from buffer name (unless buffer-file-name @@ -688,6 +737,10 @@ mouse-3: Toggle minor modes" (set-selection-coding-system 'utf-8) (set-clipboard-coding-system 'utf-8))) +(setopt x-underline-at-descent-line t) +(setopt blink-cursor-delay 0.25) +(setopt blink-cursor-interval 0.25) +(setopt blink-cursor-blinks 1) ;; Files (setopt auto-revert-verbose nil) @@ -765,6 +818,28 @@ mouse-3: Toggle minor modes" (winner-mode) ;;; Hooks + +(defcustom persist-settings-hook nil + "Functions to run in order to persist settings." + :type 'hook) + +(defun persist-settings () + (inhibit-messages + (run-with-idle-timer 5 nil #'run-hooks 'persist-settings-hook))) + +(defvar persist-timer + (run-with-timer nil 60 #'persist-settings) + "Timer running `persist-settings-hook'.") + +(add-hook 'persist-settings-hook #'save-place-kill-emacs-hook) +(add-hook 'persist-settings-hook #'recentf-save-list) +(add-hook 'persist-settings-hook #'savehist-autosave) +(add-hook 'persist-settings-hook #'bookmark-exit-hook-internal) +(with-eval-after-load 'em-hist + (add-hook 'persist-settings-hook #'eshell-save-some-history)) +(with-eval-after-load 'prescient + (add-hook 'persist-settings-hook #'prescient--save)) + (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) (add-hook 'find-file-not-found-functions #'create-missing-directories) (add-hook 'find-file-hook #'vc-remote-off) @@ -784,12 +859,41 @@ mouse-3: Toggle minor modes" (keymap-global-set "C-c a" #'org-agenda) (keymap-global-set "C-c c" #'org-capture) -(setopt org-clock-clocked-in-display nil) + +(setopt org-clock-clocked-in-display 'mode-line) (setopt org-clock-out-remove-zero-time-clocks t) (setopt org-clock-frame-title-format '("%b" " - " (t org-mode-line-string))) (setopt org-tags-column (- (- fill-column 3))) (setopt org-log-into-drawer t) (setopt org-clock-into-drawer t) +(setopt org-special-ctrl-a/e t) + +(defmacro org-insert-or-surround (character) + (let ((c (gensym))) + `(defun ,(intern (format "org-insert-or-surround-%s" character)) (arg) + ,(format "Insert %s or surround the region with it." character) + (interactive "p") + (let ((,c ,(if (stringp character) + (string-to-char character) + character))) + (if (org-region-active-p) + (let ((begin (region-beginning)) + (end (region-end))) + (save-mark-and-excursion + (deactivate-mark) + (goto-char begin) + (self-insert-command arg ,c) + (goto-char (+ 1 end)) + (self-insert-command arg ,c))) + (self-insert-command arg ,c)))))) + +(with-eval-after-load 'org + (keymap-set org-mode-map "*" (org-insert-or-surround "*")) + (keymap-set org-mode-map "/" (org-insert-or-surround "/")) + (keymap-set org-mode-map "_" (org-insert-or-surround "_")) + (keymap-set org-mode-map "=" (org-insert-or-surround "=")) + (keymap-set org-mode-map "~" (org-insert-or-surround "~")) + (keymap-set org-mode-map "+" (org-insert-or-surround "+"))) ;; Fix braindead behavior (with-eval-after-load 'org-mouse @@ -919,7 +1023,7 @@ itself. Other values of ARG will call `newline' with that ARG." (with-eval-after-load 'org (keymap-set org-mode-map "RET" #'org-return-dwim) - (keymap-set org-mode-map "S-RET" #'org-table-copy-down|org-return-dwim)) + (keymap-set org-mode-map "S-" #'org-table-copy-down|org-return-dwim)) ;;; Copy rich text to the keyboard @@ -1054,8 +1158,7 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (add-hook 'jabber-chat-mode-hook #'frowny-mode) (add-hook 'jabber-chat-mode-hook #'electric-pair-local-mode-disable) -(autoload 'hippie-completing-read "hippie-completing-read" nil t) -(keymap-global-set "M-/" #'hippie-completing-read) +(keymap-global-set "M-/" #'hippie-expand) (setopt mode-line-bell-flash-time 0.25) (autoload 'mode-line-bell-mode "mode-line-bell" nil t) @@ -1083,7 +1186,6 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (file-name-shadow-mode) (minibuffer-electric-default-mode) -(setopt completion-styles '(flex basic partial-completion emacs22)) (setopt completion-ignore-case t) (setopt read-buffer-completion-ignore-case t) (setopt read-file-name-completion-ignore-case t) @@ -1099,14 +1201,22 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (add-hook 'completion-list-mode-hook #'truncate-lines-mode) (add-hook 'minibuffer-setup-hook #'truncate-lines-mode) +(ensure-package 'prescient nil t) +(setopt completion-styles '(prescient basic)) +(setopt completion-category-overrides + '((file (styles basic partial-completion)))) +(prescient-persist-mode) +(add-hook 'persist-settings-hook #'prescient--save) + (define-minor-mode good-completions-mode "A mode for completing good." :lighter "" :global t - (setq completion-auto-help (when good-completions-mode 'always) - completion-auto-select (when good-completions-mode 'second-tab) - completions-format 'one-column - completions-header-format nil) + (setq completion-auto-help (when good-completions-mode 'always)) + (setq completion-auto-select (when good-completions-mode 'second-tab)) + (setq completions-format (if good-completions-mode 'one-column 'horizontal)) + (setq completions-header-format nil) + (setq completions-max-height 16) (cond (good-completions-mode ;; Turn off other completion frameworks @@ -1115,17 +1225,18 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (fido-mode -1) (fido-vertical-mode -1) ;; Up/down when completing in the minibuffer - (define-key minibuffer-local-map (kbd "C-p") + (keymap-set minibuffer-local-map "C-p" #'minibuffer-previous-completion) - (define-key minibuffer-local-map (kbd "C-n") + (keymap-set minibuffer-local-map "C-n" #'minibuffer-next-completion) ;; Up/down when competing in a normal buffer - (define-key completion-in-region-mode-map (kbd "C-p") + (keymap-set completion-in-region-mode-map "C-p" #'minibuffer-previous-completion) - (define-key completion-in-region-mode-map (kbd "C-n") - #'minibuffer-next-completion)) - (setq completions-sort #'renz/sort-multi-category - completion-in-region-function #'completion--in-region) + (keymap-set completion-in-region-mode-map "C-n" + #'minibuffer-next-completion) + (keymap-set completion-in-region-mode-map "RET" + #'minibuffer-choose-completion) + (setq completion-in-region-function #'completion--in-region)) (t))) (good-completions-mode) @@ -1175,7 +1286,43 @@ ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." (setq global-mode-string '((jabber-activity-mode jabber-activity-mode-string) - (:eval (when (and (fboundp 'org-clocking-p) - (org-clocking-p)) - (concat " " (truncate-string-to-width org-mode-line-string - 24 nil nil t)))))) + " ")) + +(add-hook 'prog-mode-hook #'prettify-symbols-mode) + +(require 'autoinsert) +(setf (alist-get "\\.scm" auto-insert-alist nil nil #'equal) + '(nil + "#!/bin/sh" \n + "#| -*- scheme -*-" \n + "exec csi -R r7rs -ss \"$0\" \"$@\"" \n + _ \n + "|#" \n \n)) + +(ensure-package 'embark nil t) +(when (package-installed-p 'consult) + (ensure-package 'embark-consult nil t)) + +(keymap-global-set "C-." #'embark-act) +(keymap-global-set "M-." #'embark-dwim) +(keymap-global-set "C-h B" #'embark-bindings) + +(setopt eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) +(setopt eldoc-idle-delay 0.01) + +(setf (alist-get "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" + display-buffer-alist + nil nil #'equal) + '(nil (window-parameters (mode-line-format . none)))) + +(add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode) + +(global-goto-address-mode) + +(ensure-package 'pulse-location t t) +(pulse-location-mode) +(hide-minor 'pulse-location-mode) + +(define-advice eval-region (:around (orig start end &rest args) pulse) + (apply orig start end args) + (pulse-momentary-highlight-region start end)) -- cgit 1.4.1-21-gabe81