Merge branch 'main' of tildegit.org:acdw/emacs

3 files changed, 179 insertions, 25 deletions

@@ -87,7 +87,7 @@
                                              (:work 12)
                                              (_ 10))
                   acdw-fonts/variable (acdw/system
-                                       (:home "DejaVu Sans")
+                                       (:home "Inter")
                                        (:work "Calibri")
                                        (_ "sans-serif"))
                   acdw-fonts/variable-size (acdw/system
@@ -48,6 +48,9 @@
 ;;;; Private stuff
 (acdw/require-private)
 
+;;;; Compatibility with older versions
+(require 'acdw-compat)
+
 
 ;;;; Utility functions and variables
 ;; see also: `acdw' and friends.  Functions here aren't big enough, or they're
@@ -367,8 +370,8 @@
                   (apply f r))))
   
   (:hook erc-autoaway-mode
-             erc-track-mode
-             erc-truncate-mode)
+         erc-track-mode
+         erc-truncate-mode)
 
   (:bind "C-c C-b" acdw-erc/erc-switch-to-buffer
          "C-c C-c" nil                  ; def: `erc-toggle-interpret-controls'
@@ -419,9 +422,11 @@ like a dumbass."
     ;; Define keys
     (dolist (spec '(("C-d" . eshell-quit-or-delete-char)))
       (define-key eshell-mode-map (kbd (car spec)) (function (cdr spec))))
-    ;; Etc.
+    ;; Fix modeline
     (when (boundp 'simple-modeline--mode-line)
-      (setq mode-line-format '(:eval simple-modeline--mode-line))))
+      (setq mode-line-format '(:eval simple-modeline--mode-line)))
+    ;; Set outline-regexp for consult-outline
+    (setq outline-regexp eshell-prompt-regexp))
 
   (defun eshell-buffer-name ()
     (rename-buffer (concat "*eshell*<" (eshell/pwd) ">") t))
@@ -605,6 +610,13 @@ like a dumbass."
   (minibuffer-electric-default-mode +1)
   (fset 'yes-or-no-p #'y-or-n-p))
 
+(setup page
+  (defun recenter-to-top (&rest _args)
+    "Recenter the cursor to the top of the window."
+    (recenter 0))
+  (:advise forward-page :after #'recenter-to-top
+           backward-page :after #'recenter-to-top))
+
 (setup prog
   (:option smie-indent-basic tab-width)
   
@@ -826,13 +838,15 @@ like a dumbass."
   (:global "M-=" count-words
            "C-w" kill-region-or-backward-word
            "<help> h" nil ; HELLO takes a long time to load on Windows
-           )
+           "M-c" capitalize-dwim
+           "M-u" upcase-dwim
+           "M-l" downcase-dwim)
 
   ;; (when (display-graphic-p)
   ;;   (:global "<escape>" keyboard-escape-quit))
 
   ;; Remap C-h to DEL -- <f1> can be the "help" key
-  (define-key key-translation-map [?\C-h] [?\C-?])
+  ;; (define-key key-translation-map [?\C-h] [?\C-?])
 
   (:global "C-c t" acdw/insert-iso-date
            "C-z" nil))
@@ -890,10 +904,10 @@ like a dumbass."
     "Perform `consult-git-grep' if in a git project, otherwise `consult-ripgrep'
 if ripgrep is installed, otherwise `consult-grep'."
     (interactive "P")
-    (cond ((string-equal (vc-backend buffer-file-name) "Git")
-           (call-interactively #'consult-git-grep))
-          ((executable-find "rg")
+    (cond ((executable-find "rg")
            (call-interactively #'consult-ripgrep))
+          ((string-equal (vc-backend buffer-file-name) "Git")
+           (call-interactively #'consult-git-grep))
           (t (call-interactively #'consult-grep))))
   
   (defun consult-sensible-find (&optional arg)
@@ -902,6 +916,15 @@ if ripgrep is installed, otherwise `consult-grep'."
     (cond ((executable-find "locate") (call-interactively #'consult-locate))
           (t (call-interactively #'consult-find))))
 
+  ;; Orderless Regexp Compiler! -- from Consult Wiki
+  (defun consult--orderless-regexp-compiler (input type)
+    (setq input (orderless-pattern-compiler input))
+    (cons
+     (mapcar (lambda (r) (consult--convert-regexp r type)) input)
+     (lambda (str) (orderless--highlight input str))))
+
+  (setq consult--regexp-compiler #'consult--orderless-regexp-compiler)
+
   ;; Bindings
   (:global
    ;; C-c bindings (`mode-specific-map')
@@ -913,6 +936,7 @@ if ripgrep is installed, otherwise `consult-grep'."
    ;; C-x bindings (`ctl-x-map')
    "C-x M-:" consult-complex-command
    "C-x b" consult-buffer
+   "<f1>" consult-buffer                ; trying this out ...
    "C-x 4 b" consult-buffer-other-window
    "C-x 5 b" consult-buffer-other-frame
    ;; Custom M-# bindings for fast register access
@@ -977,7 +1001,16 @@ if ripgrep is installed, otherwise `consult-grep'."
     (defun crm-indicator (args)
       (cons (concat "[CRM] " (car args)) (cdr args)))
     (:advise completing-read-multiple
-             :filter-args #'crm-indicator)))
+             :filter-args #'crm-indicator))
+
+  (with-eval-after-load 'vertico
+    (with-eval-after-load 'consult
+      (define-key consult-crm-map "\r" #'+vertico-crm-exit)
+      (define-key consult-crm-map "\t" #'vertico-exit)
+      (defun +vertico-crm-exit ()
+        (interactive)
+        (run-at-time 0 nil #'vertico-exit)
+        (funcall #'vertico-exit)))))
 
 (setup (:straight crux)
   
@@ -985,7 +1018,9 @@ if ripgrep is installed, otherwise `consult-grep'."
            "C-o" crux-smart-open-line
            "M-o" crux-smart-open-line-above
            "C-M-\\" crux-cleanup-buffer-or-region
-           "C-x 4 t" crux-transpose-windows))
+           "C-x 4 t" crux-transpose-windows)
+
+  (crux-reopen-as-root-mode +1))
 
 ;; requires extension:
 ;; https://addons.mozilla.org/en-US/firefox/addon/edit-with-emacs1/
@@ -1031,8 +1066,7 @@ if ripgrep is installed, otherwise `consult-grep'."
      (require 'gemini-write))))
 
 (setup (:straight embark)
-  (:global "C-." embark-act
-           "C-;" embark-dwim)
+  (:global "C-." embark-act)
   (:option prefix-help-command #'embark-prefix-help-command
            (append display-buffer-alist)
            '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
@@ -1208,7 +1242,57 @@ if ripgrep is installed, otherwise `consult-grep'."
                    :host github
                    :repo "oantolin/orderless"))
   (require 'orderless)
-  (:option (append completion-styles) 'orderless))
+  
+  (:option (append completion-styles) 'orderless
+           orderless-component-separator #'orderless-escapable-split-on-space
+           orderless-style-dispatchers '(acdw/orderless-dispatch))
+
+  (defun fix-dollar (args)
+    (if (string-suffix-p "$" (car args))
+        (list (concat (substring (car args) 0 -1) "[\x100000-\x10FFFD]*$"))
+      args))
+  (advice-add #'orderless-regexp :filter-args #'fix-dollar)
+
+  (defun acdw/orderless-dispatch (pattern _index _total)
+    "My custom dispatcher for `orderless'."
+    (cond
+     ;; Ensure that $ works with Consult commands, which add disambiguation
+     ;; suffixes -- see `fix-dollar'
+     ((string-suffix-p "$" pattern)
+      `(orderless-regexp . ,(concat (substring pattern 0 -1)
+                                    "[\x100000-\x10FFFD]*$")))
+     ;; File extensions
+     ((string-match-p "\\`\\.." pattern)
+      `(orderless-regexp . ,(concat "\\." (substring pattern 1)
+                                    "[\x100000-\x10FFFD]*$")))
+     ;; Ignore single !
+     ((string= "!" pattern)
+      `(orderless-literal . ""))
+     ;; Character folding
+     ((string-prefix-p "%" pattern)
+      `(char-fold-to-regexp . ,(substring pattern 1)))
+     ((string-suffix-p "%" pattern) 
+      `(char-fold-to-regexp . ,(substring pattern 0 -1)))
+     ;; Without literal
+     ((string-prefix-p "!" pattern) 
+      `(orderless-without-literal . ,(substring pattern 1)))
+     ((string-suffix-p "!" pattern) 
+      `(orderless-without-literal . ,(substring pattern 0 -1)))
+     ;; Initialism matching
+     ((string-prefix-p "`" pattern) 
+      `(orderless-initialism . ,(substring pattern 1)))
+     ((string-suffix-p "`" pattern) 
+      `(orderless-initialism . ,(substring pattern 0 -1)))
+     ;; Literal matching
+     ((string-prefix-p "=" pattern) 
+      `(orderless-literal . ,(substring pattern 1)))
+     ((string-suffix-p "=" pattern) 
+      `(orderless-literal . ,(substring pattern 0 -1)))
+     ;; Flex matching
+     ((string-prefix-p "~" pattern) 
+      `(orderless-flex . ,(substring pattern 1)))
+     ((string-suffix-p "~" pattern)
+      `(orderless-flex . ,(substring pattern 0 -1))))))
 
 (setup (:straight org)
   (:straight org-contrib)
@@ -1383,16 +1467,15 @@ if ripgrep is installed, otherwise `consult-grep'."
   (:also-load vertico-mouse)
   (vertico-mouse-mode +1)
 
-  ;; Workarounds!
-  ;; (with-eval-after-load 'org
-  ;;   (when (version< org-version "9.5")
-  ;;     (defun disable-selection ()
-  ;;       (when (eq minibuffer-completion-table #'org-tags-completion-function)
-  ;;         (setq-local vertico-map minibuffer-local-completion-map
-  ;;                     completion-cycle-threshold nil
-  ;;                     completion-styles '(basic))))
-  ;;     (advice-add #'vertico--setup :before #'disable-selection)))
-  )
+  ;; Prefix the current candidate with ": ".  From Vertico wiki.
+  (advice-add #'vertico--format-candidate :around
+              (lambda (orig cand prefix suffix index _start)
+                (setq cand (funcall orig cand prefix suffix index _start))
+                (concat
+                 (if (= vertico--index index)
+                     (propertize ": " 'face 'vertico-current)
+                   "  ")
+                 cand))))
 
 (setup (:straight vuiet)
   (:needs "youtube-dl"
@@ -0,0 +1,71 @@
+;;; acdw-compat.el -*- lexical-binding: t; coding: utf-8-unix -*-
+
+;; Author: Case Duckworth <acdw@acdw.net>
+;; Created: 2021-08-11
+;; Keywords: configuration
+;; URL: https://tildegit.org/acdw/emacs
+
+;; This file is NOT part of GNU Emacs.
+
+;;; License:
+;; Everyone is permitted to do whatever with this software, without
+;; limitation.  This software comes without any warranty whatsoever,
+;; but with two pieces of advice:
+;; - Don't hurt yourself.
+;; - Make good choices.
+
+;;; Commentary:
+
+;; This file contains functions, variables, and other code that might not be in
+;; every version of Emacs I use.
+
+;;; Code:
+
+;; Convenience macro
+(defmacro safe-defun (name arglist &optional docstring &rest body)
+  "Like `defun', but only if the function doesn't already exist.
+
+Is it necessary?  Who knows!
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+  (declare (doc-string 3)
+           (indent 2))
+  `(unless (fboundp (function ,name))
+     (defun ,name ,@body)))
+
+
+;;; Functions for changing capitalization that Do What I Mean
+;; Defined in /usr/share/emacs/28.0.50/lisp/simple.el
+
+(safe-defun upcase-dwim (arg)
+  "Upcase words in the region, if active; if not, upcase word at point.
+If the region is active, this function calls `upcase-region'.
+Otherwise, it calls `upcase-word', with prefix argument passed to it
+to upcase ARG words."
+  (interactive "*p")
+  (if (use-region-p)
+      (upcase-region (region-beginning) (region-end) (region-noncontiguous-p))
+    (upcase-word arg)))
+
+(safe-defun downcase-dwim (arg)
+  "Downcase words in the region, if active; if not, downcase word at point.
+If the region is active, this function calls `downcase-region'.
+Otherwise, it calls `downcase-word', with prefix argument passed to it
+to downcase ARG words."
+  (interactive "*p")
+  (if (use-region-p)
+      (downcase-region (region-beginning) (region-end) (region-noncontiguous-p))
+    (downcase-word arg)))
+
+(safe-defun capitalize-dwim (arg)
+  "Capitalize words in the region, if active; if not, capitalize word at point.
+If the region is active, this function calls `capitalize-region'.
+Otherwise, it calls `capitalize-word', with prefix argument passed to it
+to capitalize ARG words."
+  (interactive "*p")
+  (if (use-region-p)
+      (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
+    (capitalize-word arg)))
+
+(provide 'acdw-compat)
+;;; acdw-compat.el ends here