1 files changed, 342 insertions, 67 deletions

@@ -1,4 +1,4 @@
-;;; Emacs init.el  -*- lexical-binding: t; -*-
+;;; ~/.emacs  -*- mode: emacs-lisp; lexical-binding: t; -*-
 ;; by Case Duckworth <acdw@acdw.net>
 ;; Bankruptcy 10: "Annoyance"
 
@@ -11,11 +11,88 @@
 
 ;;; Code:
 
-(load (locate-user-emacs-file "private"))
+(add-hook 'after-init-hook
+          (lambda ()
+            (load (locate-user-emacs-file "private"))))
 
-
 ;;; Definitions:
 
+(defun reset-faces ()
+  (dolist (face '(font-lock-regexp-face
+                  font-lock-builtin-face
+                  font-lock-variable-name-face
+                  font-lock-preprocessor-face
+                  font-lock-remove-face
+                  font-lock-delimiter-face
+                  font-lock-label-face
+                  font-lock-operator-face
+                  font-lock-property-face
+                  font-lock-builtin-face
+                  font-lock-number-face
+                  font-lock-keyword-face
+                  font-lock-set-face
+                  font-lock-warning-face
+                  font-lock-punctuation-face
+                  font-lock-constant-face
+                  font-lock-type-face
+                  font-lock-function-name-face
+                  font-lock-reference-face
+                  font-lock-misc-punctuation-face
+                  font-lock-bracket-face))
+    (face-spec-set face '((t :foreground unspecified
+                             :background unspecified)))))
+
+(defun electric-pair-local-mode-disable ()
+  "Disable `electric-pair-mode', locally."
+  (electric-pair-local-mode -1))
+
+(defun kill-this-buffer (&optional buffer-or-name)
+  "Kill this buffer, or BUFFER-OR-NAME.
+When called interactvely, the user will be prompted when passing
+\\[universal-argument]."
+  (interactive "P")
+  (cond
+   ((bufferp buffer-or-name)
+    (kill-buffer buffer-or-name))
+   ((null buffer-or-name)
+    (kill-current-buffer))
+   (:else
+    (kill-buffer (read-buffer "Kill: " nil :require-match)))))
+
+(defun define-org-capture-template (description &rest args)
+  "Define an template for `org-capture-templates'.
+Will not replace an existing template unless `:force' in ARGS is
+non-nil. ARGS is a plist, which in addition to the additional
+options `org-capture-templates' accepts (which see), also accepts
+the following: `:keys', `:description', `:type', `:target', and
+`:template'."
+  (declare (indent 1))
+  (let* ((keys (plist-get args :keys))
+         (type (plist-get args :type))
+         (target (plist-get args :target))
+         (template (plist-get args :template))
+         (force (plist-get args :force))
+         (template-value
+          (append
+           (list description)
+           (when (or type target template)
+             (list (or type 'entry) target template))
+           (cl-loop for i from 0 below (length args) by 2
+                    unless (member (nth i args)
+                                   '( :keys :description :type
+                                      :target :template))
+                    append (list (nth i args)
+                                 (plist-get args (nth i args)))))))
+    (if (seq-find (lambda (el) (equal (car el) keys))
+                  org-capture-templates)
+        (and force
+             (setf (alist-get keys org-capture-templates nil nil #'equal)
+                   template-value))
+      (setf org-capture-templates
+            (append org-capture-templates
+                    (list (cons keys template-value)))))
+    org-capture-templates))
+
 (defun other-window-or-switch-buffer (&optional arg)
   "Switch to the other window.
 If a window is the only buffer on a frame, switch buffer.  When
@@ -40,6 +117,9 @@ N spaces."
   (face-spec-set 'default
                  `((t :family "Recursive Mono Casual Static"
                       :height 110)))
+  (face-spec-set 'variable-pitch
+                 `((t :family "Recursive Sans Casual Static"
+                      :height 1.0)))
   ;; Emojis
   (cl-loop with ffl = (font-family-list)
            for font in '("Noto Emoji" "Noto Color Emoji"
@@ -182,6 +262,23 @@ With prefix ARG, toggle the value of
         (titlecase-region (progn (org-beginning-of-line) (point))
                           (progn (org-end-of-line) (point)))))))
 
+(defcustom browse-url-safe-browser-functions nil
+  "\"Safe\" browser functions."
+  :type '(repeat-function))
+
+(defun browse-url-browser-function-safe-p (fn)
+  "Return t if FN is a \"safe\" browser function."
+  (memq f (append browse-url-safe-browser-functions
+                  (mapcar (lambda (i)
+                            (plist-get (cdr i) :value))
+                          (seq-filter (lambda (i)
+                                        (eq (car i) 'function-item))
+                                      (cdr (get 'browse-url-browser-function
+                                                'custom-type)))))))
+
+(put 'browse-url-browser-function 'safe-local-variable
+     'browse-url-browser-function-safe-p)
+
 
 ;;; Packages:
 
@@ -189,34 +286,49 @@ With prefix ARG, toggle the value of
 (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
 (package-initialize)
 
+(defun ensure-package (pkg &optional localp)
+  "Esnure PKG is installed from repositories.
+If LOCALP is t, add ~/src/PKG.el to `load-path'.
+If LOCALP is a string, add that directory to the `load-path'."
+  (cond
+   ((stringp localp)
+    (and (file-exists-p localp)
+         (add-to-list 'load-path localp)))
+   (localp
+    (ensure-package pkg
+                    (expand-file-name
+                     (format "~/src/%s.el"
+                             (symbol-name pkg)))))
+   (:else
+    (unless (package-installed-p pkg)
+      (unless (ignore-errors (package-install pkg))
+        (package-refresh-contents)
+        (package-install pkg))))))
+
 ;; Install packages here. Acutal configuration is done in the Configuration
 ;; section.
-(dolist (pkg `(consult
-               marginalia
-               visual-fill-column
-               adaptive-wrap
-               geiser
-               ,(when (executable-find "csi") 'geiser-chicken)
-               avy
-               zzz-to-char
-               hungry-delete
-               undohist
-               jinx))
-  (when (and pkg (not (package-installed-p pkg)))
-    (unless (ignore-errors (package-install pkg))
-      (package-refresh-contents)
-      (package-install pkg))))
-
-(dolist (local-pkg `(scule
-                     frowny
-                     hippie-completing-read
-                     mode-line-bell
-                     titlecase
-                     jabber))
-  (add-to-list 'load-path
-               (expand-file-name
-                (format "~/src/%s.el"
-                        (symbol-name local-pkg)))))
+(ensure-package 'consult)
+(ensure-package 'marginalia)
+(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)
+(ensure-package 'undohist)
+(ensure-package 'jinx)
+(ensure-package 'markdown-mode)
+(ensure-package 'anzu)
+
+;; 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
 
@@ -303,9 +415,7 @@ With prefix ARG, toggle the value of
 ;;; General keybinding changes
 
 (keymap-global-set "M-o" #'other-window-or-switch-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)
 
@@ -317,30 +427,46 @@ With prefix ARG, toggle the value of
 
 (tool-bar-mode -1)
 
+(setopt modus-themes2-bold-constructs nil
+        modus-themes-italic-constructs t
+        modus-themes-variable-pitch-ui t)
+
+(add-hook 'modus-themes-after-load-theme-hook #'reset-faces)
+
 (load-theme 'modus-vivendi :no-confirm :no-enable)
 (load-theme 'modus-operandi :no-confirm)
 
 (add-hook 'text-mode-hook #'visual-line-mode)
+(add-hook 'prog-mode-hook #'auto-fill-mode)
+(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode)
 
 ;;; Mode line
 
 (defvar mode-line-position
   '(""
-    (:eval (if line-number-mode "%3l" ""))
-    (:eval (if column-number-mode
-               (if column-number-indicator-zero-based
-                   "/%2c"
-                 "/%2C")
-             ""))
-    " (" (-3 "%p") ") "))
+    (:propertize
+     (""
+      (:eval (if line-number-mode "%3l" ""))
+      (:eval (if column-number-mode
+                 (if column-number-indicator-zero-based
+                     "/%2c"
+                   "/%2C")
+               "")))
+     display (min-width (3.0)))
+    (:propertize (" [" (-3 "%p") "] ")
+                 display (min-width (6.0)))))
 
 (setopt mode-line-format
-        '(("%e" mode-line-front-space
-           mode-line-client
-           mode-line-modified
-           mode-line-remote " "
+        '(("%e"
+           mode-line-front-space
+           (:propertize (""
+                         mode-line-client
+                         mode-line-modified
+                         mode-line-remote)
+                        display (min-width (3.0)))
+           " "
            mode-line-buffer-identification
-           (vc-mode vc-mode)
+           (vc-mode (" (" (:eval (string-trim vc-mode)) ")"))
            " "
            (mode-line-position mode-line-position)
            mode-line-modes
@@ -358,16 +484,15 @@ With prefix ARG, toggle the value of
 
 ;;; Completion & minibuffer
 
-(setopt icomplete-in-buffer t
-        icomplete-tidy-shadowed-file-names t)
 (fido-vertical-mode)
+(minibuffer-depth-indicate-mode)
 
 (setopt completion-auto-help (not icomplete-mode)
         completion-auto-select 'second-tab
         completions-header-format nil
         completions-max-height 12
         completions-format 'one-column
-        completion-styles '(basic partial-completion flex)
+        completion-styles '(basic partial-completion emacs22 flex)
         completion-ignore-case t
         read-buffer-completion-ignore-case t
         read-file-name-completion-ignore-case t
@@ -385,12 +510,12 @@ With prefix ARG, toggle the value of
 (add-hook 'minibuffer-setup-hook #'truncate-lines-mode)
 
 ;; Up/down when completing in the minibuffer
-(define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion)
-(define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion)
+;; (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion)
+;; (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion)
 
 ;; Up/down when competing in a normal buffer
-(define-key completion-in-region-mode-map (kbd "C-p") #'minibuffer-previous-completion)
-(define-key completion-in-region-mode-map (kbd "C-n") #'minibuffer-next-completion)
+;; (define-key completion-in-region-mode-map (kbd "C-p") #'minibuffer-previous-completion)
+;; (define-key completion-in-region-mode-map (kbd "C-n") #'minibuffer-next-completion)
 
 (setopt completions-sort #'renz/sort-multi-category)
 
@@ -428,9 +553,11 @@ With prefix ARG, toggle the value of
   (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go)
   (keymap-unset geiser-mode-map "C-." t))
 
-(setopt visual-fill-column-center-text t
-        visual-fill-column-width (+ fill-column 2))
-(advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)
+
+(with-eval-after-load 'visual-fill-column
+  (setopt visual-fill-column-center-text t
+          visual-fill-column-width (+ fill-column 2))
+  (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust))
 (add-hook 'visual-line-mode-hook #'visual-fill-column-mode)
 (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode)
 
@@ -617,7 +744,6 @@ With prefix ARG, toggle the value of
 (defun tab-bar-end-space ()
   `((end menu-item " " ignore)))
 
-
 (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
 (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
 (add-to-list 'tab-bar-format 'tab-bar-end-space :append)
@@ -627,9 +753,13 @@ With prefix ARG, toggle the value of
 ;;; Org mode
 
 (keymap-global-set "C-c a" #'org-agenda)
+(keymap-global-set "C-c c" #'org-capture)
 (setopt org-clock-clocked-in-display 'frame-title
         org-clock-frame-title-format
-        '("%b" " - " (t org-mode-line-string)))
+        '("%b" " - " (t org-mode-line-string))
+        org-tags-column (- (- fill-column 3))
+        org-log-into-drawer t
+        org-clock-into-drawer t)
 
 ;;; Spelling
 
@@ -647,8 +777,118 @@ With prefix ARG, toggle the value of
   (keymap-set jinx-mode-map "M-$" #'jinx-correct)
   (keymap-set jinx-mode-map "C-M-$" #'jinx-languages))
 
+;;; org-return-dwim
+;; https://github.com/alphapapa/unpackaged.el,
+;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
+(defun org-return-dwim (&optional arg)
+  "A helpful replacement for `org-return'.
+When called interactively with \\[universal-argument], call `org-return'
+itself.  Other values of ARG will call `newline' with that ARG."
+  (interactive "P")
+  ;; Auto-fill if enabled
+  (when auto-fill-function
+    (dolist (func (ensure-list auto-fill-function))
+      (funcall func)))
+  (cl-letf* ((el (org-element-at-point))
+             ((symbol-function 'el-child-of)
+              (lambda (&rest types)
+                (org-element-lineage el types t))))
+    (cond                                ; Figure out what we're going to do
+     (arg                                ; Handle prefix ARG
+      (pcase arg
+        ('(4) (org-return t nil t))
+        (_ (newline arg t))))
+     ((and org-return-follows-link      ; Open a link
+           (el-child-of 'link))
+      (org-open-at-point-global))
+     ((org-at-heading-p)                ; Open a paragraph after a heading
+      (let ((heading-start (org-entry-beginning-position)))
+        (goto-char (org-entry-end-position))
+        (cond ((and (org-at-heading-p)      ; Entry is only a heading
+                    (= heading-start (org-entry-beginning-position)))
+               (end-of-line)
+               (newline 2))
+              (:else                    ; Entry is more than a heading
+               (forward-line -1)
+               (end-of-line)
+               (when (org-at-heading-p)
+                 ;; Open a paragraph
+                 (forward-line)
+                 (newline)
+                 (forward-line -1))
+               (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
+                 (newline))
+               (forward-line -1)))))
+     ((org-at-item-checkbox-p)          ; Insert a new checkbox item
+      (end-of-line)
+      (org-insert-todo-heading nil))
+     ((org-in-item-p)                   ; Insert a new list item
+      (let* ((context (org-element-context el))
+             (first-item-p (eq 'plain-list (car context)))
+             (itemp (eq 'item (car context)))
+             (emptyp (or
+                      ;; This (regular) list item is empty
+                      (eq (org-element-property :contents-begin context)
+                          (org-element-property :contents-end context))
+                      ;; This (definition) list item is empty
+                      (looking-at " *::")))
+             (item-child-p (el-child-of 'item)))
+        (cond ((and itemp emptyp)
+               ;; This test has to be here even though it's the same as the
+               ;; :else clause, because an item that's empty will also satisfy
+               ;; the next clause.
+               (delete-region (line-beginning-position) (line-end-position))
+               (newline))
+              ((or first-item-p
+                   (and itemp (not emptyp))
+                   item-child-p)
+               (org-end-of-item)
+               (org-insert-item))
+              (:else
+               (delete-region (line-beginning-position) (line-end-position))
+               (newline)))))
+     ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
+           (org-inlinetask-in-task-p))
+      (org-return))
+     ((org-at-table-p)                  ; Insert a new table row
+      (cond ((save-excursion            ; Empty row: end the table
+               (beginning-of-line)
+               (cl-loop with end = (line-end-position)
+                        for cell = (org-element-table-cell-parser)
+                        always (eq (org-element-property :contents-begin cell)
+                                   (org-element-property :contents-end cell))
+                        while (re-search-forward "|" end t)))
+             (delete-region (line-beginning-position) (line-end-position))
+             (org-return))
+            (:else                      ; Non-empty row
+             (org-return))))
+     (:else                             ; Something else
+      (org-return)))))
+
+(defun org-table-copy-down|org-return-dwim (&optional n)
+  "Call `org-table-copy-down' or `+org-return' depending on context."
+  (interactive "P")
+  (if (org-table-check-inside-data-field 'noerror)
+      (org-table-copy-down (or n 1))
+    (org-return-dwim n)))
+
+(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))
+
 ;;; Copy rich text to the keyboard
 
+(defcustom clipboard-html-copy-program
+  (if (or (equal "wayland"
+                 (getenv "XDG_SESSION_TYPE"))
+          (getenv "WAYLAND_DISPLAY"))
+      '("wl-copy" "-t" "text/html")
+    '("xclip" "-t" "text/html" "-selection" "clipboard"))
+  "Program to use to copy HTML to the clipboard.
+Should be a list of strings---the command line.
+Defaults to 'wl-copy' on wayland and 'xclip' on Xorg."
+  :type '(repeat string))
+
 ;; Thanks to Oleh Krehel:
 ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
 ;; So.  Emacs can't do this itself because it doesn't support sending clipboard
@@ -663,23 +903,40 @@ With prefix ARG, toggle the value of
 ;;                    "-t" "text/html" "-selection" "clipboard")
 ;;     (message "HTML pasted to clipboard.")))
 
-;; Wayland version.. TODO: make it work for both
-(defun org-to-html-to-clipboard (&rest org-export-args)
-  "Export current org buffer to HTML, then copy it to the clipboard.
-ORG-EXPORT-ARGS are passed to `org-export-to-file'."
+(defun org-export-html-copy (&rest org-export-args)
+  "Export current org buffer to HTML and copy to clipboard as rich text.
+ORG-EXPORT-ARGS are passed to `org-export-to-buffer'."
   (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
     (apply #'org-export-to-buffer 'html buf org-export-args)
     (with-current-buffer buf
-      (call-process-region (point-min) (point-max)
-                           "wl-copy" nil nil nil
-                           "-t" "text/html")
+      (apply #'call-process-region
+             (point-min)
+             (point-max)
+             (car clipboard-html-copy-program)
+             nil                        ; don't delete text
+             nil                        ; discard the output
+             nil                        ; don't redisplay
+             (cdr clipboard-html-copy-program))
       (kill-buffer-and-window))
     (message "HTML copied to clipboard.")))
 
+;; Wayland version.. TODO: make it work for both
+;; (defun org-to-html-to-clipboard (&rest org-export-args)
+  ;; "Export current org buffer to HTML, then copy it to the clipboard.
+;; ORG-EXPORT-ARGS are passed to `org-export-to-file'."
+  ;; (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
+    ;; (apply #'org-export-to-buffer 'html buf org-export-args)
+    ;; (with-current-buffer buf
+      ;; (call-process-region (point-min) (point-max)
+                           ;; "wl-copy" nil nil nil
+                           ;; "-t" "text/html")
+      ;; (kill-buffer-and-window))
+    ;; (message "HTML copied to clipboard.")))
+
 (defun org-subtree-to-html-to-clipboard ()
   "Export current subtree to HTML."
   (interactive)
-  (org-to-html-to-clipboard nil :subtree))
+  (org-export-html-copy nil :subtree))
 
 (undohist-initialize)
 
@@ -736,19 +993,37 @@ ORG-EXPORT-ARGS are passed to `org-export-to-file'."
 (keymap-global-set "C-x C-b" #'ibuffer)
 (add-hook 'ibuffer-hook #'hl-line-mode)
 
-(autoload 'scule-map "scule" nil nil 'keymap)
-(keymap-global-set "M-c" 'scule-map)
-(with-eval-after-load 'scule
-  (keymap-set scule-map "M-t" #'titlecase-dwim))
+(require 'scule)
+(keymap-global-set "M-c" scule-map)
+(autoload 'titlecase-dwim "titlecase" nil t)
+(keymap-set scule-map "M-t" #'titlecase-dwim)
 
 ;; Use M-u for prefix keys
 (keymap-global-set "M-u" #'universal-argument)
 (keymap-set universal-argument-map "M-u" #'universal-argument-more)
 
+(autoload 'frowny-mode "frowny" nil t)
 (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)
 
 (setopt mode-line-bell-flash-time 0.25)
 (autoload 'mode-line-bell-mode "mode-line-bell" nil t)
 (mode-line-bell-mode)
+
+(keymap-global-set "C-x C-k" #'kill-this-buffer)
+
+(require 'anzu)
+(global-anzu-mode)
+(setopt search-default-mode t
+        anzu-mode-lighter ""
+        anzu-deactivate-region t)
+
+(global-set-key [remap query-replace] #'anzu-query-replace-regexp)
+(global-set-key [remap query-replace-regexp] #'anzu-query-replace)
+(define-key isearch-mode-map [remap isearch-query-replace]
+            #'anzu-isearch-query-replace-regexp)
+(define-key isearch-mode-map [remap isearch-query-replace-regexp]
+            #'anzu-isearch-query-replace)