From 5f9c8af280a06b721a4d5652fac57fba80f62001 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sat, 13 May 2023 23:33:07 -0500 Subject: Changes or whatever This is the last commit of this repo --- init.el | 409 +++++++++++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 342 insertions(+), 67 deletions(-) diff --git a/init.el b/init.el index c654c07..c6d361b 100644 --- a/init.el +++ b/init.el @@ -1,4 +1,4 @@ -;;; Emacs init.el -*- lexical-binding: t; -*- +;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- ;; by Case Duckworth ;; 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) -- cgit 1.4.1-21-gabe81