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-<return>" #'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