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

1 files changed, 216 insertions, 69 deletions

@@ -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))