From a2657993bad828af6743c68931a0e848bfcdec53 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 21 Nov 2021 23:57:41 -0600 Subject: I DECLARE BANKRUPTCY ... 8 Didn't think to do this till pretty .. written, so here we are. --- .gitignore | 4 +- README.org | 30 - TODO.org | 230 ---- early-init.el | 229 ++-- eshell.el | 83 -- gnus.el | 156 --- init.el | 2802 ++++++----------------------------------------- lisp/+avy.el | 21 + lisp/+circe.el | 148 +++ lisp/+consult.el | 47 + lisp/+defaults.el | 239 ++++ lisp/+dired.el | 8 + lisp/+eshell.el | 80 ++ lisp/+init.el | 92 ++ lisp/+lisp.el | 71 ++ lisp/+org.el | 341 ++++++ lisp/+setup.el | 105 ++ lisp/+util.el | 81 ++ lisp/acdw-apheleia.el | 25 - lisp/acdw-autoinsert.el | 58 - lisp/acdw-bell.el | 28 - lisp/acdw-browse-url.el | 129 --- lisp/acdw-circe.el | 167 --- lisp/acdw-compat.el | 555 ---------- lisp/acdw-consult.el | 93 -- lisp/acdw-cus-edit.el | 32 - lisp/acdw-erc.el | 228 ---- lisp/acdw-eshell.el | 93 -- lisp/acdw-eww.el | 38 - lisp/acdw-fonts.el | 176 --- lisp/acdw-frame.el | 36 - lisp/acdw-irc.el | 72 -- lisp/acdw-lisp.el | 16 - lisp/acdw-modeline.el | 232 ---- lisp/acdw-org.el | 517 --------- lisp/acdw-re.el | 151 --- lisp/acdw-reading.el | 100 -- lisp/acdw-setup.el | 103 -- lisp/acdw-ytel.el | 75 -- lisp/acdw.el | 895 +-------------- lisp/chd.el | 76 -- lisp/titlecase.el | 157 --- 42 files changed, 1683 insertions(+), 7136 deletions(-) delete mode 100644 README.org delete mode 100644 TODO.org delete mode 100644 eshell.el delete mode 100644 gnus.el create mode 100644 lisp/+avy.el create mode 100644 lisp/+circe.el create mode 100644 lisp/+consult.el create mode 100644 lisp/+defaults.el create mode 100644 lisp/+dired.el create mode 100644 lisp/+eshell.el create mode 100644 lisp/+init.el create mode 100644 lisp/+lisp.el create mode 100644 lisp/+org.el create mode 100644 lisp/+setup.el create mode 100644 lisp/+util.el delete mode 100644 lisp/acdw-apheleia.el delete mode 100644 lisp/acdw-autoinsert.el delete mode 100644 lisp/acdw-bell.el delete mode 100644 lisp/acdw-browse-url.el delete mode 100644 lisp/acdw-circe.el delete mode 100644 lisp/acdw-compat.el delete mode 100644 lisp/acdw-consult.el delete mode 100644 lisp/acdw-cus-edit.el delete mode 100644 lisp/acdw-erc.el delete mode 100644 lisp/acdw-eshell.el delete mode 100644 lisp/acdw-eww.el delete mode 100644 lisp/acdw-fonts.el delete mode 100644 lisp/acdw-frame.el delete mode 100644 lisp/acdw-irc.el delete mode 100644 lisp/acdw-lisp.el delete mode 100644 lisp/acdw-modeline.el delete mode 100644 lisp/acdw-org.el delete mode 100644 lisp/acdw-re.el delete mode 100644 lisp/acdw-reading.el delete mode 100644 lisp/acdw-setup.el delete mode 100644 lisp/acdw-ytel.el delete mode 100644 lisp/chd.el delete mode 100644 lisp/titlecase.el diff --git a/.gitignore b/.gitignore index 13a372e..7aed89c 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,6 @@ racket-mode/ server/ straight/ transient/ -var/ \ No newline at end of file +var/ +.etc/ +old/ diff --git a/README.org b/README.org deleted file mode 100644 index 44b3f6c..0000000 --- a/README.org +++ /dev/null @@ -1,30 +0,0 @@ -#+TITLE: My Emacs configuration -#+AUTHOR: Case Duckworth - -This is my Emacs configuration. There are many like it, but this one is mine. - -* Files of interest - -- {early-,}init.el :: … why we're here -- gnus.el :: not used any more -- eshell.el :: like gnus.el, but for eshell. Might be really stupid. -- lisp/*.el :: my extras. - -At /some/ point, I'll move my bespoke stuff from lisp/ to acdw/, and add a -compat/ directory for compatibility files (i.e., repeat.el). Until then, -bleh. It works. - -* License - -Unless otherwise specified, all files under this directory are licensed under -my own /Good Choices License/, the entire text of which is copied here. - -#+begin_example -Everyone is permitted to do whatever with this software, without -limitation. This software comes without any warranty whatsoever, -but with two pieces of advice: - -- Be kind to yourself. - -- Make good choices. -#+end_example diff --git a/TODO.org b/TODO.org deleted file mode 100644 index bd146a8..0000000 --- a/TODO.org +++ /dev/null @@ -1,230 +0,0 @@ -#+TITLE: TODO stuff for emacs config -#+SUBTITLE: Yes I have one of these… -#+AUTHOR: Case Duckworth - -* Packages - -** DONE insert-kaomoji - -- [X] Add =(¬‿¬)═ɜ ɛ═(⌐‿⌐ )= to list -- [X] and =▬▬▬▬▬▬▬▋ Ò╭╮Ó= -- [X] Clean up code and package it properly - -*** DONE FIX the damn thing Ò╭╮Ó - -I just have to make sure it's loading correctly in my own config… bleh - -- and add: - - [X] =ヽ(°〇°)ﾉ= - - [X] =୧((#Φ益Φ#))୨= - - [X] =(╥﹏╥)= - - [X] =Σ ◕ ◡ ◕= - - [X] =╭∩╮（︶_︶）╭∩╮= - - [X] =(งツ)ว= - - [X] =ʕ ᴖᴥᴖʔ= - -** TODO =append-scratch= mode or something - -- save the scratch buffer at times (see [[https://github.com/Fanael/persistent-scratch][GitHub - Fanael/persistent-scratch]], - [[https://umarahmad.xyz/blog/quick-scratch-buffers/][Quick persistent scratch buffers]]), but *IMPORTANTLY* - + append-only to persistent file - + have a keybinding to save buffer to file, then clear buffer - + =persistent-scratch-save-to-file= ? - -- *NO WAIT* just add a function to interface with the previous scratch buffers. - -** TODO keep-acs (name?) - -- keepassxc-cli -- interface with emacs -- plug into =auth-sources= - -** TODO banish-mouse-x - -allow more configuration of where the mouse goes: - -- '(banish . corner) -- '(banish . (x . y)) -- … - -** TODO add functionality to =electric-cursor-mode= - -- Enable idle cursor changing, dependent on mode -- see [[https://www.emacswiki.org/emacs/cursor-chg.el][cursor-chg.el]] - -* Configuring - -** DONE Install =el-patch=? - -** DONE Look at [[https://gitlab.com/ideasman42/emacs-mode-line-idle][ideasman42 / emacs-mode-line-idle]] - -** TODO Look into =which-key= [[https://github.com/justbur/emacs-which-key#2017-12-13-added-which-key-enable-extended-define-key][bind naming]] - -** TODO Look at [[https://github.com/karthink/.emacs.d/blob/master/lisp/setup-icomplete.el#L768][embark-complete setup]] - -from karthink (and prot) - -** TODO [[https://github.com/ahungry/md4rd][md4rd]] - -** DONE [[https://github.com/gRastello/ytel][ytel]] - -** TODO [[https://passionsplay.com/blog/create-minimal-emacs-environments-with-a-shell-script/][Create Minimal Emacs Environments with a Shell Script]] - -** DONE Twitch IRC - -- [[https://gist.github.com/hunterbridges/ab095066d40f2e1a243e][How to connect to Twitch with an IRC client (As of Oct 2015) · GitHub]] -- irc.twitch.tv - -** TODO Figuire out “boring”-aware =consult-buffer= - -- call boring-aware with =C-x b= -- call normal with =C-u C-x b= -- look at =consult--source-buffer= and define one there - -** TODO Fix =title-case= to work with “hard” spaces - -e.g., “A gold watch” title-cases to “A gold Watch” - -* Productivity - -** TODO LOOK AT [[https://github.com/odeke-em/drive][DRIVE]] - -- google drive go client -- can pull to txt/docx/whatev -- can =drive push -convert= to docs format -- :OOOOOO this would be HOUGHE - -** TODO Set up Org Capture - -*** Inspo: From wsinatra - -#+begin_src emacs-lisp - ;; Custom capture templates - (setq org-capture-templates - '(("t" "Todo" entry (file org-default-notes-file) - "* TODO %?\n%u\n%a\n" - :clock-in t :clock-resume t) - ("e" "Event" entry (file org-default-notes-file) - "* EVENT %? :EVENT:\n%t" - :clock-in t :clock-resume t) - ("i" "Idea" entry (file org-default-notes-file) - "* %? :IDEA: \n%t" - :clock-in t :clock-resume t) - ("p" "Project" - entry (file org-default-notes-file) - "* PROJ %?\n%u\n%a\n" - :clock-in t :clock-resume t) - ("n" "Next Task" - entry (file+headline org-default-notes-file "Tasks") - "** NEXT %? \nDEADLINE: %t"))) - #+end_src - -*** Also cf. [[https://blog.jethro.dev/posts/org_mode_workflow_preview/][Org-mode Workflow: A Preview · Jethro Kuan]] - -* Buffer display stuff - -#+begin_src emacs-lisp - ;; from alphapapa - (cl-defun ap/display-buffer-in-side-window (&optional (buffer (current-buffer))) - "Display BUFFER in dedicated side window." - (interactive) - (let ((display-buffer-mark-dedicated t)) - (display-buffer-in-side-window buffer - '((side . right) - (window-parameters - (no-delete-other-windows . t)))))) - #+end_src - -- [[https://old.reddit.com/r/emacs/comments/pka1sm/my_first_package_aside_for_easier_configuration/][My first package: Aside, for easier configuration and use of side windows : - emacs]] -- [[https://github.com/alphapapa/burly.el][GitHub - alphapapa/burly.el: Save and restore frames and windows with their - buffers in Emacs]] -- [[https://depp.brause.cc/shackle/][shackle: Enforce rules for popup windows]] - - [[https://github.com/kaushalmodi/.emacs.d/blob/master/setup-files/setup-shackle.el][.emacs.d/setup-shackle.el at master · kaushalmodi/.emacs.d · GitHub]] - - [[https://www.reddit.com/r/emacs/comments/3icpv8/help_with_shackle_configuration/][help with shackle configuration : emacs]] - - [[https://mullikine.github.io/posts/making-shackle-split-sensibly/][Sensible Splits: Extending shackle.el // Bodacious Blog]] - - [[https://news.ycombinator.com/item?id=18598863][Oh man, your link led me to shackle[1] to make transient buffers behave and - I ha... | Hacker News]] - - [[https://emacsninja.com/posts/design-is-hard.html][Emacs Ninja - Design Is Hard]] -- Alternatively: [[https://web.archive.org/web/20160409014815/https://www.lunaryorn.com/2015/04/29/the-power-of-display-buffer-alist.html][Emacs Spotlight: Configure buffer display - Emacs. What else?]] - -* Random shit - -** A way to map over buffers - -#+begin_src emacs-lisp - (dolist (buf (mapcan - (lambda (buf) - (with-current-buffer buf - (circe-server-chat-buffers))) - (circe-server-buffers))) - (with-current-buffer buf ;; whatever u wanna do on each buffer goes here - (lui-set-prompt (concat - (propertize - (acdw-irc/margin-format (buffer-name) - "" - ">") - 'face 'circe-prompt-face - 'read-only t - 'intangible t - 'cursor-intangible t) - " ")) - (setq-local fringes-outside-margins t - right-margin-width 5 - scroll-margin 0 - word-wrap t - wrap-prefix (repeat-string acdw-irc/left-margin " ") - line-number-mode nil))) -#+end_src - -** ZNC Connecting (from #systemcrafters) - -#+begin_quote -daviwil | minikN: I connect to the hostname/port of my ZNC server, but the - trick is that the username is the nick you want to use on the - server and the password is your znc username and password joined - with a colon, like daviwil:b4dp4ssw0rd - minikN | so you don't specify the network in your password? like - user/network:password? -benoitj | daviwil: nice password you have there -daviwil | minikN: nope, I only have one network anyway -- acdw > daviwil: I just see ******* -benoitj | I use two networks -#+end_quote - -** Teach =link-hint= about =lui-buttons= - -See =lui-next-button-or-complete=, etc. Also possibly: -- [[https://github.com/abo-abo/avy/issues/255][Feature request: ability to select objects in overlays · Issue #255 · abo-abo/avy · GitHub]] -- [[https://github.com/noctuid/link-hint.el/issues/24][Enhancement: Detect links in overlays · Issue #24 · noctuid/link-hint.el · - GitHub]] - - -(I /think/ a button is an overlay….) - -** Write =self-promote-shamelessly= function - -Link to the line of a file on a git forge with a command, for linking. - -https://tildegit.org/acdw/emacs/src/branch/main/init.el#L1166, e.g. - -- *OR* install this: [[https://github.com/sshaw/git-link][GitHub - sshaw/git-link: Emacs package to get the GitHub/Bitbucket/GitLab/... URL for a buffer location]] - -** DONE Fix =acdw-org/count-words-stupidly= - -It adds one for blank lines. - -** TODO [[https://stackoverflow.com/questions/25161792/emacs-org-mode-how-can-i-fold-everything-but-the-current-headline][Org mode hide all but current heading]] - -** Work around =C-m=, =RET=, etc - -#+begin_src emacs-lisp - ;; from artefact - - (define-key key-translation-map (kbd "") nil) - (define-key key-translation-map (kbd "C-m") nil) - (define-key key-translation-map (kbd "RET") nil) - (global-set-key (kbd "") 'newline) - (define-key erc-mode-map (kbd "") 'erc-send-current-line) - (global-set-key (kbd "C-m") (lambda () (interactive) (message "hello from C-m"))) -#+end_src diff --git a/early-init.el b/early-init.el index 64bf3cc..ccd1ff4 100644 --- a/early-init.el +++ b/early-init.el @@ -1,135 +1,76 @@ ;;; early-init.el -*- lexical-binding: t; coding: utf-8-unix -*- -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> + +;; Author: Case Duckworth ;; Created: Sometime during Covid-19, 2020 ;; 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. + +;; Everyone is permitted to do whatever they like with this software +;; without limitation. This software comes without any warranty +;; whatsoever, but with two pieces of advice: +;; - Be kind to yourself. ;; - Make good choices. -;;; Comentary: -;; Starting with Emacs 27.1, `early-init' is sourced before `package' -;; or any frames. So those are the settings I run in this file. +;;; Commentary: + +;; Starting with Emacs 27.1, early-init.el is sourced before +;; package.el and any graphical frames. In this file, I set up frame +;; parameters and packaging infrastructure. ;;; Code: -;;; Add `acdw.el' -(push (expand-file-name "lisp/" user-emacs-directory) - load-path) +(push (locate-user-emacs-file "lisp") load-path) +(add-to-list 'load-path (locate-user-emacs-file "lisp/compat") :append) + (require 'acdw) -(require 'acdw-frame) - -;;; Frame settings -(when (acdw/system :home) - (setq initial-frame-alist '((fullscreen . maximized)))) - -(setq default-frame-alist - `((tool-bar-lines . 0) - (menu-bar-lines . 0) - (vertical-scroll-bars . nil) - (horizontal-scroll-bars . nil) - ;; (width . 84) - ;; (height . 30) - (left-fringe . 8) - (right-fringe . 8) - (font . ,(acdw/system - (:home "DejaVu Sans Mono 10") - (:work "Consolas 12") - (:other "monospace 10")))) + +(+define-dir .etc (locate-user-emacs-file ".etc") + "Directory for all of Emacs's various files. +See `no-littering' for examples.") + +(+define-dir sync/ (expand-file-name "~/Sync") + "My Syncthing directory.") + +;;; Default frame settings + +(setq default-frame-alist '((tool-bar-lines . 0) + (menu-bar-lines . 0) + (vertical-scroll-bars) + (horizontal-scroll-bars)) frame-inhibit-implied-resize t - frame-resize-pixelwise t - inhibit-x-resources t) - -(add-hook 'after-init-hook - (defun after-init@disable-ui-modes () - "Disable UI modes after init. -I already disable them from the `default-frame-alist' for speed -and anti-flickering reasons, but this function allows running, -say, `tool-bar-mode' once to toggle the tool bar back on." - (dolist (mode ;; each mode is of the form (MODE . FRAME-ALIST-VAR) - '((tool-bar-mode . tool-bar-lines) - (menu-bar-mode . menu-bar-lines) - (scroll-bar-mode . vertical-scroll-bars) - (horizontal-scroll-bar-mode . horizontal-scroll-bars))) - (let ((setting (alist-get (cdr mode) default-frame-alist))) - (when (or (not setting) - (zerop setting)) - (funcall (car mode) -1)))))) - -(add-hook 'after-make-frame-functions - (defun after-make-frame@setup (&rest args) - (ignore args) - (let ((fixed-pitch-faces - '((:font "Fantasque Sans Mono" :height 115) - (:font "Go Mono" :height 110) - (:font "DejaVu Sans Mono" :height 110) - (:font "monospace" :height 100))) - (variable-pitch-faces - '((:font "Inter" :height 120) - (:font "Go" :height 120) - (:font "sans-serif" :height 100)))) - (acdw/set-first-face-attribute 'default - fixed-pitch-faces) - (acdw/set-first-face-attribute 'fixed-pitch - fixed-pitch-faces) - (acdw/set-first-face-attribute 'variable-pitch - variable-pitch-faces)) - (acdw/set-emoji-fonts "Noto Color Emoji" - "Noto Emoji" - "Segoe UI Emoji" - "Apple Color Emoji" - "FreeSans" - "FreeMono" - "FreeSerif" - "Unifont" - "Symbola") - (acdw/set-fringes '((left-curly-arrow [#b01100000 - #b00110000 - #b00011000 - #b00001100] - 4 8 center) - (right-curly-arrow [#b00000011 - #b00000110 - #b00001100 - #b00011000] - 4 8 center) - (left-arrow [#b01100000 - #b01010000] - 2 8 (top t)) - (right-arrow [#b00000011 - #b00000101] - 2 8 (top t)))) - (setq indicate-empty-lines nil - indicate-buffer-boundaries '((top . right) - (bottom . right))) - (custom-set-faces '(fringe ((t (:foreground "dim gray"))))))) -(add-hook 'server-after-make-frame-hook #'after-make-frame@setup) - -;; I have this here because ... the first frame doesn't ? run ? the hook ??? -(add-function :after after-focus-change-function - (defun after-focus-change@first-frame-setup (&rest args) - (ignore args) - (after-make-frame@setup) - (remove-function after-focus-change-function - #'after-focus-change@first-frame-setup))) - -;;; Bootstrap package manager (`straight.el') - -;; Set `package' and `straight' variables. + frame-resize-pixelwise t + window-resize-pixelwise t + inhibit-x-resources t + indicate-empty-lines nil + indicate-buffer-boundaries '((top . right) + (bottom . right))) + +;; Fonts +(let ((font-name "Go Mono") + (font-size 105)) + (set-face-attribute 'default nil :family font-name + :height font-size :weight 'book) + (set-face-attribute 'italic nil :family font-name + :height font-size :slant 'italic)) + +;;; Packages + (setq package-enable-at-startup nil package-quickstart nil straight-host-usernames '((github . "duckwork") - (gitlab . "acdw")) - straight-base-dir (acdw/dir) - straight-check-for-modifications '(check-on-save find-when-checking)) + (gitlab . "acdw")) + straight-check-for-modifications '(check-on-save + find-when-checking)) + +(setq no-littering-etc-directory .etc + no-littering-var-directory .etc + straight-base-dir .etc) + +;; Bootstrap straight.el +;; https://github.com/raxod502/straight.el -;; Bootstrap `straight'. (defvar bootstrap-version) (let ((bootstrap-file (expand-file-name @@ -146,44 +87,30 @@ say, `tool-bar-mode' once to toggle the tool bar back on." (eval-print-last-sexp))) (load bootstrap-file nil 'nomessage)) -;; Helper package, good commands here. +;; Early-loaded packages -- those that, for some reason or another, +;; need to be ensured to be loaded first. + (require 'straight-x) -;; Appendix. Get rid of a dumb alias. -;; straight-ಠ_ಠ-mode really slows down all minibuffer completion functions. -;; Since it's a (rarely-used, even) alias anyway, I just define it back to nil. -;; By the way, the alias is `straight-package-neutering-mode'. -(defalias 'straight-ಠ_ಠ-mode nil) +(dolist (pkg '(el-patch + no-littering + setup)) + (straight-use-package pkg) + (require pkg) + (require (intern (format "+%s" pkg)) nil :noerror)) -;;; Message startup time for profiling -;; This just redefines the Emacs function -;; `display-startup-echo-area-message', so no hooks needed. -(defun display-startup-echo-area-message () - "Show Emacs's startup time in the message buffer. For profiling." - (message "Emacs ready in %s with %d garbage collections." - (format "%.2f seconds" - (float-time (time-subtract after-init-time - before-init-time))) - gcs-done)) - -;;; Early-loaded packages -;; These packages are here because they need to be loaded /before/ -;; everything else in init.el. - -(straight-use-package '(setup - :host nil - :repo "https://git.sr.ht/~pkal/setup")) -(require 'setup) -(require 'acdw-setup) - -(setup (:straight no-littering) - (:option no-littering-etc-directory (acdw/dir) - no-littering-var-directory (acdw/dir)) - (require 'no-littering)) - -(setup (:straight el-patch)) - -;; My private variables and stuff -(require 'private (acdw/sync-dir "private") :noerror) +;;; Appendix +;; I've patched setup to look at `setup-ensure-function-inhibit' to decide +;; whether to ensure functions or not with local macros. +(setq setup-ensure-function-inhibit t) + +;; Get rid of a dumb alias. straight-ಠ_ಠ-mode really slows down all +;; minibuffer completion functions. Since it's a (rarely-used, even) +;; alias anyway, I just define it back to nil. By the way, the alias +;; is `straight-package-neutering-mode'. +(defalias 'straight-ಠ_ಠ-mode nil) + +(provide 'early-init) ;;; early-init.el ends here + diff --git a/eshell.el b/eshell.el deleted file mode 100644 index c6d8e16..0000000 --- a/eshell.el +++ /dev/null @@ -1,83 +0,0 @@ -;;; eshell.el --- eshell-specific configuration -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Case Duckworth - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> - -;;; Commentary: - -;; Much like ~/.emacs.d/gnus.el, this is eshell-specific configuration that's -;; loaded whenever `eshell' is loaded. - -;;; Code: - -(require 'setup) -(require 'eshell) -(require 'em-alias) - -;;; Environment -(setenv "PAGER" "cat") - -;;; Aliases - -(dolist (definition '(("e" . "find-file $1") - ("ff" . "find-file $1") - ("emacs" . "find-file $1") - ("ee" . "find-file-other-window $1"))) - (cl-letf (((symbol-function 'eshell-write-aliases-list) #'ignore)) - (eshell/alias (car definition) (cdr definition)))) -(eshell-write-aliases-list) - -;;; Functions - -;; https://karthinks.com/software/jumping-directories-in-eshell/ -(defun eshell/z (&optional regexp) - "Navigate to a previously visited directory in eshell, or to -any directory proferred by `consult-dir'." - (let ((eshell-dirs (delete-dups - (mapcar 'abbreviate-file-name - (ring-elements eshell-last-dir-ring))))) - (cond - ((and (not regexp) (featurep 'consult-dir)) - (let* ((consult-dir--source-eshell `(:name "Eshell" - :narrow ?e - :category file - :face consult-file - :items ,eshell-dirs)) - (consult-dir-sources (cons consult-dir--source-eshell - consult-dir-sources))) - (eshell/cd (substring-no-properties - (consult-dir--pick "Switch directory: "))))) - (t (eshell/cd (if regexp (eshell-find-previous-directory regexp) - (completing-read "cd: " eshell-dirs))))))) - -;;; Extra eshell packages - -(setup (:straight esh-autosuggest) - (:hook-into eshell-mode)) - -(setup (:straight eshell-syntax-highlighting) - (eshell-syntax-highlighting-global-mode +1)) - -(setup (:straight-when fish-completion - (executable-find "fish")) - (:autoload global-fish-completion-mode) - (global-fish-completion-mode +1)) - -(setup (:straight-when eshell-vterm - (require 'vterm nil :noerror)) - (eshell-vterm-mode +1) - (defalias 'eshell/v 'eshell-exec-visual)) - -;;; Miscellaneous - -;; Fix modeline -(when (boundp 'simple-modeline--mode-line) - (setq mode-line-format '(:eval simple-modeline--mode-line))) - -(provide 'eshellrc) -;;; eshell.el ends here - -;; Local Variables: -;; flymake-inhibit: t -;; End: diff --git a/gnus.el b/gnus.el deleted file mode 100644 index 7a2cdc7..0000000 --- a/gnus.el +++ /dev/null @@ -1,156 +0,0 @@ -;;; gnus.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: Sometime during Covid-19, 2020 -;; 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. - -;;; Code: - -;;; Private files -(acdw/require-private) - -;;; Select Methods -(setq gnus-select-method '(nnnil "")) - -(add-hook 'gnus-started-hook - (defun gnus-startup@feed-setup () - (cond ((fboundp #'gnus/init-feed-list) - (gnus/init-feed-list)) - ((and (fboundp #'gnus/import-feed-list) - (file-exists-p (expand-file-name - "feeds.txt" user-emacs-directory))) - (gnus/import-feed-list (expand-file-name - "feeds.txt" user-emacs-directory))) - (t (message "Oops, no feeds :/"))))) - -;;; Gnus cloud -(setq gnus-cloud-storage-method nil ; Don't always have GPG or gzip - gnus-cloud-covered-servers '("nntp:news.tilde.club" - "nntp:news.gwene.org" - "nntp:news.gmane.io")) -(add-hook 'gnus-started-hook #'gnus-cloud-download-all-data) -(add-hook 'gnus-exit-gnus-hook #'gnus-cloud-upload-all-data) - -;;; Gnus behavior options -(setq gnus-gcc-mark-as-read t - message-signature (or (file-exists-p message-signature-file) - "~ acdw") - gnus-startup-file (expand-file-name "newsrc" gnus-home-directory) - gnus-save-newsrc-file nil - gnus-read-newsrc-file nil - gnus-read-active-file 'some - gnus-always-read-dribble-file t - gnus-interactive-exit nil - gnus-use-cache t) - -;; Keybindings -(define-key gnus-group-mode-map (kbd "q") - (defun gnus-cloud-upload-and-bury-buffer () - (interactive) - (gnus-cloud-upload-all-data) - (bury-buffer))) -(define-key gnus-group-mode-map (kbd "Q") #'gnus-group-exit) -(define-key gnus-group-mode-map (kbd "C-q") #'gnus-group-quit) - -;;; Other parameters -(setq gnus-parameters - '(("fastmail.com:.*" - (display . 200) - (expiry-wait . immediate) - (expiry-target . "nnimap+fastmail.com:Archive")))) - -;;; Gnus UI options -(setq gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-date - (not gnus-thread-sort-by-number)) - gnus-use-cache t - gnus-summary-thread-gathering-function #'gnus-gather-threads-by-subject - gnus-thread-hide-subtree t - gnus-thread-ignore-subject t - gnus-html-frame-width fill-column) - -(when window-system - (setq gnus-sum-thread-tree-indent " ") - (setq gnus-sum-thread-tree-root "● ") - (setq gnus-sum-thread-tree-false-root "○ ") - (setq gnus-sum-thread-tree-single-indent "◎ ") - (setq gnus-sum-thread-tree-vertical "│") - (setq gnus-sum-thread-tree-leaf-with-other "├─ ") - (setq gnus-sum-thread-tree-single-leaf "╰─ ")) - -(setq gnus-summary-line-format - (concat - "%0{%U%R%z%}" - "%3{│%}" "%1{%d%}" "%3{│%}" ; date - " " - "%4{%-20,20f%}" ; name - " " - "%3{│%}" - " " - "%1{%B%}" - "%s\n")) - -(setq gnus-summary-display-arrow t) - -(add-hook 'gnus-group-mode-hook #'hl-line-mode) -(add-hook 'gnus-article-mode-hook #'acdw/reading-mode) - -;;; MIME types -(setq mm-discouraged-alternatives '("text/html" - "text/richtext")) - -(with-eval-after-load 'mailcap - (cond ((eq system-type 'darwin)) - ((eq system-type 'windows-nt)) - (t (mailcap-parse-mailcaps)))) - -;;; Composing mail -(add-hook 'message-mode-hook - (defun message-mode@setup () - (flyspell-mode +1) - (local-set-key (kbd "TAB") #'bbdb-complete-mail))) - -;;; Packages - -;; searching (?) -(require 'nnir) - -;; contacts -(setup (:straight bbdb) - (require 'bbdb) - (bbdb-initialize 'message 'gnus 'mail) - (bbdb-insinuate-message) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - (:option bbdb/gnus-summary-prefer-real-names t - bbdb/mail-auto-create-p t - bbdb/news-auto-create-p t - bbdb-use-pop-up t - bbdb-offer-save 1 - bbdb-update-records-p t)) - -;;; Functions -;; see https://wpc.io/blog/posts/bulk-import-rss-feeds-to-gnus-via-gwene.html -(defun gnus/slurp (file) - "Read FILE into a string." - (with-temp-buffer - (insert-file-contents file) - (buffer-substring-no-properties - (point-min) - (point-max)))) - -(defun gnus/import-feed-list (path) - "Import list of NNTP feeds from file at PATH." - (interactive "F") - (let ((feeds (split-string (gnus/slurp path) "\n" t))) - (cl-loop for feed in feeds - do (with-message (format "Subscribing to %s" feed) - (gnus-subscribe-group feed))))) diff --git a/init.el b/init.el index c2fbadf..abd40fe 100644 --- a/init.el +++ b/init.el @@ -1,262 +1,47 @@ -;;; init.el -*- lexical-binding: t; coding: utf-8-unix -*- +;;; init.el --- Emacs initiation file -*- lexical-binding: t -*- -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> +;; Author: Case Duckworth ;; Created: Sometime during Covid-19, 2020 ;; Keywords: configuration ;; URL: https://tildegit.org/acdw/emacs -;; Bankruptcy: 7 - -;; This file is NOT part of GNU Emacs. +;; Bankruptcy: 8 ;;; 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: - +;; Everyone is permitted to do whatever they like with this software +;; without limitation. This software comes without any warranty +;; whatsoever, but with two pieces of advice: ;; - Be kind to yourself. - ;; - Make good choices. -;;; Commentary: - -;; Some of the names in these `setup' forms are arbitrary. - ;;; Code: -(setup (:require auth-source) - (:option auth-sources (list (acdw/sync-dir "authinfo") - (acdw/sync-dir "authinfo.gpg") - "~/.authinfo" - "~/.authinfo.gpg"))) - -(setup (:require goto-addr) - (if (fboundp #'global-goto-address-mode) - (global-goto-address-mode) - (add-hook 'after-change-major-mode-hook #'goto-address-mode))) - -(setup (:require recentf) - (:option recentf-save-file (acdw/dir "recentf.el") - recentf-max-menu-items 100 - recentf-max-saved-items nil - recentf-auto-cleanup 'mode - (append recentf-exclude) (acdw/dir)) - - (:advise dired-rename-file :after #'rjs/recentf-rename-notify) - - (recentf-mode +1)) - -(setup (:require savehist) - (:option history-length t - history-delete-duplicates t - savehist-autosave-interval 60 - savehist-file (acdw/dir "savehist.el")) - - (dolist (var '(extended-command-history - global-mark-ring - kill-ring - regexp-search-ring - search-ring - mark-ring)) - (:option (append savehist-additional-variables) var)) - - (savehist-mode +1)) - -(setup (:require server) - (unless (server-running-p) - (server-start))) - -(setup (:require tramp) - ;; thanks Irreal! https://irreal.org/blog/?p=895 - (add-to-list 'tramp-default-proxies-alist - '(nil "\\`root\\'" "/ssh:%h:")) - (add-to-list 'tramp-default-proxies-alist - '((regexp-quote (system-name)) nil nil))) - -(setup Info - (:hook #'variable-pitch-mode - #'reading-mode)) - -(setup abbrev - (:option abbrev-file-name "~/Sync/abbrev.el" - save-abbrevs 'silent) - (:hook-into text-mode - circe-chat-mode)) - -(setup acdw - (:also-load acdw-compat - acdw-lisp - acdw-reading) - - (:option user-full-name "Case Duckworth" - user-mail-address (rot13-string "npqj@npqj.arg")) - - (when-let ((default-directory - (expand-file-name-exists-p "pkg/" user-emacs-directory))) - (normal-top-level-add-subdirs-to-load-path))) - -(setup auto-fill - (:hook (defun auto-fill@truncate-lines () - (setq-local truncate-lines t)))) - -(setup autoinsert - (require 'acdw-autoinsert) - (acdw/define-auto-insert '(:replace t) - ;; This is my custom auto-insert for elisp files. - '("\\.el\\'" . "Emacs Lisp header (acdw)") - '("Short description: " ";;; " - (file-name-nondirectory (buffer-file-name)) - " --- " str - (make-string (max 2 ( - fill-column (current-column) 27)) 32) - "-*- lexical-binding: t; -*-" - '(setq lexical-binding t) - "\n\n;; Copyright (C) " (format-time-string "%Y") - " " (getenv "ORGANIZATION") | (progn user-full-name) - "\n\n;; Author: " (user-full-name) - '(if (search-backward "&" (line-beginning-position) t) - (replace-match (capitalize (user-login-name)) t t)) - '(end-of-line 1) - " <" (progn user-mail-address) ">" - & -2 - "\n\n;;; License:" - "\n\n;; Everyone is permitted to do whatever with this software, without" - "\n;; limitation. This software comes without any warranty whatsoever," - "\n;; but with two pieces of advice:" - "\n\n;; - Be kind to yourself." - "\n\n;; - Make good choices." - "\n\n;;; Commentary:" - "\n\n;; " _ - "\n\n;;; Code:" - "\n\n\n\n(provide '" (file-name-base (buffer-file-name)) ")" - "\n;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")) - (auto-insert-mode +1)) - -(setup autorevert - (:option global-auto-revert-non-file-buffers t - auto-revert-verbose nil) - (global-auto-revert-mode +1)) +;; Require early-init.el just in case it hasn't been yet. +(require 'early-init (locate-user-emacs-file "early-init.el") :noerror) +;; Requre my private stuff +(require 'private) -(setup browse-url - (:require acdw-browse-url) - - (:option browse-url-secondary-browser-function - (if (executable-find "firefox") ; prefer Firefox - #'browse-url-firefox - #'browse-url-default-browser) - browse-url-new-window-flag nil ; for eww - browse-url-firefox-arguments '("--new-tab") ; for firefox - browse-url-firefox-new-window-is-tab t) - - (acdw/browse-url-set-handlers - (list - (cons (rx (seq "." (or "jpeg" "jpg" ; images - "png") - eos)) - (lambda (&rest args) - (apply - (cond ((executable-find "feh") #'browse-url-feh) - ((executable-find "mpv") - (defun browse-image-url-mpv (url &rest _args) - "View an image URL in mpv." - (let ((url (browse-url-encode-url url)) - (process-environment - (browse-url-process-environment))) - (message "Viewing %s in mpv..." url) - (apply #'start-process - (concat "mpv " url) nil - "mpv" - (append browse-url-mpv-arguments - (list "--image-display-duration=inf" - url)))))) - (t #'eww-browse-url)) - args))) - (cons (rx (or "youtube.com" ; videos - "youtu.be" - (seq "." (or "mp4" - "gif" - "mov" "MOV") - eos))) - (lambda (&rest args) - (apply (if (executable-find "mpv") - #'browse-url-mpv - browse-url-secondary-browser-function) - args))) - (cons (rx (or "google.com" ; websites that don't work with eww - "reddit.com" - "twitter.com" - "imgur.com" - "pixelfed" - "taskiq")) - browse-url-secondary-browser-function) - (cons "." ; everything else - #'eww-browse-url))) - - ;; Buttonize gemini:// links. - (acdw/add-button-url-regexp-protocol "gemini")) +(setup (:require +defaults)) -(setup buffers - (:global "C-x k" #'acdw/kill-a-buffer) - ;; Set the right major mode based on buffer name, if not visiting a file. - ;; http://ruzkuku.com/emacs.d.html#orgeab93c3 - (setq-default major-mode (lambda () - (unless buffer-file-name - (let ((buffer-file-name (buffer-name))) - (set-auto-mode)))))) +(setup (:require +init) + (:bind "C-c s" (lambda () + (interactive) + (+init-sort) + (save-buffer))) + (:hook '+init-add-setup-to-imenu)) (setup calendar - (:option calendar-week-start-day 1)) - -(setup completion - (:option completion-ignore-case t - read-buffer-completion-ignore-case t - completion-styles '(substring partial-completion) - completion-category-defaults nil - completion-category-overrides - '((file (styles . (partial-completion))))) - - (:global "M-/" #'hippie-expand)) - -(setup css-mode - (:bind "C-c C-h" #'css-lookup-symbol)) - -(setup cursor - (:option cursor-type 'bar - cursor-in-non-selected-windows 'hollow - blink-cursor-blinks 1) - (blink-cursor-mode +1)) - -(setup cus-edit - (:also-load acdw-cus-edit) - (:option custom-file (acdw/dir "custom.el") - custom-magic-show nil - custom-magic-show-button t - custom-raised-buttons nil - custom-unlispify-tag-names nil - custom-variable-default-form 'lisp) - - ;; I need this to save `safe-local-variables' between Emacs invocations. For - ;; now, of course .... I would /love/ a better solution. - (when (file-exists-p custom-file) - ;; Don't load faces, since those are all set in init.el - (cl-letf (((symbol-function 'custom-set-faces) #'ignore)) - (load custom-file nil nil))) - - ;; `Custom-mode-hook' fires /before/ the widgets are built, so I have to - ;; install advice after the widgets are made. - (:advise custom-buffer-create-internal :after #'acdw-cus/expand-widgets) - - (:with-mode Custom-mode - (:local-set imenu-generic-expression acdw-cus/imenu-generic-expression))) - -(setup debugger - (:hook visual-line-mode)) + (require '_location) + (:option calendar-location-name _location-name + calendar-latitude _location-latitude + calendar-longitude _location-longitude)) (setup dired (:also-load dired-x) - (:straight dired-subtree - dired-collapse - dired-git-info) - + (:also-straight dired-subtree + dired-collapse + dired-git-info + dired+) (:option dired-recursive-copies 'top dired-recursive-deletes 'top dired-create-destination-dirs 'ask @@ -269,1248 +54,255 @@ hardlink load move shell touch symlink) dired-dwim-target t) - - (:bind "TAB" #'dired-subtree-cycle - "i" #'dired-subtree-toggle - ")" #'dired-git-info-mode) - - (:hook dired-collapse-mode - dired-hide-details-mode - hl-line-mode) - - (:global "C-x C-j" #'dired-jump) - + (:bind "TAB" 'dired-subtree-cycle + "i" 'dired-subtree-toggle + ")" 'dired-git-info-mode) + (:hook 'dired-collapse-mode + 'dired-hide-details-mode + 'hl-line-mode) + (:global "C-x C-j" 'dired-jump) (with-eval-after-load 'dired - (acdw/system - (:work (:straight w32-browser) - (autoload #'dired-w32-browser "w32-browser" nil t) - (:bind "RET" #'dired-w32-browser)) - (:home (:straight dired-open) - (autoload #'dired-find-alternate-file "dired-open" nil t) - (:bind "RET" #'dired-find-alternate-file))))) - -(setup disabled - ;; While this stuff is defined in novice.el, I'm using 'disabled' as the name - ;; for easy finding. - - ;; Enable all disabled commands. - ;; This is an option, but I'm going to try /enabling/ just the ones that I - ;; use instead. - ;; (mapatoms (lambda (symbol) - ;; (when (get symbol 'disabled) - ;; (put symbol 'disabled nil)))) - - ;; Enable /some/ disabled commands - (dolist (enable-sym '(narrow-to-region - dired-find-alternate-file - narrow-to-page)) - (put enable-sym 'disabled nil)) - - ;; Now, disable symbols as I wish. - (dolist (disable-sym '(view-hello-file - suspend-frame - scroll-left - scroll-right - comment-set-column - set-fill-column)) - (put disable-sym 'disabled t)) - - ;; And set the disabled function to something better than the default. - ;; Now, I can run any disabled command, but I have to use M-x to do it. - (:option disabled-command-function #'acdw/disabled-command-function)) - -(setup ediff - (:option ediff-diff-options "-w" ; ignore whitespace - ediff-window-setup-function #'ediff-setup-windows-plain - ediff-split-window-function #'split-window-horizontally) - ;; https://oremacs.com/2015/01/17/setting-up-ediff/ - (add-hook 'ediff-after-quit-hook-internal #'winner-undo)) - -(setup eldoc - (:option eldoc-idle-delay 0.1 - eldoc-echo-area-use-multiline-p nil)) - -(setup elec-pair - (electric-pair-mode +1)) - -(setup elisp-mode - (:with-mode emacs-lisp-mode ;; -_- - (:option eval-expression-print-length nil - eval-expression-print-level nil - print-length nil - print-level nil - lisp-indent-function #'lisp-indent-function) - - (:local-set (append imenu-generic-expression) - `("Setup" - ,(rx (seq - (group bol (* space) "(setup" (+ space)) - (? (group "(:" (+ graph) (* space) (? "("))) - (group (+ (any word ?+ ?-))))) - 3)) - - (:hook #'checkdoc-minor-mode - #'turn-on-eldoc-mode) - - ;; Emulate slime's eval binds - (:bind "C-c C-c" #'eval-defun - "C-c C-k" #'acdw/eval-region-or-buffer - "C-c C-z" #'ielm) - - ;; Add advice to pulse evaluated regions - (:advise eval-region :around - (defun eval-region@pulse (fn beg end &rest args) - (let ((pulse-flag t)) - (pulse-momentary-highlight-region beg end)) - (apply fn beg end args)))) - - (:with-mode lisp-interaction-mode ;; -___- - (:bind "C-c C-c" #'eval-defun - "C-c C-k" #'acdw/eval-region-or-buffer - "C-c C-z" #'ielm))) - -(setup emacs - ;; "Et cetera" settings - ;; This should stay as /minimal/ as possible. Anything that can go somewhere - ;; else /should/ go there. - (:option - async-shell-command-display-buffer nil - async-shell-command-buffer #'new-buffer - attempt-orderly-shutdown-on-fatal-signal nil - auto-hscroll-mode 'current-line - attempt-stack-overflow-recovery nil - echo-keystrokes 0.01 - find-function-C-source-directory (acdw/find-emacs-source) - image-use-external-converter (and (not (version< emacs-version "27")) - (or (executable-find "magick") - (executable-find "convert"))) - kill-read-only-ok t - kill-ring-max 500 ; RAM is cheap, right? - mark-ring-max 50 - kmacro-ring-max 20 - search-ring-max 200 - global-mark-ring-max 100 - regexp-search-ring-max 100 - load-prefer-newer t - native-comp-async-report-warnings-errors nil - password-cache t - password-cache-expiry (* 60 5) ; seconds - set-mark-command-repeat-pop t - hscroll-step 1 - scroll-step 1) - - (when (fboundp 'command-completion-default-include-p) - (setq read-extended-command-predicate - #'command-completion-default-include-p)) - - (defvar case-map (make-sparse-keymap) - "A keymap for setting case in various ways.") - (global-set-key (kbd "C-c c") case-map) - - (defvar lookup-map (make-sparse-keymap) - "A keymap for looking up things.") - (global-set-key (kbd "C-c l") lookup-map) - - (:global "M-=" #'count-words - "C-M-;" #'comment-or-uncomment-sexp - "C-w" #'kill-region-or-backward-word - "C-c d" #'acdw/insert-iso-date - "M-`" nil - "C-x o" #'acdw/other-window-or-switch-buffer - "C-x O" #'acdw/other-window-or-switch-buffer-backward - "C-c _" #'add-file-local-variable - "C-x C-c" #'acdw/fat-finger-exit) - - (global-set-key (kbd "M-n") (kbd "C-u 1 C-v")) - (global-set-key (kbd "M-p") (kbd "C-u 1 M-v")) - - ;; inspo: https://github.com/zaeph/.emacs.d/blob/master/init.el#L479 - (defvar toggle-map (make-sparse-keymap) - "A keymap for toggling!") - (global-set-key (kbd "C-c t") toggle-map) - - (:with-map toggle-map - (:bind "c" #'column-number-mode - "l" #'display-line-numbers-mode - "d" #'toggle-debug-on-error - "s" #'so-long-mode - "S" #'scroll-bar-mode)) - - ;; Toggle - (:with-map toggle-map - (:bind "b" (defun acdw/toggle-lexical-binding () - "Toggle `lexical-binding' in the current buffer." - (interactive) - (setq lexical-binding (not lexical-binding)) - (message "Lexical-binding is %sabled." - (if lexical-binding "en" "dis")) - (force-mode-line-update)))) - - - (:with-map case-map - (require 'titlecase) - (require 'acdw) - (:bind "c" #'capitalize-dwim - "t" #'titlecase-dwim - "u" #'upcase-dwim - "l" #'downcase-dwim)) - - (column-number-mode +1)) - -(setup encoding - (:option locale-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - buffer-file-coding-system 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - x-select-request-type '(UTF8_STRING - COMPOUND_TEXT - TEXT - STRING)) - - (set-charset-priority 'unicode) - (set-language-environment "UTF-8") - (prefer-coding-system 'utf-8-unix) - (set-default-coding-systems 'utf-8-unix) - (set-terminal-coding-system 'utf-8-unix) - (set-keyboard-coding-system 'utf-8-unix) - - (acdw/system - (:work (set-clipboard-coding-system 'utf-16-le) - (set-selection-coding-system 'utf-16-le)) - (_ (set-selection-coding-system 'utf-8) - (set-clipboard-coding-system 'utf-8)))) + (pcase system-type + ((or 'ms-dos 'windows-nt) + (:straight w32-browser)) + ((or 'gnu/linux) + (:straight dired-open) + (:option dired-listing-switches + (concat dired-listing-switches " -F"))))) + (with-eval-after-load 'frowny + (add-to-list 'frowny-inhibit-modes 'dired-mode))) (setup eshell - (:also-load acdw-eshell + (:also-load +eshell em-smart em-tramp) - - (:option eshell-aliases-file (acdw/dir "eshell/aliases" t) + (:option eshell-aliases-file (.etc "eshell/aliases" t) eshell-destroy-buffer-when-process-dies t - eshell-directory-name (acdw/dir "eshell/" t) + eshell-directory-name (.etc "eshell/" t) eshell-error-if-no-glob t eshell-hist-ignore-dups t eshell-kill-on-exit nil - eshell-prefer-lisp-functions t ; I want to try using eshell - eshell-prefer-lisp-variables t ; as much as possible. + eshell-prefer-lisp-functions t + eshell-prefer-lisp-variables t eshell-review-quick-commands nil eshell-save-history-on-exit t eshell-scroll-to-bottom-on-input 'all eshell-smart-space-goes-to-end t eshell-where-to-jump 'begin) - (:local-set outline-regexp eshell-prompt-regexp page-delimiter eshell-prompt-regexp) - - (:hook #'eshell-arg-hist-mode - (defun eshell-mode@setup () - (require 'eshellrc (locate-user-emacs-file "eshell") :noerror) - (:bind "C-d" #'eshell-quit-or-delete-char)))) - -(setup eww - (:also-load acdw-eww) - (defvar-local eww-readable-p nil - "Whether current buffer is in readable-mode.") - (:option eww-search-prefix "https://duckduckgo.com/html?q=" - url-privacy-level '(email agent cookies lastloc)) - - (defun eww@is-readable (&rest _) - (setq-local eww-readable-p t)) - (defun eww@is-not-readable (&rest _) - (setq-local eww-readable-p nil)) - - (advice-add 'eww-readable :after #'eww@is-readable) - (advice-add 'eww-render :after #'eww@is-not-readable) - (advice-add 'eww-back-url :after #'eww@is-not-readable) - - (:hook #'reading-mode - (defun bookmark-eww--setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'bookmark-eww--make))) - - (:bind "RET" (defun eww/browse-url (arg) - (interactive "P") - (if-let ((url (thing-at-point 'url))) - (browse-url url) - (call-interactively #'acdw/link-hint-open-link))) - "b" #'bookmark-set - "B" #'bookmark-jump - "M-n" nil - "M-p" nil)) - -(setup executable - (:option executable-prefix-env t) - (add-hook 'after-save-hook - #'executable-make-buffer-file-executable-if-script-p)) - -(setup files - (:option auto-save-file-name-transforms `((".*" ,(acdw/dir "auto-save/" t) t)) - auto-save-list-file-prefix (acdw/dir "auto-save-list/.saves-" t) - auto-save-interval 60 - auto-save-timeout 60 - auto-save-visited-interval auto-save-timeout - backup-by-copying t - backup-directory-alist `((".*" . ,(acdw/dir "backup/" t))) - delete-old-versions t - mode-require-final-newline 'visit-save - tramp-backup-directory-alist backup-directory-alist - vc-make-backup-files t - version-control t) - (auto-save-visited-mode +1)) - -(setup find-func - (:global "C-c l f" #'find-function - "C-c l l" #'find-library - "C-c l v" #'find-variable)) - -(setup flymake - ;; TODO: look at flycheck for ideas around `flycheck-disabled-checkers' and - ;; `flycheck-emacs-lisp-load-path'... there must be a way to get flymake to - ;; recognize new values in the load path. - (defvar-local flymake-inhibit nil - "Buffer-local variable to inhibit `flymake'.") - (add-to-list 'safe-local-variable-values '(flymake-inhibit . t)) - (add-to-list 'safe-local-variable-values '(flymake-inhibit . nil)) - - (defvar flymake-inhibit-major-modes nil - "Which major-modes NOT to enable `flymake' in.") - - (defvar flymake-inhibit-file-name-regexps '("init\\.el\\'" - "early-init\\.el\\'") - "List of file regexps NOT to enable `flymake' in.") - - (defvar flymake-inhibit-buffer-name-regexps (list (rx "*scratch*")) - "List of buffer-name regexps NOT to enable `flymake' in.") - - (defun list-string-match-p (string regexp-list) - "Return t if at least one regex in RETGEXP-LIST matches STRING, else nil." - ;; FINE alphapapa ;P - (seq-some (lambda (regexp) - (string-match regexp (or string ""))) - regexp-list)) - - (defun flymake-unless () - "Turn on `flymake-mode', UNLESS it's inhibited. -There are three methods to inhibit flymake in a file. From most -specific to most general, they are these: - -- `flymake-inhibit': a file-local-variable - -- `flymake-inhibit-buffer-name-regexps': a list of regexps to - match the buffer name against. If one of them matches, inhibit - `flymake-mode'. - -- `flymake-inhibit-file-name-regexps': a list of regexps to match - the filename against. If one of them matches, inhibit - `flymake-mode'. - -- `flymake-inhibit-major-modes': a list of major-modes in which - to inhibit `flymake-mode'. Really only useful if you want to - generally add `flymake-mode' to `prog-mode-hook'." - ;; The name of this hook tells you pretty much everything you need to know - ;; for this little thing right here. - (add-hook 'hack-local-variables-hook - (defun flymake-unless@hack-local-variables () - (unless (or (cdr (assoc 'flymake-inhibit - file-local-variables-alist)) - (list-string-match-p - (buffer-name) - flymake-inhibit-buffer-name-regexps) - (list-string-match-p - (buffer-file-name) - flymake-inhibit-file-name-regexps) - (apply #'derived-mode-p - flymake-inhibit-major-modes)) - (flymake-mode-on))))) - - (add-hook 'prog-mode-hook #'flymake-unless) - - (:bind "M-n" #'flymake-goto-next-error - "M-p" #'flymake-goto-prev-error)) - -(setup flyspell - (:hook-into text-mode)) - -(setup frames - (:option frame-title-format '("%b@" - (:eval - (or (file-remote-p default-directory 'host) - system-name)) - " %+%* GNU Emacs" - (:eval (when (frame-parameter nil 'client) - " Client"))) - window-resize-pixelwise t)) - -(setup ibuffer - (:also-load ibuf-ext) - (:option ibuffer-expert t - ibuffer-show-empty-filter-groups nil - ibuffer-saved-filter-groups - '(("default" - ("dired" (mode . dired-mode)) - ("customize" (mode . Custom-mode)) - ("emacs" (or (name . "^\\*scratch\\*$") - (name . "^\\*Messages\\*$") - (name . "^\\*Warnings\\*$") - (name . "^\\*straight-process\\*$") - (name . "^\\*Calendar\\*$"))) - ("git" (or (name . "^\*magit") - (name . "^\magit"))) - ("help" (or (mode . help-mode) - (mode . Info-mode) - (mode . helpful-mode))) - ("messaging" (or (mode . message-mode) - (mode . bbdb-mode) - (mode . mail-mode) - (mode . gnus-group-mode) - (mode . gnus-summary-mode) - (mode . gnus-article-mode) - (name . "^\\.bbdb$") - (name . "^\\.newsrc-dribble") - (mode . erc-mode) - (mode . circe-server-mode) - (mode . circe-channel-mode))) - ("shell" (or (mode . eshell-mode) - (mode . shell-mode) - (mode . vterm-mode))) - ("web" (or (mode . elpher-mode) - (mode . gemini-mode) - (mode . eww-mode)))))) - - (:global "C-x C-b" #'ibuffer) - - (:hook (defun ibuffer@filter-to-default () - (ibuffer-switch-to-saved-filter-groups "default")))) - -(setup ielm - (:hook #'turn-on-eldoc-mode)) - -(setup imenu - (:option imenu-auto-rescan t)) - -(setup isearch - (:option search-default-mode t)) - -(setup lines - (:option fill-column 79 - word-wrap t - truncate-lines nil) - - (global-display-fill-column-indicator-mode -1) - (global-so-long-mode +1) - - (add-hook 'visual-line-mode-hook - (defun acdw/disable-fill-column-indicator () - (display-fill-column-indicator-mode - (if visual-line-mode -1 +1)))) - - ;; `acdw/kill-line-and-join-advice' cribs from `crux-kill-and-join-forward'. - ;; I can't simply advise `kill-line' with an override from crux because crux - ;; itself calls `kill-line', leading to a infinite nesting situation. - (advice-add 'kill-line :around - (defun kill-line@join (fn &rest args) - (if (and (eolp) - (not (bolp))) - (delete-indentation 1) - (apply fn args))))) - -(setup minibuffer - (:option enable-recursive-minibuffers t - file-name-shadow-properties '(invisible t intangible t) - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties - '(read-only t cursor-intangible t face minibuffer-prompt) - read-answer-short t - read-extended-command-predicate ; used on >28 - #'command-completion-default-include-p) - - (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) - - (add-hook 'minibuffer-setup-hook #'acdw/gc-disable) - (add-hook 'minibuffer-exit-hook #'acdw/gc-enable) - - (minibuffer-depth-indicate-mode +1) - (file-name-shadow-mode +1) - (minibuffer-electric-default-mode +1) - - (if (version< emacs-version "28") - (fset 'yes-or-no-p #'y-or-n-p) - (setq use-short-answers t))) - -(setup mouse - ;; Unconditionally follow links when clicked. - ;; This is because mouse-1 usually sets point. - ;; Other options: - ;; +[ms] -> perform mouse-2 until held for [ms], then mouse-1 - ;; -[ms] -> perform mouse-1 until held for [ms], then mouse-2 - ;; 'double -> mouse-2 on double click - ;; nil -> mouse-1 never follows link - ;; -> mouse-1 /always/ follows link - (:option mouse-1-click-follows-link t)) - -(setup mu4e - (:load-from "/usr/share/emacs/site-lisp/mu4e") - (:autoload (mu4e :interactive t) - make-mu4e-context) - (:option message-kill-buffer-on-exit t - message-send-mail-function #'smtpmail-send-it - mu4e-change-filenames-when-moving t - mu4e-completing-read-function 'completing-read - mu4e-compose-context-policy 'ask-if-none - mu4e-context-policy 'ask-if-none - mu4e-contexts - (list - ;; Work - (make-mu4e-context - :name "Work" - :match-func (lambda (msg) - (when msg - (string-prefix-p - work-mail-dir - (mu4e-message-field msg :maildir)))) - :vars `((user-mail-address . ,work-email) - (smtpmail-smtp-server . ,work-smtp-server) - (mu4e-compose-format-flowed . nil) - (mu4e-drafts-folder - . ,(concat work-mail-dir "/[Gmail]/Drafts")) - (mu4e-sent-folder - . ,(concat work-mail-dir "/[Gmail]/Sent Mail")) - (mu4e-refile-dir - . ,(concat work-mail-dir "/[Gmail]/All Mail")) - (mu4e-trash-folder - . ,(concat work-mail-dir "/[Gmail]/Trash")) - (mu4e-maildir-shortcuts - . ,(mapcar (lambda (cell) - (let ((dir (car cell)) - (char (cdr cell))) - (cons (concat work-mail-dir dir) char))) - '(("/Inbox" . ?i) - ("/[Gmail]/All Mail" . ?a) - ("/[Gmail]/Sent" . ?s) - ("/[Gmail]/Drafts" . ?d) - ("/[Gmail]/Trash" . ?t)))))) - ;; Home - (make-mu4e-context - :name "Home" - :match-func (lambda (msg) - (when msg - (string-prefix-p - home-mail-dir - (mu4e-message-field msg :maildir)))) - :vars `((user-mail-address . ,home-email) - (smtpmail-smtp-server . ,home-smtp-server) - (mu4e-compose-signature . "~ Case") - (mu4e-compose-format-flowed . nil) - (mu4e-drafts-folder - . ,(concat home-mail-dir "/Drafts")) - (mu4e-sent-folder - . ,(concat home-mail-dir "/Sent")) - (mu4e-refile-folder - . ,(concat home-mail-dir "/Archive")) - (mu4e-trash-folder - . ,(concat home-mail-dir "/Trash")) - (mu4e-maildir-shortcuts - . ,(mapcar (lambda (cell) - (let ((dir (car cell)) - (char (cdr cell))) - (cons (concat home-mail-dir dir) char))) - '(("/INBOX" . ?i) - ("/Archive" . ?a) - ("/Sent" . ?s) - ("/Drafts" . ?d) - ("/Trash" . ?t))))))) - mu4e-get-mail-command "mbsync -a" - mu4e-maildir "~/mail" - mu4e-update-interval (unless - ;; I just realized... there is probably a - ;; /much/ better way to do this. - (file-exists-p - (expand-file-name - "systemd/user/mbsync.timer" - (getenv "XDG_CONFIG_HOME"))) - (* 60 5)) - sendmail-program (seq-some #'executable-find - '("msmtp" - "sendmail")) - message-sendmail-f-is-evil t - message-sendmail-extra-arguments '("--read-envelope-from") - message-send-mail-function #'smtpmail-send-it - send-mail-function #'smtpmail-send-it - smtpmail-smtp-service 465 - smtpmail-stream-type 'ssl) - - (:with-mode mu4e-view-mode - (:hook #'reading-mode))) - -(setup page - (:option page-delimiter - (rx bol (or "\f" ";;;") - (not (any "#")) (* not-newline) "\n" - (* (* blank) (opt ";" (* not-newline)) "\n"))) - - (defun recenter-to-top (&rest _) - "Recenter the cursor to the top of the window." - (when (called-interactively-p 'any) - (recenter (if (or (null scroll-margin) - (zerop scroll-margin)) - 3 - scroll-margin)))) - - (:advise forward-page :after #'recenter-to-top - backward-page :after #'recenter-to-top) - - ;; I'm not sure where this is in /my/ version of Emacs - ;; (defvar page-navigation-repeat-map - ;; (let ((map (make-sparse-keymap))) - ;; (define-key map "]" #'forward-page) - ;; (define-key map "[" #'backward-page) - ;; map) - ;; "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") - - ;; (put 'forward-page 'repeat-map 'page-navigation-repeat-map) - ;; (put 'backward-page 'repeat-map 'page-navigation-repeat-map) - ) - -(setup prog - (:option show-paren-delay 0 - show-paren-style 'mixed - show-paren-when-point-inside-paren t - show-paren-when-point-in-periphery t - smie-indent-basic tab-width) - - (:hook #'show-paren-mode - #'prettify-symbols-mode - ;; #'electric-pair-local-mode - #'acdw/setup-fringes - #'display-fill-column-indicator-mode - - (defun prog-mode@auto-fill () - (setq-local comment-auto-fill-only-comments t) - (turn-on-auto-fill)))) - -(setup pulse - (:option pulse-flag nil - pulse-delay 0.5 - pulse-iterations 1) - - ;; XXX: this doesn't work yet. I only want to pulse the line in the active - ;; window, so when I have the same buffer viewed in multiple windows I can - ;; still see where my cursor is. To see the issue, C-x 2 then C-x o a few - ;; times. - (defun pulse-line-current-window (&rest _) - "Pulse the current line, but only if this window is active." - (pulse-momentary-highlight-one-line (window-point (selected-window)))) - - (dolist (func '(scroll-up-command - scroll-down-command - recenter-top-bottom - other-window - switch-to-buffer - redraw-frame)) - (advice-add func :after #'pulse-line-current-window))) - -(setup re-builder - (require 'acdw-re) - (:global "C-M-5" #'re-builder - "C-M-%" #'re-builder) - (:with-map reb-mode-map - (:bind "C-c C-k" #'reb-quit - "RET" #'reb-replace-regexp)) - (:with-map reb-lisp-mode-map - (:bind "RET" #'reb-replace-regexp))) - -(setup repeat - ;; new for Emacs 28! - (:only-if (fboundp #'repeat-mode)) - - (:option repeat-exit-key "g" - repeat-exit-timeout 5) - - (repeat-mode +1)) - -(setup saveplace - (:option save-place-file (acdw/dir "places.el") - save-place-forget-unreadable-files (acdw/system :home)) - - (save-place-mode +1)) - -(setup scratch - (:option inhibit-startup-screen t - initial-buffer-choice t - initial-major-mode #'lisp-interaction-mode - lexical-binding t - initial-scratch-message - (concat ";; Howdy, " - (nth 0 (split-string - user-full-name)) - "! " - "Welcome to GNU Emacs.\n\n")) - - (add-hook 'kill-buffer-query-functions - (defun kill-buffer-query@immortal-scratch () - (if (eq (current-buffer) (get-buffer "*scratch*")) - (progn (bury-buffer) - nil) - t)))) - -(setup scrolling - (:option auto-window-vscroll nil - fast-but-imprecise-scrolling t - scroll-margin 3 - scroll-conservatively 101 - scroll-preserve-screen-position 1)) - -(setup selection - (:option save-interprogram-paste-before-kill t - yank-pop-change-selection t - x-select-enable-clipboard t - x-select-enable-primary t - mouse-drag-copy-region t - kill-do-not-save-duplicates t) - - (delete-selection-mode +1)) - -(setup sh-mode - (:option sh-basic-offset tab-width - sh-indent-after-case 0 - sh-indent-for-case-alt '+ - sh-indent-for-case-label 0) - - (:local-set indent-tabs-mode t) - - (when (executable-find "shfmt") - (with-eval-after-load 'apheleia - (:option (append apheleia-formatters) '(shfmt . ("shfmt")) - (append apheleia-mode-alist) '(sh-mode . shfmt)))) - - (when (executable-find "shellcheck") - (:straight flymake-shellcheck) - (:hook flymake-mode - flymake-shellcheck-load))) - -(setup shell-command - (:option shell-command-switch (acdw/system - ;; I should be testing on some variable - (:home "-csi") - (:work "-c")) - shell-command-prompt-show-cwd t - shell-command-default-error-buffer "*shell-command-errors*")) - -(setup shr - (:option shr-width fill-column - shr-max-image-proportion 0.6 - shr-image-animate t - shr-discard-aria-hidden t)) - -(setup text - (:hook turn-on-auto-fill - tildify-mode - acdw/setup-fringes)) - -(setup uniquify - (:option uniquify-buffer-name-style 'forward - uniquify-separator path-separator - uniquify-after-kill-buffer-p t - uniquify-ignore-buffers-re "^\\*")) - -(setup variable-pitch-mode - ;; I might want to change this to `buffer-face-mode-hook'... - (:advise variable-pitch-mode :after - (defun variable-pitch-mode@setup (&rest _) - "Set up `variable-pitch-mode' with my customizations." - (display-fill-column-indicator-mode - (if buffer-face-mode -1 +1))))) - -(setup view - (:option view-read-only t) - - (:hook (defun acdw/read-view-mode () - (reading-mode (if view-mode +1 -1))))) - -(setup w32 - (:option w32-allow-system-shell t - w32-pass-lwindow-to-system nil - w32-lwindow-modifier 'super - w32-pass-rwindow-to-system nil - w32-rwindow-modifier 'super - w32-pass-apps-to-system nil - w32-apps-modifier 'hyper)) - -(setup whitespace - (:option whitespace-style '(empty - indentation - space-before-tab - space-after-tab) - indent-tabs-mode nil - tab-width 4 - backward-delete-char-untabify-method 'hungry) - - (:global "M-SPC" #'cycle-spacing) - ;; http://ruzkuku.com/emacs.d.html#orgc62eb58 - (:advise cycle-spacing :around - (defun cycle-spacing@newlines-by-default (old arg &rest _) - (funcall old (if (numberp arg) (- arg) arg))))) - -(setup windmove - (:option windmove-wrap-around t) - (:global - ;; moving - "C-x 4 " #'windmove-left - "C-x 4 " #'windmove-right - "C-x 4 " #'windmove-up - "C-x 4 " #'windmove-down - ;; swapping - "C-x 4 S-" #'windmove-swap-states-left - "C-x 4 S-" #'windmove-swap-states-right - "C-x 4 S-" #'windmove-swap-states-up - "C-x 4 S-" #'windmove-swap-states-down) - - ;; (when (fboundp 'repeat-mode) - ;; (defvar windmove-repeat-map - ;; (let ((map (make-sparse-keymap))) - ;; ;; moving - ;; (define-key map [left] #'windmove-left) - ;; (define-key map [right] #'windmove-right) - ;; (define-key map [up] #'windmove-up) - ;; (define-key map [down] #'windmove-down) - ;; ;; swapping - ;; (define-key map [S-left] #'windmove-swap-states-left) - ;; (define-key map [S-right] #'windmove-swap-states-right) - ;; (define-key map [S-up] #'windmove-swap-states-up) - ;; (define-key map [S-down] #'windmove-swap-states-down) - ;; map) - ;; "Keymap to repeat various `windmove' sequences. Used in `repeat-mode'.") - - ;; (dolist (sym '(windmove-left - ;; windmove-right - ;; windmove-up - ;; windmove-down - ;; windmove-swap-states-left - ;; windmove-swap-states-right - ;; windmove-swap-states-up - ;; windmove-swap-states-down)) - ;; (put sym 'repeat-map 'windmove-repeat-map))) + (:bind "C-d" '+eshell-quit-or-delete-char) + (:when-loaded + (setenv "PAGER" "cat"))) + +(setup magit + ;; This setup is weird because of dependency issues + (:straight (transient :host github :repo "magit/transient" :branch "master") + (magit :host github :repo "magit/magit") + (git-modes :host github :repo "magit/git-modes")) + (when (eq system-type 'gnu/linux) + (:straight (forge :host github :repo "magit/forge")) + (with-eval-after-load 'magit + (require 'forge) + (add-to-list 'forge-alist + '("tildegit.org" "tildegit.org/api/v1" "tildegit.org" + forge-gitea-repository))))) + +(setup (:straight 0x0) + (:option 0x0-default-server 'ttm) + (with-eval-after-load 'embark + (define-key embark-region-map (kbd "U") '0x0-dwim))) + +(setup (:straight acme-theme) + ;; (load-theme 'acme t) ) -(setup window - ;; (require 'acdw-bell) - (:option - ;; Man-notify-method 'pushy - ;; display-buffer-alist ; from FrostyX - ;; '(("shell.*" (display-buffer-same-window) ()) - ;; (".*" (display-buffer-reuse-window - ;; display-buffer-same-window) - ;; (reusable-frames . t))) - recenter-positions '(top middle bottom) - ;; ring-bell-function - ;; (lambda () - ;; (acdw-bell/flash-mode-line - ;; (acdw/system :home))) - use-dialog-box nil - use-file-dialog nil - visible-bell nil) - - (tooltip-mode -1)) - -(setup winner - ;; see https://lists.gnu.org/archive/html/emacs-devel/2021-08/msg00888.html - (:global "C-x 4 C-/" #'winner-undo - "C-x 4 /" #'winner-undo - "C-x 4 C-?" #'winner-redo - "C-x 4 ?" #'winner-redo) - - ;; add `winner-undo' and `winner-redo' to `repeat-mode' - ;; (when (fboundp 'repeat-mode) - ;; (defvar winner-mode-repeat-map - ;; (let ((map (make-sparse-keymap))) - ;; (define-key map "/" #'winner-undo) - ;; (define-key map "?" #'winner-redo) - ;; map) - ;; "Keymap to repeat `winner-mode' sequences. Used in `repeat-mode'.") - - ;; (put 'winner-undo 'repeat-map 'winner-mode-repeat-map) - ;; (put 'winner-redo 'repeat-map 'winner-mode-repeat-map)) - - (winner-mode +1)) - -(setup (:straight (0x0 - :host gitlab - :repo "willvaughn/emacs-0x0")) - (:option 0x0-default-server 'ttm)) - -(setup (:straight (actually-selected-window - :host github - :repo "duckwork/actually-selected-window.el")) - (actually-selected-window-mode +1)) - -(setup (:straight-when affe - (and (or (executable-find "fd") - (executable-find "find")) - (executable-find "rg"))) - ;; Keys are bound in `acdw/sensible-grep' and `acdw/sensible-find' - (:option affe-regexp-compiler - (defun affe-orderless-regexp-compiler (input _type) - (setq input (orderless-pattern-compiler input)) - (cons input (lambda (str) (orderless--highlight input str)))))) - -(setup (:straight-when ahk-mode - (acdw/system :work))) - -(setup (:straight alert) - (:option alert-default-style (acdw/system - (:home 'libnotify) - (_ 'message)))) - -(setup (:straight (apheleia - :host github - :repo "raxod502/apheleia")) - - (require 'acdw-apheleia) - (add-hook 'before-save-hook #'apheleia-dumb-auto-format) - - ;; Aphelia can't find prettier on Windows (though I - ;; installed it, I think), and it keeps trying to start - ;; new processes until Emacs runs out of subprocess space. - ;; So I just enable it at home. - (unless (acdw/system :work) - (apheleia-global-mode +1))) - -(setup (:straight async) - (dired-async-mode +1)) +(setup (:straight anzu) + (:global [remap query-replace] 'anzu-query-replace-regexp + [remap query-replace-regexp] 'anzu-query-replace-regexp) + (global-anzu-mode +1) + (:bind-into isearch + [remap isearch-query-replace] + 'anzu-isearch-query-replace + [remap isearch-query-replace-regexp] + 'anzu-isearch-query-replace-regexp)) (setup (:straight avy) - (:global "M-j" #'avy-goto-char-timer - "C-c C-j" #'avy-resume) + (:also-load +avy) + (:global "M-j" 'avy-goto-char-timer) + (:bind-into isearch + "M-j" 'avy-isearch) + (:when-loaded + (setf (alist-get ?. avy-dispatch-alist) 'avy-action-embark))) - (:with-feature isearch - (:bind "M-j" #'avy-isearch))) +(setup (:straight (capf-autosuggest + :repo "https://repo.or.cz/emacs-capf-autosuggest.git")) + (:hook-into eshell-mode + comint-mode)) (setup (:straight circe) - (require 'circe) - (require 'acdw-irc) - (:also-load acdw-circe) - - (defun acdw-circe/format-meta (string) - "Return a format string for `lui-format'." - (format "{nick:%1$d.%1$ds} *** %s" (- acdw-irc/left-margin 3) string)) + (:require _circe) + (:require +circe) + (autoload '+irc "+circe" "Connect to IRC." t) - (:option acdw-irc/left-margin 20 - circe-channel-killed-confirmation nil - circe-color-nicks-everywhere t - circe-default-nick "acdw" - circe-default-part-message "See You, Space Cowpokes . . ." - circe-default-user "acdw" - circe-format-action (format - (format "%%%ds* {nick} {body}" - (- acdw-irc/left-margin 2)) " ") - circe-format-say (format - "{nick:%1$d.%1$ds} | {body}" - (- acdw-irc/left-margin 3)) + ;; Formatting options + (:option circe-format-action (format (format "%%%ds* {nick} {body}" + (- +circe-left-margin 2)) + " ") + circe-format-say (format "{nick:%1$d.%1$ds} | {body}" + (- +circe-left-margin 3)) circe-format-self-action circe-format-action - circe-format-self-say (format - "{nick:%1$d.%1$ds} > {body}" - (- acdw-irc/left-margin 3)) - circe-format-server-part (acdw-circe/format-meta + circe-format-self-say (replace-regexp-in-string "|" ">" + circe-format-say) + circe-format-server-part (+circe-format-meta "PART {channel}: {reason}") - circe-format-server-quit (acdw-circe/format-meta "QUIT: {reason}") - circe-format-server-quit-channel (acdw-circe/format-meta + circe-format-server-quit (+circe-format-meta "QUIT: {reason}") + circe-format-server-quit-channel (+circe-format-meta "QUIT {channel}: {reason}") - circe-format-server-join (acdw-circe/format-meta "JOIN: {userinfo}") - circe-format-server-rejoin (acdw-circe/format-meta - (concat "REJOIN: {userinfo}" - " after {departuredelta}")) - circe-format-server-topic (acdw-circe/format-meta + circe-format-server-join (+circe-format-meta "JOIN: {userinfo}") + circe-format-server-rejoin (+circe-format-meta + (concat "REJOIN: {userinfo} " + "after {departuredelta}")) + circe-format-server-topic (+circe-format-meta "TOPIC: {new-topic}") circe-prompt-string (format (format "%%%ds> " - (- acdw-irc/left-margin 2)) - " ") + (- +circe-left-margin 2)) + " ")) + + (:option +circe-network-inhibit-autoconnect _circe-network-inhibit-autoconnect + circe-network-options _circe-network-options + circe-color-nicks-everywhere t + circe-default-part-message "See You, Space Cowpokes . . ." + circe-default-user user-real-login-name circe-reduce-lurker-spam t - circe-server-auto-join-default-type :after-auth - circe-server-buffer-action (lambda (buf) - (message "Connected to %s" buf))) - - (with-eval-after-load 'circe - (:face circe-nick-highlight-face - ((t (:inherit (modus-themes-hl-line modus-themes-bold)))) - ;; circe-my-message-face - ;; ((t (:inherit (modus-themes-slant)))) - )) + circe-server-auto-join-default-type :after-auth) + (:bind "C-c C-p" 'circe-command-PART + "C-c C-t" '+circe-current-topic + "C-l" 'lui-track-jump-to-indicator + "C-" '+circe-chat@set-prompt) - (with-eval-after-load 'topsy - (:option (append topsy-mode-functions) - '(circe-channel-mode . circe-current-topic))) + (advice-add 'circe-command-PART :after '+circe-kill-buffer) + (advice-add 'circe-command-QUIT :after '+circe-quit@kill-buffer) + (advice-add 'circe-command-GQUIT :after '+circe-gquit@kill-buffer) - (:bind "C-c C-p" #'circe-command-PART - "C-c C-t" #'circe-current-topic ; in acdw-circe.el - "C-l" #'lui-track-jump-to-indicator - "" #'circe-chat@set-prompt) - - (:advise circe-command-PART :after #'circe-part@kill-buffer - circe-command-QUIT :after #'circe-quit@kill-buffer - circe-command-GQUIT :after #'circe-gquit@kill-buffer) - (:with-mode circe-chat-mode - (:hook #'acdw/stop-paren-annoyances - #'enable-circe-color-nicks - ;; #'enable-circe-display-images - #'enable-circe-new-day-notifier - #'circe-chat@set-prompt - #'topsy-mode)) - (:bind "C-c C-s" #'circe-command-SLAP) - - (autoload 'circe-nick-color-reset "circe-color-nicks") - (add-hook 'modus-themes-after-theme-hook - #'circe-nick-color-reset) + (:hook 'enable-circe-color-nicks + 'enable-circe-new-day-notifier + '+circe-chat@set-prompt) + (:bind "C-c C-s" 'circe-command-SLAP)) (:with-mode lui-mode - (:option lui-fill-column (+ fill-column acdw-irc/left-margin) - lui-fill-type nil ;;(repeat-string acdw-irc/left-margin " ") + (:option lui-fill-column (+ fill-column +circe-left-margin) + lui-fill-type nil lui-time-stamp-position 'right-margin - lui-time-stamp-format "%H:%M" + lui-time-stamp-format "[ %H:%M" lui-track-behavior 'before-switch-to-buffer lui-track-indicator 'fringe lui-fill-remove-face-from-newline nil) - - (:hook #'visual-fill-column-mode - #'visual-line-mode - #'enable-lui-track) - - (:face lui-time-stamp-face - ((t :inherit font-lock-comment-face))) - - (:local-set visual-fill-column-extra-text-width - (cons acdw-irc/left-margin 0) - fringes-outside-margins t - right-margin-width 5 + (:hook 'visual-line-mode + 'enable-lui-track + 'visual-fill-column-mode) + (:local-set fringes-outside-margins t + right-margin-width (length lui-time-stamp-format) scroll-margin 0 word-wrap t - wrap-prefix (repeat-string acdw-irc/left-margin " ") - nyan-mode nil + wrap-prefix (+string-repeat +circe-left-margin " ") line-number-mode nil column-number-mode nil - file-percentage-mode nil)) + file-percentage-mode nil + visual-fill-column-extra-text-width + (cons +circe-left-margin 0))) (add-hook 'kill-emacs-hook (defun circe-quit-all () (ignore-errors - (advice-remove 'circe-command-GQUIT 'circe-gquit@kill-buffer) + (advice-remove 'circe-command-GQUIT + 'circe-gquit@kill-buffer) (circe-command-GQUIT "Quitting Emacs, bye!"))))) -(setup (:straight (command-log-mode - :host github - :repo "positron-solutions/command-log-mode")) - ;; I have many ideas as to how to change this. - (:option clm-window-text-scale 0 - clm-logging-shows-buffer t - clm-log-globally t - clm-exceptions '(self-insert-command) - clm-window-size 0.25) - (el-patch-feature command-log-mode) - (with-eval-after-load 'command-log-mode - (el-patch-defun clm--show-buffer (&optional clear) - "Displays the command log buffer in a window. -CLEAR will clear the buffer if it exists before returning it." - (let ((buffer (clm--setup-buffer clear))) - (let ((win (get-buffer-window buffer))) - (unless (windowp win) - (let ((new-win (el-patch-swap - (split-window-horizontally - (- 0 clm-window-size)) - (if (< (window-pixel-width) (window-pixel-height)) - (split-window-vertically - (- (if (floatp clm-window-size) - (floor (* (window-height) clm-window-size)) - clm-window-size))) - (split-window-horizontally - (- (if (floatp clm-window-size) - (floor (* (window-width) clm-window-size)) - clm-window-size))))))) - (set-window-buffer new-win buffer) - (set-window-dedicated-p new-win t) - (el-patch-add - (with-current-buffer buffer - (setq-local mode-line-format nil))))) - buffer))))) - -(setup (:straight (consult - :host github - :repo "minad/consult")) - - (:require acdw-consult) - (:autoload consult-register-preview) - - ;; Bindings - (:global - ;; C-c bindings (`mode-specific-map') - ;; I don't use any of these right now. - ;; "C-c h" #'consult-history - ;; "C-c m" #'consult-mode-command - ;; "C-c b" #'consult-bookmark - ;; "C-c k" #'consult-kmacro - ;; C-x bindings (`ctl-x-map') - "C-x M-:" #'consult-complex-command - "C-x b" #'consult-buffer - "C-x 4 b" #'consult-buffer-other-window - "C-x 5 b" #'consult-buffer-other-frame - ;; Custom M-# bindings for fast register access - "M-#" #'consult-register-load - "M-'" #'consult-register-store - "C-M-#" #'consult-register - ;; M-g bindings (`goto-map') - "M-g e" #'consult-compile-error - "M-g g" #'consult-goto-line - "M-g M-g" #'consult-goto-line - "M-g o" #'consult-outline - "M-g m" #'consult-mark - "M-g k" #'consult-global-mark - "M-g i" #'consult-imenu - "M-g I" #'consult-project-imenu - ;; M-s bindings (`search-map') - "M-s g" #'acdw-consult/sensible-grep - "M-s f" #'acdw-consult/sensible-find - "M-s l" #'consult-line - "M-s m" #'consult-multi-occur - "M-s k" #'consult-keep-lines - "M-s u" #'consult-focus-lines - ;; Other bindings - "M-y" #'consult-yank-pop - " a" #'consult-apropos - ;; Isearch integration - "M-s e" #'consult-isearch) - - (:with-map isearch-mode-map - (:bind "M-e" #'consult-isearch - "M-s e" #'consult-isearch - "M-s l" #'consult-line)) - - (:option (append consult-buffer-sources) #'circe-buffer-source) - - (consult-history-to-modes ((minibuffer-local-map . nil) - (shell-mode-map . shell-mode-hook) - (term-mode-map . term-mode-hook) - (term-raw-map . term-mode-hook) - (comint-mode-map . comint-mode-hook) - (sly-mrepl-mode-map . sly-mrepl-hook))) - +(setup (:straight consult) + (:also-load +consult) + ;; from Consult wiki (:option register-preview-delay 0 - register-preview-function #'consult-register-format - xref-show-xrefs-function #'consult-xref - xref-show-definitions-function #'consult-xref - consult-project-root-function #'vc-root-dir - completion-in-region-function #'acdw-consult/complete-in-region - completion-cycle-threshold 3 - consult-preview-key (kbd "M-.") - tab-always-indent 'complete) - - (:advise register-preview :override #'consult-register-window) - - ;; Completing-read-multple - (if (fboundp #'consult-completing-read-multiple) - (:advise completing-read-multple :override - #'consult-completing-read-multiple) - (:advise completing-read-multiple :filter-args - (defun crm-indicator (args) - (cons (concat "[CRM] " (car args)) (cdr args))))) - - (with-eval-after-load 'orderless - (:option consult--regexp-compiler - #'consult--orderless-regexp-compiler)) - - (with-eval-after-loads (vertico consult) - (:with-map consult-crm-map - (:bind "RET" (defun +vertico-crm-exit () - (interactive) - (run-at-time 0 nil #'vertico-exit) - (funcall #'vertico-exit)) - "TAB" #'vertico-exit)))) - -(setup (:straight consult-dir) - (:with-feature project - (:autoload project--read-project-list)) - (:global "C-x C-d" #'consult-dir) - (with-eval-after-load 'vertico - (:with-map vertico-map - (:bind "C-x C-d" #'consult-dir - "C-x C-j" #'consult-dir-jump-file)))) - -(setup (:straight crux) - (:global "C-o" #'crux-smart-open-line - "M-o" #'open-paragraph - "C-M-\\" #'crux-cleanup-buffer-or-region - "C-x 4 t" #'crux-transpose-windows) - - (el-patch-feature crux) - (with-eval-after-load 'crux - (el-patch-defun crux-reopen-as-root () - "Find file as root if necessary. - -Meant to be used as `find-file-hook'. -See also `crux-reopen-as-root-mode'." - (unless (or - ;; This helps fix for `nov-mode', and possibly others. - (el-patch-add (null buffer-file-name)) - (tramp-tramp-file-p buffer-file-name) - (equal major-mode 'dired-mode) - (not (file-exists-p (file-name-directory buffer-file-name))) - (file-writable-p buffer-file-name) - (crux-file-owned-by-user-p buffer-file-name)) - (crux-find-alternate-file-as-root buffer-file-name)))) - - (crux-reopen-as-root-mode +1)) - -;; (setup (:straight-when -;; (define-repeat-map -;; :host nil -;; :repo "https://tildegit.org/acdw/define-repeat-map.el") -;; (acdw/system :home)) - -;; (require 'define-repeat-map ; just for me -;; (acdw/dir -;; "straight/build/define-repeat-map/define-repeat-map.el")) - -;; (defun acdw/other-window-or-switch-buffer-backward () -;; (interactive) -;; (setq repeat-map 'other-window-repeat-map) -;; (acdw/other-window-or-switch-buffer -1)) - -;; (define-repeat-map other-window -;; ("o" acdw/other-window-or-switch-buffer -;; "O" acdw/other-window-or-switch-buffer-backward)) - -;; (define-repeat-map case -;; ("c" capitalize-word -;; "u" upcase-dwim -;; "l" downcase-dwim) -;; (:continue "f" forward-word -;; "b" backward-word) -;; (:enter capitalize-dwim -;; upcase-dwim -;; downcase-dwim)) - -;; (define-repeat-map page-navigation -;; ("]" forward-page -;; "[" backward-page)) - -;; (define-repeat-map windmove -;; (;; moving -;; "" windmove-left -;; "" windmove-right -;; "" windmove-up -;; "" windmove-down -;; ;; swapping -;; "" windmove-swap-states-left -;; "" windmove-swap-states-right -;; "" windmove-swap-states-up -;; "" windmove-swap-states-down)) - -;; (define-repeat-map winner-mode -;; ("/" winner-undo -;; "?" winner-redo))) + register-preview-function 'consult-register-format + xref-show-xrefs-function 'consult-xref + xref-show-definitions-function 'consult-xref + tab-always-indent 'complete + completion-in-region-function 'consult-completion-in-region) + (advice-add 'register-preview :override 'consult-register-window) + (advice-add 'completing-read-multiple :override + 'consult-completing-read-multiple) + (dolist (binding '(;; C-c bindings (mode-specific-map) + ("C-c h" . consult-history) + ("C-c m" . consult-mode-command) + ("C-c b" . consult-bookmark) + ("C-c k" . consult-kmacro) + ;; C-x bindings (ctl-x-map) + ("C-x M-:" . consult-complex-command) + ("C-x b" . consult-buffer) + ("C-x 4 b" . consult-buffer-other-window) + ("C-x 5 b" . consult-buffer-other-frame) + ;; Custom M-# bindings for fast register access + ("M-#" . consult-register-load) + ("M-'" . consult-register-store) + ("C-M-#" . consult-register) + ;; Other custom bindings + ("M-y" . consult-yank-pop) + (" a" . consult-apropos) + ;; M-g bindings (goto-map) + ("M-g e" . consult-compile-error) + ("M-g f" . consult-flymake) ; or consult-flycheck + ("M-g g" . consult-goto-line) + ("M-g M-g" . consult-goto-line) + ("M-g o" . consult-outline) ; or consult-org-heading + ("M-g m" . consult-mark) + ("M-g k" . consult-global-mark) + ("M-g i" . consult-imenu) + ("M-g I" . consult-imenu-multi) + ;; M-s bindings (search-map) + ("M-s f" . consult-find) + ("M-s F" . consult-locate) + ("M-s g" . consult-grep) + ("M-s G" . consult-git-grep) + ("M-s r" . consult-ripgrep) + ("M-s l" . consult-line) + ("M-s L" . consult-line-multi) + ("M-s m" . consult-multi-occur) + ("M-s k" . consult-keep-lines) + ("M-s u" . consult-focus-lines) + ;; Isearch integration + ("M-s e" . consult-isearch-history))) + (global-set-key (kbd (car binding)) (cdr binding))) + (with-eval-after-load 'isearch-mode + (dolist (binding '(("M-e" . consult-isearch-history) + ("M-s e" . consult-isearch-history) + ("M-s l" . consult-line) + ("M-s L" . consult-line-multi))) + (define-key isearch-mode-map (car binding) (cdr binding)))) + (with-eval-after-load 'org-mode + (define-key org-mode-map "M-g o" 'consult-org-heading)) + (with-eval-after-load 'consult + (:option consult-narrow-key "<" + consult-project-root-function '+consult-project-root) + (consult-customize + consult-theme + :preview-key '(:debounce 0.2 any) + consult-ripgrep consult-git-grep consult-grep + consult-bookmark consult-recent-file consult-xref + consult--source-file consult--source-project-file + consult--source-bookmark + :preview-key (kbd "M-.")) + (consult-history-to-modes ((minibuffer-local-map . nil) + (shell-mode-map . shell-mode-hook) + (term-mode-map . term-mode-hook) + (term-raw-map . term-mode-hook) + (comint-mode-map . comint-mode-hook) + (sly-mrepl-mode-map . sly-mrepl-hook))) + (with-eval-after-load 'orderless + (:option consult--regexp-compiler 'consult--orderless-regexp-compiler)))) (setup (:straight dictionary) (:option dictionary-use-single-buffer t) - (autoload 'dictionary-search "dictionary" "Ask for a word and search it in all dictionaries" t) (autoload 'dictionary-match-words "dictionary" @@ -1526,226 +318,29 @@ See also `crux-reopen-as-root-mode'." (autoload 'dictionary-tooltip-mode "dictionary" "Display tooltips for the current word" t) (autoload 'global-dictionary-tooltip-mode "dictionary" - "Enable/disable dictionary-tooltip-mode for all buffers" t) - - (define-key lookup-map "d" #'dictionary-search) - - (:hook #'reading-mode)) - -(setup (:straight (dogears - :host github - :repo "alphapapa/dogears.el" - :files (:defaults - (:exclude "helm-dogears.el")))) - (:option (append savehist-additional-variables) 'dogears-list) - (with-eval-after-load 'dogears - (dolist (mode '(magit-status-mode - elfeed-show-mode - elfeed-search-mode)) - (:option (append dogears-ignore-modes) mode))) - (:global "M-g d" dogears-go) - (:autoload dogears-mode) - (dogears-mode +1)) - -(setup (:straight edit-indirect)) + "Enable/disable dictionary-tooltip-mode for all buffers" t)) -;; requires extension: -;; https://addons.mozilla.org/en-US/firefox/addon/edit-with-emacs1/ -(setup (:straight edit-server) - (:require edit-server) - (edit-server-start) - - (:option edit-server-default-major-mode 'text-mode - edit-server-url-major-mode-alist - (list (cons (rx (| "reddit.com" - "tildes.net")) - 'markdown-mode) - (cons (rx "github.com") - 'gfm-mode) - (cons "." 'text-mode))) - - (:advise edit-server-make-frame :before - (defun edit-server@set-a-variable (&rest _) - (setq-local edit-server-frame-p t)))) - -(setup (:straight (electric-cursor - :host github - :repo "duckwork/electric-cursor")) +(setup (:straight electric-cursor) (electric-cursor-mode +1)) -(setup (:straight (elfeed - :host github - :repo "skeeto/elfeed") - elfeed-protocol) - (:option elfeed-use-curl t - elfeed-curl-extra-arguments '("--insecure") - elfeed-feeds `(("fever+https://acdw@mf.acdw.net" - :api-url "https://mf.acdw.net/fever/" - :password ,(acdw/make-password-fetcher - :host "mf.acdw.net") - :autotags ; do I want to use elfeed-org ? - '(("r/emacs" reddit social emacs) - ("protesilaos.com/codelog.xml" emacs) - ("tildes.net" social) - ("catandgirl.com" comics) - ("qwantz.com" comics) - ("emacsninja.com" emacs) - ("falseknees.com" comics) - ("emacslife.com" emacs) - ("lisp.org" lisp programming) - ("scheme.org" scheme programming) - ("smbc-comics.com" comics) - ("youtube.com" video) - ("tilde.news" social) - ("xkcd.com" comics)))) - elfeed-show-unique-buffers t) - (:autoload elfeed-set-timeout) - (elfeed-set-timeout 3600) - (elfeed-protocol-enable) - (:advise elfeed :after - (defun elfeed@protocol-update (&rest _) - (elfeed-search-fetch nil))) - (:with-mode elfeed-search-mode - (:bind "G" (defun elfeed-protocol|update-first (arg) - (interactive "P") - (let ((first-proto (caar elfeed-feeds))) - (if arg - (call-interactively #'elfeed-protocol-fever-reinit) - (with-temp-message (format "Updating %s" first-proto) - (elfeed-protocol-fever-reinit first-proto))))))) - (:with-mode elfeed-show-mode - (:hook #'reading-mode) - (:local-set shr-max-image-proportion 0.9 - visual-fill-column-width (+ fill-column 5)) - ;; see https://irreal.org/blog/?p=8885 - (:bind "SPC" (defun elfeed-scroll-up-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-up-command arg) - (error (elfeed-show-next))))) - "S-SPC" (defun elfeed-scroll-down-command (&optional arg) - "Scroll up or go to next feed item in Elfeed" - (interactive "^P") - (let ((scroll-error-top-bottom nil)) - (condition-case-unless-debug nil - (scroll-down-command arg) - (error (elfeed-show-prev)))))))) - -(setup (:straight elisp-slime-nav) - (:hook-into emacs-lisp-mode - ielm-mode)) - -(setup (:straight (elpher - :host nil - :repo "git://thelambdalab.xyz/elpher.git")) - (:option elpher-ipv4-always t - elpher-certificate-directory (acdw/dir "elpher/") - elpher-gemini-max-fill-width fill-column) - - (:bind "n" #'elpher-next-link - "p" #'elpher-prev-link - "o" #'elpher-follow-current-link - "G" #'elpher-go-current) - - (:hook #'reading-mode) - - (:autoload (elpher-bookmarks :interactive t) - (elpher-go :interactive t)) - - ;; Make `eww' gemini/gopher aware. From Emacswiki. - ;; (define-advice eww-browse-url (:around (fn url &rest args) gemini-elpher) - ;; (cond ((string-match-p "\\`\\(gemini\\|gopher\\)://" url) - ;; (require 'elpher) - ;; (elpher-go url)) - ;; (t (apply fn url args)))) - ) - -(setup (:straight-when emacs-everywhere - (and (executable-find "xclip") - (executable-find "xdotool") - (executable-find "xprop") - (executable-find "xwininfo")))) - -(setup (:straight (embark ; gotta git that fresh fresh - :host github - :repo "oantolin/embark")) - (:global "C-." #'embark-act) - (:option prefix-help-command #'embark-prefix-help-command - (append display-buffer-alist) - `(,(rx (seq bos "*Embark Collect " - (group (| "Live" "Completions")) - "*")) - nil - (window-parameters (mode-line-format . none))) - embark-prompter #'embark-keymap-prompter - embark-verbose-indicator-display-action - '(display-buffer-at-bottom (window-height . fit-window-to-buffer)) - embark-action-indicator - (lambda (map _target) - (which-key--show-keymap "Embark" map nil nil 'no-paging) - #'which-key--hide--ignore-command) - embark-become-indicator embark-action-indicator) - - (with-eval-after-loads (embark consult) - (:straight embark-consult) - (add-hook 'embark-collect-mode-hook - #'consult-preview-at-point-mode))) +(setup (:straight electric-cursor) + (electric-cursor-mode +1)) -(setup (:straight epithet) - (dolist (hook '(Info-selection-hook - eww-after-render-hook - help-mode-hook - occur-mode-hook)) - (add-hook hook #'epithet-rename-buffer))) +(setup (:straight embark) + (:option prefix-help-command 'embark-prefix-help-command) + (:global "C-." 'embark-act + "M-." 'embark-dwim + "C-h B" 'embark-bindings)) -;; TODO: look into emms or something related for this -(setup (:straight-when eradio - (executable-find "mpv")) - (:option - eradio-player '("mpv" "--no-video" "--no-terminal") - eradio-channels `(("KLSU" . - "http://130.39.238.143:8010/stream.mp3") - ("Soma FM Synphaera" . - "https://somafm.com/synphaera256.pls") - ("SomaFM BAGel Radio" . - "https://somafm.com/bagel.pls") - ("SomaFM Boot Liquor" . - "https://somafm.com/bootliquor320.pls") - ("SomaFM Deep Space One" . - "https://somafm.com/deepspaceone.pls") - ("SomaFM Fluid" . - "https://somafm.com/fluid.pls") - ("SomaFM Underground 80s" . - "https://somafm.com/u80s256.pls") - ("WBRH: Jazz & More" . - "http://wbrh.streamguys1.com/wbrh-mp3") - ("KBRH Blues & Rhythm Hits" . - "http://wbrh.streamguys1.com/kbrh-mp3") - ("WRKF HD-2" . - ,(concat "https://playerservices.streamtheworld.com/" - "api/livestream-redirect/WRKFHD2.mp3")) - ("WRKF: NPR for the Capital Region" . - ,(concat "https://playerservices.streamtheworld.com/" - "api/livestream-redirect/WRKFFM.mp3")) - ("BadRadio: 24/7 PHONK" . - "https://s2.radio.co/s2b2b68744/listen") - ("tilderadio" . - "https://azuracast.tilderadio.org/radio/8000/radio.ogg") - ("vantaradio" . - "https://vantaa.black/radio"))) - (:global "C-c r r" #'eradio-play ; mnemonic: radio - "C-c r s" #'eradio-stop ; mnemonic: stop - "C-c r p" #'eradio-toggle ; mnemonic: play/pause - )) +(setup (:straight embark-consult) + (:load-after consult embark) + (add-hook 'embark-collect-mode-hook 'consult-preview-at-point-mode)) -(setup (:straight eros) - (:hook-into emacs-lisp-mode - lisp-interaction-mode)) +(setup (:straight eshell-syntax-highlighting) + (:hook-into eshell-mode)) (setup (:straight-when exec-path-from-shell - (acdw/system :home)) + (eq system-type 'gnu/linux)) (when (daemonp) (exec-path-from-shell-initialize)) (exec-path-from-shell-copy-envs '("XDG_CONFIG_HOME" @@ -1755,250 +350,83 @@ See also `crux-reopen-as-root-mode'." "XDG_CACHE_HOME"))) (setup (:straight expand-region) - (:global "C-=" #'er/expand-region)) - -(setup (:straight-when fennel-mode - (executable-find "fennel")) - (:autoload (fennel-repl :interactive t)) - (:file-match (rx ".fnl" eos))) - -(setup (:straight flyspell-correct) - (:option flyspell-correct-interface #'flyspell-correct-completing-read - flyspell-correct--cr-key ";") + (:global "C-=" 'er/expand-region)) - (:with-feature flyspell - (:bind "C-." #'flyspell-correct-wrapper - "" (defun acdw/flyspell-correct-f7 () - "Run a full spell correction on the current buffer." - (interactive) - (save-mark-and-excursion - (flyspell-correct-move 0 :forward :rapid)))) - (:unbind "C-;" "C-," "C-." "C-M-i"))) - -(setup (:straight-when forge - (acdw/system :home)) - ;; make sure to read Info manual with Forge (and Ghub) for setup - ;; instructions. - (with-eval-after-load 'magit - (require 'forge) - (add-to-list 'forge-alist ; tildegit is a gitea server - '("tildegit.org" "tildegit.org/api/v1" "tildegit.org" - forge-gitea-repository)))) +(setup (:straight (filldent + :host github + :repo "duckwork/filldent.el")) + (:global "M-q" 'filldent-dwim)) (setup (:straight (frowny :host github :repo "duckwork/frowny.el")) - (:option frowny-eyes (rx (| ":" ":-" ":'" "=")) - frowny-eyes-looking-back-limit 2) (global-frowny-mode +1)) (setup (:straight gcmh) (:option gcmh-idle-delay 'auto) (gcmh-mode +1)) -(setup (:straight-when geiser - (progn - (defvar acdw/schemes - (let (schemes) - (dolist (scheme '(("scheme" . geiser-chez) ; chez - ("petite" . geiser-chez) ; petite - ("csi" . geiser-chez) ; chicken - ("gsi" . geiser-gambit) - ("gosh" . geiser-gauche) - ("guile" . geiser-guile) - ("kawa" . geiser-kawa) - ("mit-scheme" . geiser-mit) - ("racket" . geiser-racket) - ("stklos" . geiser-stklos))) - (when-let (binary (executable-find (car scheme))) - (push binary schemes) - ;; and install the proper helper package - (straight-use-package (cdr scheme)))) - (nreverse schemes))) - acdw/schemes)) - (:file-match (rx ".rkt" eos) - (rx ".scm" eos))) - -(setup (:straight (gemini-mode - :host nil - :repo "https://git.carcosa.net/jmcbray/gemini.el.git")) - (:file-match (rx (seq "." (or "gemini" "gmi") eos))) - (:hook turn-off-auto-fill)) - -(setup (:straight (gemini-write - :host nil - :repo "https://alexschroeder.ch/cgit/gemini-write" - :branch "main")) - (with-eval-after-load 'elpher - (require 'gemini-write))) - -(setup (:straight git-modes)) - (setup (:straight helpful) - (:require-after 3) - (:global " f" #'helpful-callable - " v" #'helpful-variable - " k" #'helpful-key - " o" #'helpful-symbol)) + (:global " f" 'helpful-callable + " v" 'helpful-variable + " k" 'helpful-key + "C-c C-d" 'helpful-at-point)) + (setup (:straight (hippie-completing-read :host github :repo "duckwork/hippie-completing-read")) - (:global "M-/" #'hippie-completing-read)) + (:global "M-/" 'hippie-completing-read)) (setup (:straight hungry-delete) (:option hungry-delete-chars-to-skip " \t" - hungry-delete-join-reluctantly nil) - - (global-hungry-delete-mode +1) - - (:with-feature paredit - (:bind [remap paredit-backward-delete] - (defun acdw/paredit-hungry-delete-backward (arg) - (interactive "P") - (if (looking-back "[ \t]" 1) - (hungry-delete-backward (or arg 1)) - (paredit-backward-delete arg))) - - [remap paredit-forward-delete] - (defun acdw/paredit-hungry-delete-forward (arg) - (interactive "P") - (if (looking-at "[ \t]") - (hungry-delete-forward (or arg 1)) - (paredit-forward-delete arg)))))) - -(setup (:straight iscroll) - (define-globalized-minor-mode global-iscroll-mode iscroll-mode - (lambda () (iscroll-mode +1))) - - (global-iscroll-mode +1)) - -(setup (:straight (kaomoji-insert - :host nil - :repo "https://tildegit.org/acdw/kaomoji-insert")) - (require 'kaomoji-insert) - (dolist (km '(("(Ծ‸ Ծ)" "suspicious") - ("(¬‿¬)═ɜ ɛ═(⌐‿⌐ )" "pound it" "fist bump") - ("▬▬▬▬▬▬▬▋ Ò╭╮Ó" "hammer") - ("👁👄👁" "lewk") - ("( ͡~ ͜ʖ ͡°)" "wink") - (" (づ￣ ³￣)づ " "party") - ("⊙﹏⊙" "uhhh" "unsure"))) - (add-to-list 'kaomoji-insert-alist km)) - (:global "C-x 8 k" #'kaomoji-insert)) - -;; (setup (:straight wrap-region) -;; (:hook-into org-mode) -;; (with-eval-after-load 'org -;; (dolist (punc '("=" "*" "/" "_" "+")) -;; (wrap-region-add-wrapper punc punc nil 'org-mode)))) + hungry-delete-join-reluctantly nil) + (:bind-into paredit + [remap paredit-backward-delete] + (defun acdw/paredit-hungry-delete-backward (arg) + (interactive "P") + (if (looking-back "[ \t]" 1) + (hungry-delete-backward (or arg 1)) + (paredit-backward-delete arg))) + [remap paredit-forward-delete] + (defun acdw/paredit-hungry-delete-forward (arg) + (interactive "P") + (if (looking-at "[ \t]") + (hungry-delete-forward (or arg 1)) + (paredit-forward-delete arg)))) + (global-hungry-delete-mode +1)) + +(setup (:straight isearch-mb) + ;; This complicatedness is an attempt to make it easier to add and + ;; subtract `isearch-mb' bindings using the suggestions in the + ;; project's README. + (with-eval-after-load 'isearch-mb + (dolist (spec '((isearch-mb--with-buffer + ("M-e" . consult-isearch) + ("C-o" . loccur-isearch)) + (isearch-mb--after-exit + ("M-%" . anzu-isearch-query-replace) + ("M-s l" . consult-line)))) + (let ((isearch-mb-list (car spec)) + (isearch-mb-binds (cdr spec))) + (dolist (cell isearch-mb-binds) + (let ((key (car cell)) + (command (cdr cell))) + (when (fboundp command) + (add-to-list isearch-mb-list command) + (define-key isearch-mb-minibuffer-map (kbd key) command))))))) + (isearch-mb-mode +1)) (setup (:straight lacarte) - (:global "" #'lacarte-execute-menu-command)) - -(setup (:straight-when ledger-mode - (executable-find "ledger"))) - -(setup (:straight link-hint) - ;; Browse web URLs with a browser with a prefix argument. - (dolist (type '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link)) - (link-hint-define-type type - :open-secondary browse-url-secondary-browser-function - :open-secondary-multiple t)) - - (defun acdw/link-hint-open-all-links (prefix) - "Open all visible links. -When PREFIX is non-nil, open links with -`browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--all (if prefix :open-secondary :open)))) - - (defun acdw/link-hint-open-multiple-links (prefix) - "Use `avy' to open multiple visible links at once. -When PREFIX is non-nil, open links with -`browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--multiple (if prefix :open-secondary :open)))) - - (:option link-hint-avy-style 'at-full) - (:global "C-j" - (defun acdw/link-hint-open-link (arg) - "Open a link using `link-hint-open-link', prefix-aware. -That is, a prefix argument (\\[universal-argument]) will open the -browser defined in `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-link - (link-hint--one (if arg :open-secondary :open)))))) - -(setup (:straight lua-mode) - (:file-match (rx ".lua" eos))) - -(setup (:straight macrostep) - (define-key emacs-lisp-mode-map (kbd "C-c e") #'macrostep-expand) - (define-key lisp-interaction-mode-map (kbd "C-c e") #'macrostep-expand)) - -(setup (:straight magit) - (:global "C-x g" #'magit-status) - - (:option magit-display-buffer-function - (defun magit-display-buffer-same-window (buffer) - "Display BUFFER in the selected window like God intended." - (display-buffer buffer '(display-buffer-same-window))) - magit-popup-display-buffer-action '((display-buffer-same-window)) - magit-refresh-status-buffer nil)) + (:global "" 'lacarte-execute-menu-command)) (setup (:straight marginalia) - (:option marginalia-annotators '(marginalia-annotators-heavy - marginalia-annotators-light)) (marginalia-mode +1)) -(setup (:straight markdown-mode) - (:file-match (rx ".md" eos) - (rx ".markdown" eos)) - (:hook #'variable-pitch-mode - #'visual-fill-column-mode) - - (:with-mode gfm-mode - (:file-match (rx "README.md" eos)) - (:hook #'variable-pitch-mode)) - - (when (executable-find "markdownfmt") - (with-eval-after-load 'apheleia - (:option (append apheleia-formatters) '(markdownfmt . ("markdownfmt")) - (append apheleia-mode-alist) '(markdown-mode . markdownfmt) - (append apheleia-mode-alist) '(gfm-mode . markdownfmt))))) - -(setup (:straight (mastodon - :host github - :repo "mooseyboots/mastodon.el")) - (:option mastodon-instance-url "https://writing.exchange" - mastodon-auth-source-file (car auth-sources) - mastodon-client--token-file (acdw/dir "mastodon.plstore") - mastodon-tl--enable-proportional-fonts t - mastodon-tl--enable-relative-timestamps nil) - - (:hook #'hl-line-mode - #'reading-mode) - - (defun mastodon-goto-toot@recenter () - "Recenter the current toot." - (recenter -1)) - - (:advise mastodon-tl--goto-next-toot :after #'mastodon-goto-toot@recenter - mastodon-tl--goto-prev-toot :after #'mastodon-goto-toot@recenter)) +(setup (:straight minions) + (:option minions-prominent-modes + '(tracking-mode)) + (minions-mode +1)) (setup (:straight mode-line-bell) (:option mode-line-bell-flash-time 0.1) @@ -2007,164 +435,14 @@ browser defined in `browse-url-secondary-browser-function'." (setup (:straight (modus-themes :host gitlab :repo "protesilaos/modus-themes")) - (:option modus-themes-slanted-constructs t - modus-themes-bold-constructs t - modus-themes-fringes nil - modus-themes-mode-line '(borderless) - modus-themes-region '(bg-only) - modus-themes-org-blocks 'gray-background - modus-themes-headings '((t . (background))) - modus-themes-lang-checkers '(straight-underline) - modus-themes-scale-headings nil) - - (acdw/sunrise-sunset #'modus-themes-load-operandi - #'modus-themes-load-vivendi) - - (add-hook 'modus-themes-after-load-theme-hook - (defun modus-themes@customize-faces () - "Customize faces of modus-themes." - ;; (dolist (face '(font-lock-builtin-face - ;; ;; font-lock-comment-delimiter-face - ;; ;; font-lock-coment-face - ;; font-lock-constant-face - ;; ;; font-lock-doc-face - ;; font-lock-function-name-face - ;; font-lock-keyword-face - ;; font-lock-negation-char-face - ;; font-lock-preprocessor-face - ;; font-lock-regexp-grouping-backslash - ;; font-lock-regexp-goruping-construct - ;; font-lock-string-face - ;; font-lock-type-face - ;; font-lock-variable-name-face - ;; font-lock-warning-face)) - ;; (modus-themes-with-colors - ;; (custom-set-faces - ;; `(,face - ;; ((,class :foreground ,fg-main - ;; :weight normal - ;; :slant normal)))))) - ;; Other faces - (modus-themes-with-colors - (custom-set-faces - `(org-level-1 - ((,class :inherit (modus-themes-heading-1 fixed-pitch) - :extend t))) - `(org-level-2 - ((,class :inherit (modus-themes-heading-2 fixed-pitch) - :extend t))) - `(org-level-3 - ((,class :inherit (modus-themes-heading-3 fixed-pitch) - :extend t))) - `(org-level-4 - ((,class :inherit (modus-themes-heading-4 fixed-pitch) - :extend t))) - `(org-level-5 - ((,class :inherit (modus-themes-heading-5 fixed-pitch) - :extend t))) - `(org-level-6 - ((,class :inherit (modus-themes-heading-6 fixed-pitch) - :extend t))) - `(org-level-7 - ((,class :inherit (modus-themes-heading-7 fixed-pitch) - :extend t))) - `(org-level-8 - ((,class :inherit (modus-themes-heading-8 fixed-pitch) - :extend t)))))))) + (load-theme 'modus-operandi t)) (setup (:straight mwim) (:global "C-a" #'mwim-beginning "C-e" #'mwim-end)) -(setup (:straight nov) - (:option nov-text-width fill-column) - (:file-match (rx ".epub" eos))) - -(setup (:straight (nyan-mode - :host github :repo "TeMPOraL/nyan-mode" - :fork (:host github :repo "duckwork/nyan-mode") - :files ("nyan-mode.el" "img"))) - (:option nyan-animate-nyancat nil - nyan-bar-length 20 - nyan-minimum-window-width (+ fill-column (/ nyan-bar-length 2))) - (nyan-mode +1) - (defun disable-nyan-mode () - "Disable `nyan-mode' in current buffer." - (setq-local nyan-mode -1)) - (dolist (mode '(eshell-mode - comint-mode)) - (add-hook mode #'disable-nyan-mode))) - -;; (setup (:straight olivetti) -;; (:option olivetti-body-width (+ fill-column 4) -;; olivetti-minimum-body-width fill-column) - -;; (:hook (defun olivetti-mode@setup () -;; (if olivetti-mode -;; (setq-local indicate-empty-lines nil -;; indicate-buffer-boundaries nil) -;; (acdw/setup-fringes))))) - -(setup (:straight (orderless - :host github - :repo "oantolin/orderless")) - (require 'orderless) - - (:option (append completion-styles) 'orderless - orderless-component-separator #'orderless-escapable-split-on-space - orderless-matching-styles '(orderless-literal - orderless-regexp - ;; orderless-flex - ) - orderless-style-dispatchers '(acdw/orderless-dispatch)) - - (:advise orderless-regexp :filter-args - (defun fix-dollar (args) - (if (string-suffix-p "$" (car args)) - (list (concat (substring (car args) 0 -1) - "[\x100000-\x10FFFD]*$")) - args))) - - (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 orderless) + (:option completion-styles '(orderless))) (setup (:straight (org :type git @@ -2179,10 +457,13 @@ browser defined in `browse-url-secondary-browser-function'." (org-contrib :type git :repo "https://git.sr.ht/~bzg/org-contrib")) - (:also-load acdw-org) - (require 'chd nil 'noerror) + ;; DO NOT load system-installed org !!! + (setq load-path (cl-remove-if (lambda (path) + (string-match-p "lisp/org\\'" path)) + load-path)) + (:also-load +org + ox-md) (:option org-adapt-indentation nil - ;; org-agenda-files nil ; only until I set this up org-catch-invisible-edits 'show-and-error org-clock-clocked-in-display 'mode-line org-clock-frame-title-format (cons @@ -2194,7 +475,7 @@ browser defined in `browse-url-secondary-browser-function'." org-confirm-babel-evaluate nil org-cycle-separator-lines 0 org-directory "~/org" - org-ellipsis " …" + org-ellipsis "…" org-export-coding-system 'utf-8-unix org-export-headline-levels 8 org-export-with-section-numbers nil @@ -2206,7 +487,8 @@ browser defined in `browse-url-secondary-browser-function'." org-fontify-whole-heading-line t org-hide-emphasis-markers t org-html-coding-system 'utf-8-unix - org-image-actual-width '(300) + org-image-actual-width (list (* (window-font-width) + (- fill-column 8))) org-imenu-depth 3 org-list-demote-modify-bullet '(("-" . "+") ("+" . "*") @@ -2224,116 +506,16 @@ browser defined in `browse-url-secondary-browser-function'." org-startup-truncated nil org-startup-with-inline-images t org-tags-column (- (- fill-column (length org-ellipsis)))) - - (:bind "RET" #'acdw-org/return-dwim - "" #'acdw-org/org-table-copy-down - ;; "M-SPC M-SPC" #'insert-zero-width-space - "C-c C-l" #'org-insert-link-dwim - "C-c w" #'chd/do-the-thing - "C-c C-n" #'acdw/org-next-heading-widen - "C-c C-p" #'acdw/org-previous-heading-widen - "C-x n t" #'org-narrow-to-task) - - (:unbind "C-j" ; org-return-and-maybe-indent - "M-j") - - (:local-set unfill-fill-function #'org-fill-paragraph - wc-count-words-function - (lambda (start end) "Count words stupidly with a limit." - (acdw-org/count-words-stupidly start - end - 999))) - - (with-eval-after-load 'org-export - (:option (append org-export-filter-final-output-functions) - #'org-export-remove-zero-width-spaces)) - - (:local-hook before-save-hook - (defun org/before-save@prettify-buffer () - (save-mark-and-excursion - (mark-whole-buffer) - (org-fill-paragraph nil t)) - (acdw-org/fix-blank-lines t) - (org-align-tags :all))) - + (:bind "RET" '+org-return-dwim + "" '+org-table-copy-down + "C-c C-l" '+org-insert-link-dwim + "C-c C-n" '+org-next-heading-widen + "C-c C-p" '+org-previous-heading-widen) + (:local-set unfill-fill-function 'org-fill-paragraph) + (:local-hook before-save-hook '+org-before-save@prettify-buffer) + (advice-add 'org-delete-backward-char :override '+org-delete-backward-char) (with-eval-after-load 'org - (org-clock-persistence-insinuate)) - - (with-eval-after-load 'consult - (defun consult-clock-in (&optional match scope resolve) - "Clock into an Org heading." - (interactive (list nil nil current-prefix-arg)) - (require 'org-clock) - (org-clock-load) - (save-window-excursion - (consult-org-heading - match - (or scope - (thread-last org-clock-history - (mapcar 'marker-buffer) - (mapcar 'buffer-file-name) - (delete-dups) - (delq nil)) - (user-error "No recent clocked tasks"))) - (org-clock-in nil (when resolve - (org-resolve-clocks) - (org-read-date t t))))) - - (consult-customize consult-clock-in - :prompt "Clock in: " - :preview-key (kbd "M-.") - :group - (lambda (cand transform) - (if transform - (substring - cand - (next-single-property-change - 0 'consult-org--buffer cand)) - (let ((m (car (get-text-property - 0 'consult-org--heading cand)))) - (if (member m org-clock-history) - "*Recent*" - (buffer-name (marker-buffer m)))))))) - - (:advise org-delete-backward-char :override #'acdw-org/delete-backward-char) - - (el-patch-feature org) - (with-eval-after-load 'org - (el-patch-defun org-format-outline-path (path &optional - width prefix separator) - "Format the outline path PATH for display. -WIDTH is the maximum number of characters that is available. -PREFIX is a prefix to be included in the returned string, -such as the file name. -SEPARATOR is inserted between the different parts of the path, -the default is \"/\"." - (setq width (or width 79)) - (setq path (delq nil path)) - (unless (> width 0) - (user-error "Argument `width' must be positive")) - (setq separator (or separator "/")) - (let* ((org-odd-levels-only nil) - (fpath (concat - prefix (and prefix path separator) - (mapconcat - (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) - (cl-loop for head in path - for n from 0 - collect - (el-patch-swap - (org-add-props - head nil 'face - (nth (% n org-n-level-faces) - org-level-faces)) - head)) - separator)))) - (when (> (length fpath) width) - (if (< width 7) - ;; It's unlikely that `width' will be this small, but don't - ;; waste characters by adding ".." if it is. - (setq fpath (substring fpath 0 width)) - (setf (substring fpath (- width 2)) ".."))) - fpath)))) + (org-clock-persistence-insinuate))) (setup (:straight org-appear) (:option org-appear-autoemphasis t @@ -2344,24 +526,10 @@ the default is \"/\"." org-appear-delay 0) (:hook-into org-mode)) -(setup (:straight org-sticky-header) - (:hook-into org-mode)) - -(setup (:straight package-lint - package-lint-flymake)) - -(setup (:straight page-break-lines) - (global-page-break-lines-mode +1)) - (setup (:straight paredit) - (:bind "DEL" #'paredit-backward-delete - "C-" #'paredit-backward-kill-word - "M-w" #'paredit-copy-as-kill - "RET" #'paredit-newline) - (:unbind "C-j" ; paredit-newline - ) + (:bind "DEL" 'paredit-backward-delete + "C-" 'paredit-backward-kill-word) (:hook-into emacs-lisp-mode lisp-interaction-mode - ielm-mode sly-repl-mode lisp-mode scheme-mode) (:also-load eldoc) (eldoc-add-command 'paredit-backward-delete 'paredit-close-round)) @@ -2373,163 +541,28 @@ the default is \"/\"." lisp-interaction-mode scheme-mode)) -(setup (:straight-when (pdf-tools - :host github - :repo "vedang/pdf-tools") - (acdw/system :home)) - (:file-match (rx ".pdf" eos)) - (pdf-loader-install)) - -(setup (:straight popper) - (:option popper-reference-buffers - `(,(rx "*Messages*") - ,(rx "Output*" eol) - ,(rx "*Async Shell Command*") - help-mode helpful-mode - compilation-mode) - popper-mode-line nil - popper-display-control t - popper-display-function - (defun popper/select-popup-smartly (buffer &optional _alist) - (let* ((widep (> (frame-pixel-width) (frame-pixel-height))) - (window (display-buffer-in-side-window - buffer - `((side . ,(if widep 'right 'bottom)) - (slot . 1) - ,(if widep - (cons 'window-width - popper-window-height) - (cons 'window-height - popper-window-height)))))) - (select-window window))) - popper-window-height - (defun popper/figure-window-height (window) - (let* ((widep (> (frame-pixel-width) (frame-pixel-height))) - (fit-window-to-buffer-horizontally widep)) - (fit-window-to-buffer - window - (floor (frame-pixel-height) 2) - (floor (frame-pixel-height) 4) - fill-column - fill-column)))) - (:global "M-`" #'popper-toggle-latest - "C-`" #'popper-cycle) - (popper-mode +1) - (when (fboundp 'popper-echo-mode) - (popper-echo-mode +1))) - -(setup (:straight-when (powershell - :host github - :repo "jschaf/powershell.el") - (acdw/system :work))) - (setup (:straight (shell-command+ :host nil :repo "https://git.sr.ht/~pkal/shell-command-plus")) (:option shell-command-prompt "$ ") - (:with-feature dired - (:bind "M-!" shell-command+)) - (:global "M-!" shell-command+)) - -(setup (:straight sicp)) + (:bind-into dired + "M-!" 'shell-command+) + (:global "M-!" 'shell-command+)) -(setup (:straight simple-modeline - minions) - (:also-load acdw-modeline) - (:option simple-modeline-segments - ;; Yeah this is laid out like poo. It's so I can easily change - ;; things around if need be. - '((;; left - acdw-modeline/winum - acdw-modeline/modified - acdw-modeline/buffer-name - acdw-modeline/vc-branch - acdw-modeline/wc - acdw-modeline/nyan-cat - acdw-modeline/position - ) (;; right - acdw-modeline/track - simple-modeline-segment-misc-info - acdw-modeline/text-scale - simple-modeline-segment-process - acdw-modeline/god-mode-indicator - acdw-modeline/minions - acdw-modeline/reading-mode - acdw-modeline/narrowed - acdw-modeline/major-mode - ))) - - (:option tab-bar-mode t - tab-bar-show 1) - - ;; I've put in a pull request to add the (- 0 right-margin) bit here. - (el-patch-feature simple-modeline) - (with-eval-after-load 'simple-modeline - (el-patch-defun simple-modeline--format (left-segments right-segments) - "Return a string of `window-width' length containing LEFT-SEGMENTS and RIGHT-SEGMENTS, aligned respectively." - (let* ((left (simple-modeline--format-segments left-segments)) - (right (simple-modeline--format-segments right-segments)) - (reserve (length right))) - (concat - left - (propertize " " - 'display (el-patch-swap - `((space :align-to (- right ,reserve))) - `((space :align-to - (- right - (- 1 right-fringe right-margin) - ,reserve)))) - 'face '(:inherit simple-modeline-space)) - right)))) - - (simple-modeline-mode +1)) - -(setup (:straight-when sly - (progn - (defvar acdw/lisps - (let (lisps) - (dolist (lisp '("sbcl" ; TODO: add more lisps - "clisp")) - (when-let (binary (executable-find lisp)) - (push binary lisps))) - (nreverse lisps))) - acdw/lisps)) - (:also-load sly-autoloads) - (:straight clhs) - - (:option inferior-lisp-program acdw/lisp-bin - sly-kill-without-query-p t) - - (:with-feature sly-mrepl - (defun sly-mrepl-return-at-end () - (interactive) - (if (<= (point-max) (point)) - (sly-mrepl-return) - (if (bound-and-true-p paredit-mode) - (paredit-newline) - (electric-newline-and-maybe-indent)))) - - (dolist (key '("RET" "")) - (:bind key #'sly-mrepl-return-at-end)) - - (:bind "C-c C-c" #'sly-mrepl-return))) - -(setup (:straight (spongebob-case +(setup (:straight (sophomore :host github - :repo "duckwork/spongebob-case.el")) - (:global "C-c c s" #'spongebob-case-dwim)) + :repo "duckwork/sophomore.el")) + (:option disabled-command-function 'sophomore-dispatch + sophomore-dispatch-alist '((fatfinger . sophomore-fat-finger))) + (put 'save-buffers-kill-terminal 'disabled 'fatfinger)) (setup (:straight ssh-config-mode) (:file-match (rx "/.ssh/config" eos) (rx "/ssh" (? "d") "_config" eos)) - (:with-mode ssh-known-hosts-mode (:file-match (rx "/knownhosts" eos))) - (:with-mode ssh-authorized-keys-mode - (:file-match (rx "/authorized_keys" (? "2") eos))) - - (:hook #'turn-on-font-lock)) + (:file-match (rx "/authorized_keys" (? "2") eos)))) (setup (:straight super-save) (:option auto-save-default nil @@ -2540,72 +573,9 @@ the default is \"/\"." (auto-save-visited-mode -1) (super-save-mode +1)) -(setup (:straight-when system-packages - (seq-some #'executable-find - ;; I can't use `system-packages-supported-package-managers' - ;; because, well, the package isn't installed yet. So - ;; ... update this list if any package managers are added. - '("guix" "nix" - "brew" "macports" - "pacman" "emerge" - "zypper" "dnf" - "apt" "aptitude" - "xbps")))) - -(setup (:straight-when systemd - (executable-find "systemd"))) - -(setup (:straight (topsy - :host github - :repo "alphapapa/topsy.el")) - (:hook-into prog-mode) - (:when-loaded - (:option topsy-header-line-format - `(:eval - (list - (propertize " " - 'display - `((space - :align-to - ,(unless - (bound-and-true-p visual-fill-column-mode) - 0)))) - (funcall topsy-fn)))))) - (setup (:straight trashed) (:option trashed-action-confirmer #'y-or-n-p)) -(setup (:straight typo) - - ;; Enable C-c 8 map in all buffers - (typo-global-mode +1) - - (add-hook 'text-mode-hook - (defun text-mode@typo-unless () - "Start `typo-mode' UNLESS the buffer matches a predicate." - ;; I implement this instead of using - ;; `typo-disable-electricity-functions' because the latter checks - ;; on every pertinent keypress. I know I want /no/ typo-ing in - ;; these certain buffers, so I won't even turn on the mode. - (unless (or ; predicates here - (string-match-p "COMMIT_EDITMSG" - (or (buffer-name) ""))) - (typo-mode +1)))) - - ;; jlf & cvandusen on #emacs make a great point: ’ (RIGHT SINGLE QUOTATION - ;; MARK) is /not/ an apostrophe. Making it curly is a typographical - ;; consideration, not an input consideration. (I suppose you could make - ;; the argument that all of these are typographical considerations, but - ;; .. bleh.) - (:bind "'" (define-typo-cycle typo-cycle-apostrophe - "Cycle through apostrophe-like graphemes. -If used with a numeric prefix argument N, N apostrophes will be inserted." - ("'" "′" "″" "’")) - "`" (define-typo-cycle typo-cycle-backtick - "Cycle through backtick and left single quotation mark. -If used with a numeric prefix argument N, N backticks will be inserted." - ("`" "‘")))) - (setup (:straight undo-fu) (:global "C-/" #'undo-fu-only-undo "C-?" #'undo-fu-only-redo)) @@ -2613,146 +583,40 @@ If used with a numeric prefix argument N, N backticks will be inserted." (setup (:straight undo-fu-session) (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" "/git-rebase-todo\\'") - undo-fu-session-directory (acdw/dir "undo/" t) - undo-fu-session-compression (acdw/system :home)) - + undo-fu-session-directory (.etc "undo/" t) + undo-fu-session-compression (eq system-type 'gnu/linux)) (global-undo-fu-session-mode +1)) (setup (:straight (unfill :host github :repo "purcell/unfill" :fork (:host github :repo "duckwork/unfill"))) (:global "M-q" #'unfill-toggle)) -(setup (:straight (unfocused - :host github - :repo "duckwork/unfocused")) - (unfocused-mode +1) - - (:with-hook unfocused-hook - (:hook #'garbage-collect))) - (setup (:straight (vertico :host github :repo "minad/vertico" :files ("*" "extensions/*" (:exclude ".git")))) - (:option resize-mini-windows 'grow-only vertico-count-format nil vertico-cycle t) - (when (boundp 'native-comp-deferred-compilation-deny-list) (add-to-list 'native-comp-deferred-compilation-deny-list "vertico")) - (vertico-mode +1) - - ;; Extensions! - (:also-load vertico-mouse - vertico-directory) - (vertico-mouse-mode +1) + ;; Extensions + (:also-load vertico-directory) (:with-map vertico-map - (:bind "RET" #'vertico-directory-enter - "DEL" #'vertico-directory-delete-char - "M-DEL" #'vertico-directory-delete-word)) - (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) + (:bind "RET" 'vertico-directory-enter + "DEL" 'vertico-directory-delete-char + "M-DEL" 'vertico-directory-delete-word)) + (add-hook 'rfn-eshadow-update-overlay-hook 'vertico-directory-tidy)) (setup (:straight visual-fill-column) - (:option visual-fill-column-width (1+ fill-column) - visual-fill-column-center-text t - (append reading-modes) '(visual-fill-column-mode . +1) - (append reading-modes) '(visual-line-mode . +1) - (append reading-vars) '(fill-column . 0)) + (:option visual-fill-column-center-text t) (:hook-into org-mode) - (:hook (defun visual-fill-column@setup () - (if visual-fill-column-mode - (setq-local indicate-empty-lines nil - indicate-buffer-boundaries nil) - (acdw/setup-fringes)))) - (:advise text-scale-adjust :after #'visual-fill-column-adjust) - ;; Fix bindings - (when (bound-and-true-p mouse-wheel-mode) - (with-eval-after-load 'visual-fill-column - (dolist (margin '(right-margin left-margin)) - (dolist (event '(wheel-down wheel-up)) - (define-key visual-fill-column-mode-map - (vector margin event) - #'mwheel-scroll)))))) - -(setup (:straight visual-regexp) - (:global "M-%" #'vr/query-replace)) - -(setup (:straight-when vterm - (acdw/system :home)) - (:straight (eshell-vterm - :host github - :repo "iostapyshyn/eshell-vterm")) - (eshell-vterm-mode +1) - (defalias 'eshell/v 'eshell-exec-visual)) - -(setup (:straight wc-mode) - (:option wc-modeline-format "[%tww]" - wc-idle-wait 2) - (:hook-into text-mode) - (:unbind "C-c C-w a" - "C-c C-w c" - "C-c C-w l" - "C-c C-w w" - "C-c C-w")) - -(setup (:straight web-mode) - (:option css-level-offset 2 - js-indent-level 2 - sgml-indent-offset 2) - - (:file-match (rx ".htm" (? "l") eos) - (rx "." (? "tpl.") "php" eos) - (rx "." (| "asp" "gsp" "jsp") eos) - (rx "." (| "ascx" "aspx") eos) - (rx ".erb" eos) - (rx ".mustache" eos))) - -(setup (:straight wgrep) - (wgrep-setup)) - -;; (setup (:straight which-key) -;; (:option which-key-show-early-on-C-h t -;; which-key-idle-delay 1 -;; which-key-idle-secondary-delay 0.5 -;; which-key-sort-order 'which-key-prefix-then-key-order) - -;; (:global "C-h m" #'which-key-show-major-mode) - -;; (which-key-setup-side-window-right-bottom) -;; (which-key-mode +1)) + (with-eval-after-load 'visual-fill-column + (advice-add 'text-scale-adjust :after 'visual-fill-column-adjust))) (setup (:straight whitespace-cleanup-mode) + (:option whitespace-cleanup-mode-preserve-point t) + (remove-hook 'before-save-hook 'whitespace-cleanup) (global-whitespace-cleanup-mode +1)) - -(setup (:straight winum) - (:option winum-scope 'frame-local - winum-auto-setup-mode-line nil - winum-ignored-buffers '(" *which-key*") - winum-format " %s") - - (winum-mode +1)) - -(setup (:straight xr)) - -(setup (:straight-when ytdious - (executable-find "mpv")) - (:also-load acdw-ytel) ; so named because I used ytel first - (:option ytdious-invidious-api-url "https://invidious.snopyta.org") - (:hook #'hl-line-mode) - (:global "C-c y" #'ytdious) - (:bind "v" #'acdw/ytdious-watch - "w" #'acdw/ytdious-copy-link - "q" #'acdw/ytdious-quit)) - -(setup (:straight zzz-to-char) - - (:global "M-z" - (defun acdw/zzz-up-to-char (prefix) - "Call `zzz-up-to-char' or `zzz-to-char', PREFIX-depending." - (interactive "P") - (if prefix - (call-interactively #'zzz-up-to-char) - (call-interactively #'zzz-to-char))))) diff --git a/lisp/+avy.el b/lisp/+avy.el new file mode 100644 index 0000000..5010e95 --- /dev/null +++ b/lisp/+avy.el @@ -0,0 +1,21 @@ +;;; +avy.el -*- lexical-binding: t -*- + +;;; Commentary: + +;; https://karthinks.com/software/avy-can-do-anything/ + +;;; Code: + +(require 'avy) + +(defun avy-action-embark (pt) + (unwind-protect + (save-excursion + (goto-char pt) + (embark-act)) + (select-window + (cdr (ring-ref avy-ring 0)))) + t) + +(provide '+avy) +;;; avy.el ends here diff --git a/lisp/+circe.el b/lisp/+circe.el new file mode 100644 index 0000000..1403af8 --- /dev/null +++ b/lisp/+circe.el @@ -0,0 +1,148 @@ +;;; +circe.el -*- lexical-binding: t; -*- + +;;; Code: + +(require '+util) +(require 'circe) + +(defgroup +circe nil + "Extra customizations for Circe." + :group 'circe) + +(defcustom +circe-left-margin 16 + "The size of the margin on the left." + :type 'integer) + +(defcustom +circe-network-inhibit-autoconnect nil + "Servers to inhibit autoconnecting from `circe-network-options'." + :type '(repeat string)) + +;;; Connecting to IRC + +;;;###autoload +(defun +irc () + "Connect to all IRC networks in `circe-network-options'." + (interactive) + (dolist (network (mapcar 'car circe-network-options)) + (unless (member network +circe-network-inhibit-autoconnect) + (+circe-maybe-connect network)))) + +(defun +circe-network-connected-p (network) + "Return t if connected to NETWORK, nil otherwise." + (catch 'return + (dolist (buffer (circe-server-buffers)) + (with-current-buffer buffer + (when (string= network circe-server-network) + (throw 'return t)))))) + +(defun +circe-maybe-connect (network) + "Connect to NETWORK, asking for confirmation to reconnect." + (interactive ("sNetwork: ")) + (when (or (not (+circe-network-connected-p network)) + (yes-or-no-p (format "Already connected to %s, reconnect? " + network))) + (circe network))) + +;;; Channel information + +(defun +circe-current-topic (&optional message) + "Return the topic of the current channel. +When called with optional MESSAGE non-nil, or interactively, also +message the current topic.") + +;;; Formatting messages + +(defun +circe-format-meta (string) + "Return a format string for `lui-format' for metadata messages." + (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string)) + +;;; Hooks & Advice + +(defun +circe-chat@set-prompt () + "Set the prompt to the (shortened) buffer name." + (interactive) + (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin + :after " > " + :ellipsis "~" + :alignment 'right)))) + +(defun +circe-kill-buffer (&rest _) + "Kill a circe buffer without confirmation, and after a delay." + (let ((circe-channel-killed-confirmation nil) + (circe-server-killed-confirmation nil)) + (run-with-timer 0.25 nil 'kill-buffer))) + +(defun +circe-quit@kill-buffer (&rest _) + "ADVICE: kill all buffers of a server after `circe-command-QUIT'." + (with-circe-server-buffer + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (+circe-kill-buffer))) + (+circe-kill-buffer))) + +(defun +circe-gquit@kill-buffer (&rest _) + "ADVICE: kill all Circe buffers after `circe-command-GQUIT'." + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (+circe-quit@kill-buffer)))) + +;;; Patches + +(require 'el-patch) + +(el-patch-feature circe) +(defvar circe-server-buffer-action 'pop-to-buffer-same-window + "What to do with `circe-server' buffers when created.") + +(el-patch-defun circe (network-or-server &rest server-options) + "Connect to IRC. + +Connect to the given network specified by NETWORK-OR-SERVER. + +When this function is called, it collects options from the +SERVER-OPTIONS argument, the user variable +`circe-network-options', and the defaults found in +`circe-network-defaults', in this order. + +If NETWORK-OR-SERVER is not found in any of these variables, the +argument is assumed to be the host name for the server, and all +relevant settings must be passed via SERVER-OPTIONS. + +All SERVER-OPTIONS are treated as variables by getting the string +\"circe-\" prepended to their name. This variable is then set +locally in the server buffer. + +See `circe-network-options' for a list of common options." + (interactive (circe--read-network-and-options)) + (let* ((options (circe--server-get-network-options network-or-server + server-options)) + (buffer (circe--server-generate-buffer options))) + (with-current-buffer buffer + (circe-server-mode) + (circe--server-set-variables options) + (circe-reconnect)) + (el-patch-swap (pop-to-buffer-same-window buffer) + (funcall circe-server-buffer-action buffer)))) + +;;; Chat commands + +(defun circe-command-SHORTEN (url) + "Shorten URL using `0x0-shorten-uri'.") + +(defun circe-command-SLAP (nick) + "Slap NICK around a bit with a large trout.") + +;;; Pure idiocy + +(define-minor-mode circe-cappy-hour-mode + "ENABLE CAPPY HOUR IN CIRCE!" + :lighter "CAPPY HOUR" + (when (derived-mode-p 'circe-chat-mode) + (if circe-cappy-hour-mode + (setq-local lui-input-function + (lambda (input) (circe--input (upcase input)))) + ;; XXX: It'd be better if this were more general, but whatever. + (setq-local lui-input-function #'circe--input)))) + +(provide '+circe) +;;; +circe.el ends here diff --git a/lisp/+consult.el b/lisp/+consult.el new file mode 100644 index 0000000..7b6a20f --- /dev/null +++ b/lisp/+consult.el @@ -0,0 +1,47 @@ +;;; +consult.el --- consult additions -*- lexical-binding: t -*- + +;;; Code: + +(defun +consult-project-root () + "Return either the current project, or the VC root, of current file." + (if (and (functionp 'project-current) + (project-current)) + (car (project-roots (project-current))) + (vc-root-dir))) + +;;; Cribbed functions +;; https://github.com/minad/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)))) + +(defmacro consult-history-to-modes (map-hook-alist) + (let (defuns) + (dolist (map-hook map-hook-alist) + (let ((map-name (symbol-name (car map-hook))) + (key-defs `(progn (define-key + ,(car map-hook) + (kbd "M-r") + (function consult-history)) + (define-key ,(car map-hook) + (kbd "M-s") nil)))) + (push (if (cdr map-hook) + `(add-hook ',(cdr map-hook) + (defun + ,(intern (concat map-name + "@consult-history-bind")) + nil + ,(concat + "Bind `consult-history' to M-r in " + map-name ".\n" + "Defined by `consult-history-to-modes'.") + ,key-defs)) + key-defs) + defuns))) + `(progn ,@ (nreverse defuns)))) + +(provide '+consult) +;;; +consult.el ends here diff --git a/lisp/+defaults.el b/lisp/+defaults.el new file mode 100644 index 0000000..ee49480 --- /dev/null +++ b/lisp/+defaults.el @@ -0,0 +1,239 @@ +;;; +defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- + +;;; Commentary: + +;; I find myself copy-pasting a lot of "boilerplate" type code when +;; bankrupting my Emacs config and starting afresh. Instead of doing +;; that, I'm putting it here, where it'll be easier to include in my +;; config. + +;; Of course, some might say I could just ... stop bankrupting my +;; Emacs. But like, why would I want to? + +;; Other notable packages include +;; https://git.sr.ht/~technomancy/better-defaults/ + +;;; Code: + +(require 'early-init (locate-user-emacs-file "early-init.el")) + +(defun +set-major-mode-from-buffer-name (&optional buf) + "Set the major mode for BUF from the buffer's name. +Do this only if the buffer is not visiting a file." + (unless buffer-file-name + (let ((buffer-file-name (buffer-name buf))) + (set-auto-mode)))) + +;;; General settings + +(setq-default + apropos-do-all t + async-shell-command-buffer 'new-buffer + async-shell-command-display-buffer nil + auto-hscroll-mode 'current-line + auto-revert-verbose nil + auto-save-file-name-transforms `((".*" ,(.etc "auto-save/" t) t)) + auto-save-interval 60 + auto-save-list-file-prefix (.etc "auto-save/.saves-" t) + auto-save-timeout 60 + auto-save-visited-interval 60 + auto-window-vscroll nil + backup-by-copying t + backup-directory-alist `((".*" . ,(.etc "backup/" t))) + blink-cursor-blinks 1 + completion-category-defaults nil + completion-category-overrides '((file (styles . (partial-completion)))) + completion-ignore-case t + completion-styles '(substring partial-completion) + cursor-in-non-selected-windows 'hollow + cursor-type 'bar + custom-file (.etc "custom.el") + delete-old-versions t + echo-keystrokes 0.1 + ediff-window-setup-function 'ediff-setup-windows-plain + eldoc-echo-area-use-multiline-p nil + eldoc-idle-delay 0.1 + enable-recursive-minibuffers t + executable-prefix-env t + fast-but-imprecise-scrolling t + file-name-shadow-properties '(invisible t intangible t) + frame-resize-pixelwise t + global-auto-revert-non-file-buffers t + global-mark-ring-max 100 + hscroll-step 1 + imenu-auto-rescan t + indent-tabs-mode nil + inhibit-startup-screen t + initial-buffer-choice t + kill-do-not-save-duplicates t + kill-read-only-ok t + kill-ring-max 500 + kmacro-ring-max 20 + load-prefer-newer t + major-mode '+set-major-mode-from-buffer-name + mark-ring-max 50 + minibuffer-eldef-shorten-default t + minibuffer-prompt-properties '(read-only t + cursor-intangible t + face minibuffer-prompt) + mode-require-final-newline 'visit-save + mouse-drag-copy-region t + mouse-yank-at-point t + native-comp-async-report-warnings-errors 'silent + read-answer-short t + read-buffer-completion-ignore-case t + read-extended-command-predicate (when + (fboundp + 'command-completion-default-include-p) + 'command-completion-default-include-p) + recenter-positions '(top middle bottom) + regexp-search-ring-max 100 + regexp-search-ring-max 200 + save-interprogram-paste-before-kill t + scroll-conservatively 101 + scroll-preserve-screen-position 1 + scroll-step 1 + search-ring-max 200 + search-ring-max 200 + sentence-end-double-space t + set-mark-command-repeat-pop t + show-paren-delay 0 + show-paren-style 'mixed + show-paren-when-point-in-periphery t + show-paren-when-point-inside-paren t + tramp-backup-directory-alist backup-directory-alist + use-dialog-box nil + use-file-dialog nil + use-short-answers t + vc-follow-symlinks t + vc-make-backup-files t + version-control t + view-read-only t + visible-bell nil + window-resize-pixelwise t + x-select-enable-clipboard t + x-select-enable-primary t + yank-pop-change-selection t + ) + +(when (version< emacs-version "28") + (fset 'yes-or-no-p 'y-or-n-p)) + +;; Encoding -- UTF-8 everywhere +(setq-default locale-coding-system 'utf-8-unix + coding-system-for-read 'utf-8-unix + coding-system-for-write 'utf-8-unix + buffer-file-coding-system 'utf-8-unix + default-process-coding-system '(utf-8-unix . utf-8-unix) + x-select-request-type '(UTF8_STRING + COMPOUND_TEXT + TEXT + STRING)) + +(set-charset-priority 'unicode) +(set-language-environment "UTF-8") +(prefer-coding-system 'utf-8-unix) +(set-default-coding-systems 'utf-8-unix) +(set-terminal-coding-system 'utf-8-unix) +(set-keyboard-coding-system 'utf-8-unix) + +(pcase system-type + ((or 'ms-dos 'windows-nt) + (set-clipboard-coding-system 'utf-16-le) + (set-selection-coding-system 'utf-16-le)) + (_ + (set-selection-coding-system 'utf-8) + (set-clipboard-coding-system 'utf-8))) + +;;; Modes + +(dolist (enable-mode '(global-auto-revert-mode + blink-cursor-mode + electric-pair-mode + show-paren-mode + global-so-long-mode + minibuffer-depth-indicate-mode + file-name-shadow-mode + minibuffer-electric-default-mode + delete-selection-mode + column-number-mode)) + (when (fboundp enable-mode) + (funcall enable-mode +1))) + +(dolist (disable-mode '(tooltip-mode + tool-bar-mode + menu-bar-mode + scroll-bar-mode + horizontal-scroll-bar-mode)) + (when (fboundp disable-mode) + (funcall disable-mode -1))) + +;;; Hooks + +(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p) +(add-hook 'minibuffer-setup-hook 'cursor-intangible-mode) + +;;; Bindings + +(global-set-key (kbd "M-/") 'hippie-expand) +(global-set-key (kbd "M-=") 'count-words) +(global-set-key (kbd "C-x C-b") 'ibuffer) +(global-set-key (kbd "C-s") 'isearch-forward-regexp) +(global-set-key (kbd "C-r") 'isearch-backward-regexp) +(global-set-key (kbd "C-M-s") 'isearch-forward) +(global-set-key (kbd "C-M-r") 'isearch-backward) + +;;; Required libraries + +(when (require 'uniquify nil :noerror) + (setq-default uniquify-buffer-name-style 'forward + uniquify-separator path-separator + uniquify-after-kill-buffer-p t + uniquify-ignore-buffers-re "^\\*")) + +(when (require 'goto-addr) + (if (fboundp 'global-goto-address-mode) + (global-goto-address-mode +1) + (add-hook 'after-change-major-mode-hook 'goto-address-mode))) + +(when (require 'recentf nil :noerror) + (setq-default recentf-save-file (.etc "recentf.el") + recentf-max-menu-items 100 + recentf-max-saved-items nil + recentf-auto-cleanup 'mode) + (add-to-list 'recentf-exclude .etc) + (recentf-mode +1)) + +(when (require 'repeat nil :noerror) + (setq-default repeat-exit-key "g" + repeat-exit-timeout 5) + (repeat-mode +1)) + +(when (require 'savehist nil :noerror) + (setq-default history-length t + history-delete-duplicates t + history-autosave-interval 60 + savehist-file (.etc "savehist.el")) + (dolist (var '(extended-command-history + global-mark-ring + kill-ring + regexp-search-ring + search-ring + mark-ring)) + (add-to-list 'savehist-additional-variables var)) + (savehist-mode +1)) + +(when (require 'saveplace nil :noerror) + (setq-default save-place-file (.etc "places.el") + save-place-forget-unreadable-files (eq system-type 'gnu/linux)) + (save-place-mode +1)) + +(when (require 'tramp) + ;; thanks Irreal! https://irreal.org/blog/?p=895 + (add-to-list 'tramp-default-proxies-alist + '(nil "\\`root\\'" "/ssh:%h:")) + (add-to-list 'tramp-default-proxies-alist + '((regexp-quote (system-name)) nil nil))) + +(provide '+defaults) +;;; +defaults.el ends here diff --git a/lisp/+dired.el b/lisp/+dired.el new file mode 100644 index 0000000..7decec1 --- /dev/null +++ b/lisp/+dired.el @@ -0,0 +1,8 @@ +;;; +dired.el -*- lexical-binding: t -*- + +;;; Code: + + + +(provide '+dired) +;;; +dired.el ends here diff --git a/lisp/+eshell.el b/lisp/+eshell.el new file mode 100644 index 0000000..bd92b03 --- /dev/null +++ b/lisp/+eshell.el @@ -0,0 +1,80 @@ +;;; +eshell.el -*- lexical-binding: t; -*- + +;;; Code: + +;; https://karthinks.com/software/jumping-directories-in-eshell/ +(defun eshell/z (&optional regexp) + "Navigate to a previously visited directory in eshell, or to +any directory proferred by `consult-dir'." + (let ((eshell-dirs (delete-dups + (mapcar 'abbreviate-file-name + (ring-elements eshell-last-dir-ring))))) + (cond + ((and (not regexp) (featurep 'consult-dir)) + (let* ((consult-dir--source-eshell `(:name "Eshell" + :narrow ?e + :category file + :face consult-file + :items ,eshell-dirs)) + (consult-dir-sources (cons consult-dir--source-eshell + consult-dir-sources))) + (eshell/cd (substring-no-properties + (consult-dir--pick "Switch directory: "))))) + (t (eshell/cd (if regexp (eshell-find-previous-directory regexp) + (completing-read "cd: " eshell-dirs))))))) + +;;; Start and quit + +(defun +eshell-quit-or-delete-char (arg) + "Delete the character to the right, or quit eshell on an empty line." + (interactive "p") + (if (and (eolp) (looking-back eshell-prompt-regexp)) + (eshell-life-is-too-much) + (delete-forward-char arg))) + +;;; Insert previous arguments +;; Record arguments + +(defvar eshell-arg-history nil) +(defvar eshell-arg-history-index nil) +(add-to-list 'savehist-additional-variables 'eshell-arg-history) + +(defun eshell-record-args (&rest _) + "Record unique arguments onto the front of `eshell-arg-history'." + (setq eshell-arg-history + (cl-loop with history = eshell-arg-history + for arg in (reverse eshell-last-arguments) + do (setq history (cons arg (remove arg history))) + finally return history))) + +(defun eshell-insert-prev-arg () + "Insert an argument from `eshell-arg-history' at point." + (interactive) + (if (eq last-command 'eshell-insert-prev-arg) + (progn + (let ((pos (point))) + (eshell-backward-argument 1) + (delete-region (point) pos)) + (if-let ((text (nth eshell-arg-history-index + eshell-arg-history))) + (progn + (insert text) + (cl-incf eshell-arg-history-index)) + (insert (cl-first eshell-arg-history)) + (setq eshell-arg-history-index 1))) + (insert (cl-first eshell-arg-history)) + (setq eshell-arg-history-index 1))) + +;;;###autoload +(define-minor-mode eshell-arg-hist-mode + "Minor mode to enable argument history, like bash/zsh with M-." + :lighter "$." + :keymap (let ((map (make-sparse-keymap))) + (define-key map (kbd "M-.") #'eshell-insert-prev-arg) + map) + (if eshell-arg-hist-mode + (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) + (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) + +(provide '+eshell) +;;; +eshell.el ends here diff --git a/lisp/+init.el b/lisp/+init.el new file mode 100644 index 0000000..3ab0486 --- /dev/null +++ b/lisp/+init.el @@ -0,0 +1,92 @@ +;;; +init.el --- extra init.el stuff -*- lexical-binding: t -*- + +;;; Commentary: + +;; Yes, I edit my init.el often enough I need to write a mode for it. + +;;; Code: + +(require '+lisp) + +;;; Sort `setup' forms + +(defun +init--sexp-setup-p (sexp-str &optional head) + "Is SEXP-STR a `setup' form, optionally with a HEAD form?" + (let ((head (if (and head (symbolp head)) + (symbol-name head) + head))) + (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str) + (if head + (string-match-p (concat "\\`.*" head) sexp-str) + t)))) + +(defun +init-sort () + "Sort init.el. +Sort based on the following heuristic: `setup' forms (the +majority of my init.el) are sorted after everything else, and +within that group, forms with a HEAD of `:require' are sorted +first, and `:straight' HEADs are sorted last. All other forms +are sorted lexigraphically." + (interactive) + (save-excursion + (save-restriction + (widen) + (+lisp-sort-sexps + (point-min) (point-max) + ;; Key function + nil + ;; Sort function + (lambda (s1 s2) + (let ((s1 (cdr s1)) (s2 (cdr s2))) + (cond + ;; Sort everything /not/ `setup' /before/ `setup' + ((and (+init--sexp-setup-p s1) + (not (+init--sexp-setup-p s2))) + nil) + ((and (+init--sexp-setup-p s2) + (not (+init--sexp-setup-p s1))) + t) + ;; otherwise... + (t (let ((s1-straight (+init--sexp-setup-p s1 :straight)) + (s2-straight (+init--sexp-setup-p s2 :straight)) + (s1-require (+init--sexp-setup-p s1 :require)) + (s2-require (+init--sexp-setup-p s2 :require))) + (cond + ;; `:straight' setups have extra processing + ((and s1-straight s2-straight) + (let* ((r (rx (: ":straight" (? "-when") (* space) (? "(")))) + (s1 (replace-regexp-in-string r "" s1)) + (s2 (replace-regexp-in-string r "" s2))) + (string< s1 s2))) + ;; `:require' setups go first + ((and s1-require (not s2-require)) t) + ((and s2-require (not s1-require)) nil) + ;; `:straight' setups go last + ((and s1-straight (not s2-straight)) nil) + ((and s2-straight (not s1-straight)) t) + ;; otherwise, sort lexigraphically + (t (string< s1 s2)))))))))))) + +;;; Add `setup' forms to `imenu-generic-expression' + +(defun +init-add-setup-to-imenu () + "Recognize `setup' forms in `imenu'." + ;; `imenu-generic-expression' automatically becomes buffer-local when set + (setf (alist-get "Setup" imenu-generic-expression nil nil 'string-equal) + (list + (rx (: bol (* space) + "(setup" (+ space) + (group (? "(") (* nonl)))) + 1))) + +;;; Major mode + +;;;###autoload +(define-derived-mode +init-mode emacs-lisp-mode "Init.el" + "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.") + +;;;###autoload +(add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode)) + +(provide '+init) +;;; +init.el ends here diff --git a/lisp/+lisp.el b/lisp/+lisp.el new file mode 100644 index 0000000..3267fd9 --- /dev/null +++ b/lisp/+lisp.el @@ -0,0 +1,71 @@ +;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*- + +;;; Code: + +;;; Sort sexps in a region. +;; https://github.com/alphapapa/unpackaged.el + +(defun +lisp-skip-whitespace () + (while (looking-at (rx (1+ (or space "\n")))) + (goto-char (match-end 0)))) + +(defun +lisp-skip-both () + (while (cond ((or (nth 4 (syntax-ppss)) + (ignore-errors + (save-excursion + (forward-char 1) + (nth 4 (syntax-ppss))))) + (forward-line 1)) + ((looking-at (rx (1+ (or space "\n")))) + (goto-char (match-end 0)))))) + +(defun +lisp-sort-sexps (beg end &optional key-fn sort-fn) + "Sort sexps between BEG and END. +Comments stay with the code below. + +Optional argument KEY-FN will determine where in each sexp to +start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) + +Optional argument SORT-FN will determine how to sort two sexps' +strings. It's passed to `sort'. By default, it sorts the sexps +with `string<' starting with the key determined by KEY-FN." + (interactive "r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (+lisp-skip-both) + (cl-destructuring-bind (sexps markers) + (cl-loop do (+lisp-skip-whitespace) + for start = (point-marker) + for sexp = (ignore-errors + (read (current-buffer))) + for end = (point-marker) + while sexp + ;; Collect the real string, then one used for sorting. + collect (cons (buffer-substring (marker-position start) + (marker-position end)) + (save-excursion + (goto-char (marker-position start)) + (+lisp-skip-both) + (if key-fn + (funcall key-fn sexp) + (buffer-substring + (point) + (marker-position end))))) + into sexps + collect (cons start end) + into markers + finally return (list sexps markers)) + (setq sexps (sort sexps (if sort-fn sort-fn + (lambda (a b) + (string< (cdr a) (cdr b)))))) + (cl-loop for (real . sort) in sexps + for (start . end) in markers + do (progn + (goto-char (marker-position start)) + (insert-before-markers real) + (delete-region (point) (marker-position end)))))))) + +(provide '+lisp) +;;; +lisp.el ends here diff --git a/lisp/+org.el b/lisp/+org.el new file mode 100644 index 0000000..a4ce230 --- /dev/null +++ b/lisp/+org.el @@ -0,0 +1,341 @@ +;;; +org.el -*- lexical-binding: t; -*- + +;;; Code: + +(require 'org) +(require 'org-element) +(require 'ox) + +;;; 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-element-descendant-of (type element) + "Return non-nil if ELEMENT is a descendant of TYPE. +TYPE should be an element type, like `item' or `paragraph'. +ELEMENT should be a list like that returned by `org-element-context'." + ;; MAYBE: Use `org-element-lineage'. + (when-let* ((parent (org-element-property :parent element))) + (or (eq type (car parent)) + (+org-element-descendant-of type parent)))) + +(defun +org-return-dwim (&optional prefix) + "A helpful replacement for `org-return'. With PREFIX, call `org-return'. + +On headings, move point to position after entry content. In +lists, insert a new item or end the list, with checkbox if +appropriate. In tables, insert a new row or end the table." + (interactive "P") + ;; Auto-fill if enabled + (when auto-fill-function + (if (listp auto-fill-function) + (dolist (func auto-fill-function) + (funcall func)) + (funcall auto-fill-function))) + (if prefix + ;; Handle prefix args + (pcase prefix + ('(4) (newline)) + ('(16) (newline 2)) + ;; this is ... not ideal. but whatever. + (_ (newline prefix))) + (cond + ;; Act depending on context around point. + ((and org-return-follows-link + (eq 'link (car (org-element-context)))) + ;; Link: Open it. + (org-open-at-point-global)) + + ((org-at-heading-p) + ;; Heading: Move to position after entry content. + ;; NOTE: This is probably the most interesting feature of this function. + (let ((heading-start (org-entry-beginning-position))) + (goto-char (org-entry-end-position)) + (cond ((and (org-at-heading-p) + (= heading-start (org-entry-beginning-position))) + ;; Entry ends on its heading; add newline after + (end-of-line) + (insert "\n\n")) + (t + ;; Entry ends after its heading; back up + (forward-line -1) + (end-of-line) + (when (org-at-heading-p) + ;; At the same heading + (forward-line) + (insert "\n") + (forward-line -1)) + (while (not + (looking-back + (rx (repeat 3 (seq (optional blank) "\n"))) + nil)) + (insert "\n")) + (forward-line -1))))) + + ((org-at-item-checkbox-p) + ;; Checkbox: Insert new item with checkbox. + (org-insert-todo-heading nil)) + + ((org-in-item-p) + ;; Plain list + (let* ((context (org-element-context)) + (first-item-p (eq 'plain-list (car context))) + (itemp (eq 'item (car context))) + (emptyp (eq (org-element-property :contents-begin context) + (org-element-property :contents-end context))) + (item-child-p + (+org-element-descendant-of 'item context))) + ;; The original function from unpackaged just tested the (or ...) test + ;; in this cond, in an if. However, that doesn't auto-end nested + ;; lists. So I made this form a cond and added the (and...) test in + ;; the first position, which is clunky (the delete-region... stuff + ;; comes twice) and might not be needed. More testing, obviously, but + ;; for now, it works well enough. + (cond ((and itemp emptyp) + (delete-region (line-beginning-position) (line-end-position)) + (insert "\n\n")) + ((or first-item-p + (and itemp (not emptyp)) + item-child-p) + (org-insert-item)) + (t (delete-region (line-beginning-position) (line-end-position)) + (insert "\n"))))) + + ((when (fboundp 'org-inlinetask-in-task-p) + (org-inlinetask-in-task-p)) + ;; Inline task: Don't insert a new heading. + (org-return)) + + ((org-at-table-p) + (cond ((save-excursion + (beginning-of-line) + ;; See `org-table-next-field'. + (cl-loop with end = (line-end-position) + for cell = (org-element-table-cell-parser) + always (equal (org-element-property :contents-begin cell) + (org-element-property :contents-end cell)) + while (re-search-forward "|" end t))) + ;; Empty row: end the table. + (delete-region (line-beginning-position) (line-end-position)) + (org-return)) + (t + ;; Non-empty row: call `org-return'. + (org-return)))) + (t + ;; All other cases: call `org-return'. + (org-return))))) + +(defun +org-table-copy-down (n) + "Call `org-table-copy-down', or `org-return' outside of a table. +N is passed to the functions." + (interactive "p") + (if (org-table-check-inside-data-field 'noerror) + (org-table-copy-down n) + (+org-return-dwim n))) + +;;; org-fix-blank-lines - unpackaged.el + +(defun +org-fix-blank-lines (&optional prefix) + "Ensure blank lines around headings. +Optional PREFIX argument operates on the entire buffer. +Drawers are included with their headings." + (interactive "P") + (org-map-entries (lambda () + (org-with-wide-buffer + ;; `org-map-entries' narrows the buffer, which + ;; prevents us from seeing newlines before the + ;; current heading, so we do this part widened. + (while (not (looking-back "\n\n" nil)) + ;; Insert blank lines before heading. + (insert "\n"))) + (let ((end (org-entry-end-position))) + ;; Insert blank lines before entry content + (forward-line) + (while (and (org-at-planning-p) + (< (point) (point-max))) + ;; Skip planning lines + (forward-line)) + (while (re-search-forward + org-drawer-regexp end t) + ;; Skip drawers. You might think that + ;; `org-at-drawer-p' would suffice, but for + ;; some reason it doesn't work correctly when + ;; operating on hidden text. This works, taken + ;; from `org-agenda-get-some-entry-text'. + (re-search-forward "^[ \t]*:END:.*\n?" end t) + (goto-char (match-end 0))) + (unless (or (= (point) (point-max)) + (org-at-heading-p) + (looking-at-p "\n")) + (insert "\n")))) + t + (if prefix + nil + 'tree))) + +;;; org-count-words + +(defun +org-count-words-stupidly (start end &optional limit) + "Count words between START and END, ignoring a lot. + +Since this function is, for some reason, pricy, the optional +parameter LIMIT sets a word limit at which to stop counting. +Once the function hits that number, it'll return -LIMIT +instead of the true count." + (interactive (list nil nil)) + (cond ((not (called-interactively-p 'any)) + (let ((words 0) + (continue t)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (and continue + (< (point) (point-max))) + (cond + ;; Ignore comments + ((or (org-at-comment-p) + (org-in-commented-heading-p)) + (forward-line)) + ;; Ignore headings + ((or (org-at-heading-p)) + (forward-line)) + ;; Ignore property and log drawers + ((or (looking-at org-drawer-regexp) + (looking-at org-clock-drawer-re)) + (search-forward ":END:" nil :noerror) + (forward-line)) + ;; Ignore DEADLINE and SCHEDULED keywords + ((or (looking-at org-deadline-regexp) + (looking-at org-scheduled-regexp) + (looking-at org-closed-time-regexp)) + (forward-line)) + ;; Ignore tables + ((org-at-table-p) (forward-line)) + ;; Ignore hyperlinks, but count the descriptions + ((looking-at org-link-bracket-re) + (when-let ((desc (match-string-no-properties 5))) + (save-match-data + (setq words (+ words + (length (remove "" + (org-split-string + desc "\\W"))))))) + (goto-char (match-end 0))) + ;; Ignore source blocks + ((org-in-src-block-p) (forward-line)) + ;; Ignore blank lines + ((looking-at "^$") + (forward-line)) + ;; Count everything else + (t + ;; ... unless it's in a few weird contexts + (let ((contexts (org-context))) + (cond ((or (assoc :todo-keyword contexts) + (assoc :priority contexts) + (assoc :keyword contexts) + (assoc :checkbox contexts)) + (forward-word-strictly)) + + (t (setq words (1+ words)) + (if (and limit + (> words limit)) + (setq words (- limit) + continue nil)) + (forward-word-strictly))))))))) + words)) + ((use-region-p) + (message "%d words in region" + (+org-count-words-stupidly (region-beginning) + (region-end)))) + (t + (message "%d words in buffer" + (+org-count-words-stupidly (point-min) + (point-max)))))) + +;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/ + +(defun +org-insert-link-dwim () + "Like `org-insert-link' but with personal dwim preferences." + (interactive) + (let* ((point-in-link (org-in-regexp org-link-any-re 1)) + (clipboard-url (when (string-match-p + (rx (sequence bos + (or "http" + "gemini" + "gopher"))) + (current-kill 0)) + (current-kill 0))) + (region-content (when (region-active-p) + (buffer-substring-no-properties (region-beginning) + (region-end))))) + (cond ((and region-content clipboard-url (not point-in-link)) + (delete-region (region-beginning) (region-end)) + (insert (org-link-make-string clipboard-url region-content))) + ((and clipboard-url (not point-in-link)) + (insert (org-link-make-string + clipboard-url + (read-string "title: " + (with-current-buffer + (url-retrieve-synchronously + clipboard-url) + (dom-text + (car + (dom-by-tag (libxml-parse-html-region + (point-min) + (point-max)) + 'title)))))))) + (t + (call-interactively 'org-insert-link))))) + +;;; Navigate headings with widening + +(defun +org-next-heading-widen (arg) + "Find the ARGth next org heading, widening if necessary." + (interactive "p") + (let ((current-point (point)) + (point-target (if (> arg 0) (point-max) (point-min)))) + (org-next-visible-heading arg) + (when (and (buffer-narrowed-p) + (= (point) point-target) + (or (and (> arg 0)) + (and (< arg 0) + (= (point) current-point)))) + (widen) + (org-next-visible-heading arg)))) + +(defun +org-previous-heading-widen (arg) + "Find the ARGth previous org heading, widening if necessary." + (interactive "p") + (+org-next-heading-widen (- arg))) + +;;; Hooks & Advice + +(defun +org-before-save@prettify-buffer () + (save-mark-and-excursion + (mark-whole-buffer) + ;;(org-fill-paragraph nil t) + (+org-fix-blank-lines t) + (org-align-tags t))) + +(defun +org-delete-backward-char (N) + "Keep tables aligned while deleting N characters backward. +When deleting backwards, in tables this function will insert +whitespace in front of the next \"|\" separator, to keep the +table aligned. The table will still be marked for re-alignment +if the field did fill the entire column, because, in this case +the deletion might narrow the column." + (interactive "p") + (save-match-data + (org-check-before-invisible-edit 'delete-backward) + (if (and (= N 1) + (not overwrite-mode) + (not (org-region-active-p)) + (not (eq (char-before) ?|)) + (save-excursion (skip-chars-backward " \t") (not (bolp))) + (looking-at-p ".*?|") + (org-at-table-p)) + (progn (forward-char -1) (org-delete-char 1)) + (backward-delete-char-untabify N) + (org-fix-tags-on-the-fly)))) + +(provide '+org) +;;; +org.el ends here diff --git a/lisp/+setup.el b/lisp/+setup.el new file mode 100644 index 0000000..dce5d7b --- /dev/null +++ b/lisp/+setup.el @@ -0,0 +1,105 @@ +;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*- + +;; Author: Case Duckworth + +;; 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: + +;; `setup', by Philip Kaludercic, is a wonderful package that works +;; sort of like `use-package', but to my mind it's cleaner and easier +;; to extend. These are my additions to the local macros provided by +;; the package. + +;;; Code: + +(require 'el-patch) +(require 'setup) +(require 'straight) + +;; I don't like the "magic" `setup' performs to ensure a symbol is a +;; function in `:global', `:bind', `:hook', `:hook-into', and others. +;; So here, I'll just make it return the symbol unmodified. +(el-patch-feature setup) +(with-eval-after-load 'setup + (el-patch-defvar + (el-patch-add setup-ensure-function-inhibit nil + "Whether to inhibit `setup-ensure-function'.")) + (el-patch-defun setup-ensure-function (sexp) + (el-patch-concat + "Attempt to return SEXP as a quoted function name." + (el-patch-add + "\nIf `setup-ensure-function-inhibit' is non-nil, just return SEXP.")) + (el-patch-wrap 3 0 + (if (and setup-ensure-function-inhibit + (not (eq sexp (setup-get 'mode)))) + sexp + (cond ((eq (car-safe sexp) 'function) + sexp) + ((eq (car-safe sexp) 'quote) + `#',(cadr sexp)) + ((symbolp sexp) + `#',sexp) + (sexp)))))) + +(setup-define :face + (lambda (face spec) + `(custom-set-faces '(,face ,spec 'now "Customized by `setup'."))) + :documentation "Customize FACE with SPEC using `custom-set-faces'." + :repeatable t) + +(setup-define :load-after + (lambda (&rest features) + (let ((body `(require ',(setup-get 'feature)))) + (dolist (feature (nreverse features)) + (setq body `(with-eval-after-load ',feature ,body))) + body)) + :documentation "Load the current feature after FEATURES.") + +(setup-define :also-straight + (lambda (recipe) `(setup (:straight ,recipe))) + :documentation + "Install RECIPE with `straight-use-package', after loading FEATURE." + :repeatable t + :after-loaded t) + +(setup-define :straight + (lambda (recipe) + `(unless (straight-use-package ',recipe) + ,(setup-quit))) + :documentation + "Install RECIPE with `straight-use-package'. +This macro can be used as HEAD, and will replace itself with the +first RECIPE's package." + :repeatable t + :shorthand (lambda (sexp) + (let ((recipe (cadr sexp))) + (if (consp recipe) + (car recipe) + recipe)))) + +(setup-define :straight-when + (lambda (recipe condition) + `(unless (and ,condition + (straight-use-package ',recipe)) + ,(setup-quit))) + :documentation + "Install RECIPE with `straight-use-package' when CONDITION is met. +If CONDITION is false, or if `straight-use-package' fails, stop +evaluating the body. This macro can be used as HEAD, and will +replace itself with the RECIPE's package." + :repeatable 2 + :indent 1 + :shorthand (lambda (sexp) + (let ((recipe (cadr sexp))) + (if (consp recipe) (car recipe) recipe)))) + +(provide '+setup) +;;; +setup.el ends here diff --git a/lisp/+util.el b/lisp/+util.el new file mode 100644 index 0000000..0870a71 --- /dev/null +++ b/lisp/+util.el @@ -0,0 +1,81 @@ +;;; +util.el --- utility whatevers -*- lexical-binding: t -*- + +;;; Commentary: + +;; This file is going to be my version of like, subr.el -- lots of +;; random shit that all goes in here. + +;;; Code: + +(require 'cl-lib) + +(defgroup +util nil + "Utility whatevers." + :group 'convenience) + +;;; STRINGS + +(defcustom +string-default-alignment 'left + "Default alignment." + :type '(choice (const :tag "Left" 'left) + (const :tag "Right" 'right))) + +;; stolen from s.el +(defun +string-repeat (n s) + "Make a string of S repeated N times." + (declare (pure t) + (side-effect-free t)) + (let (ss) + (while (> n 0) + (setq ss (cons s ss) + n (1- n))) + (apply 'concat ss))) + +(defun +string-truncate (s length &optional ellipsis alignment) + "Return S, shortened to LENGTH including ELLIPSIS and aligned to ALIGNMENT. + +ELLIPSIS defaults to \"...\". + +ALIGNMENT defaults to `+string-default-alignment'." + (declare (pure t) + (side-effect-free t)) + (let ((ellipsis (or ellipsis "...")) + (alignment (or alignment +string-default-alignment))) + (if (> (length s) length) + (format "%s%s" + (substring s 0 (- length (length ellipsis))) + ellipsis) + s))) + +(cl-defun +string-align (s len + &key + (before "") (after "") (fill " ") + (ellipsis "...") + (alignment +string-default-alignment)) + "Print S to fit in LEN characters. +Optional arguments BEFORE and AFTER specify strings to go on +either side of S. + +FILL is the string to fill extra space with (default \" \"). + +ELLIPSIS is the string to show when S is too long to fit (default \"...\"). + +ALIGNMENT can be one of these: +- nil: align to `+string-default-alignment' +- `left': align left +- `right': align right" + (let* ((s-length (length s)) + (before-length (length before)) + (after-length (length after)) + (max-length (- len (+ before-length after-length))) + (left-over (max 0 (- max-length s-length))) + (filler (+string-repeat left-over fill))) + (format "%s%s%s%s%s" + before + (if (eq alignment 'left) "" filler) + (+string-truncate s max-length ellipsis alignment) + (if (eq alignment 'right) "" filler) + after))) + +(provide '+util) +;;; +util.el ends here diff --git a/lisp/acdw-apheleia.el b/lisp/acdw-apheleia.el deleted file mode 100644 index 1b646ef..0000000 --- a/lisp/acdw-apheleia.el +++ /dev/null @@ -1,25 +0,0 @@ -;;; acdw-apheleia.el --- bespoke apheleia junk -*- lexical-binding: t -*- - -;;; Commentary: - -;;; Code: - -(require 'apheleia) - -(defcustom apheleia-stupid-modes '(makefile-mode - org-mode) - "List of stupid modes to not use `apheleia-global-mode' on." - :type '(repeat function) - :group 'apheleia) - -(defun apheleia-dumb-auto-format () - "Format a buffer dumbly." - ;; If there's no apheleia formatter for the mode, just indent the - ;; buffer. - (unless (or (apply #'derived-mode-p apheleia-stupid-modes) - (and (fboundp 'apheleia--get-formatter-command) - (apheleia--get-formatter-command))) - (indent-region (point-min) (point-max)))) - -(provide 'acdw-apheleia) -;;; acdw-apheleia ends here diff --git a/lisp/acdw-autoinsert.el b/lisp/acdw-autoinsert.el deleted file mode 100644 index bc0810a..0000000 --- a/lisp/acdw-autoinsert.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; acdw-autoinsert.el --- autoinsert.el -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Case Duckworth - -;; Author: Case Duckworth ") - " ") - 'face 'circe-prompt-face - 'read-only t - 'intangible t - 'cursor-intangible t))) - -;;; Advices - -(defun circe-part@kill-buffer (&rest _) - "Advice to kill the channel buffer after PART." - (let ((circe-channel-killed-confirmation nil)) - (kill-buffer))) - -(defun circe-quit@kill-buffer (&rest _) - "Advice to kill all buffers of a server after QUIT." - ;; `circe-server-killed-confirmation' set to nil, and manually - ;; deleting all chat buffers, pending Github issue #402 - ;; (https://github.com/emacs-circe/circe/issues/402) - (let ((circe-server-killed-confirmation nil)) - (with-circe-server-buffer - (dolist (buf (circe-server-chat-buffers)) - (let ((circe-channel-killed-confirmation nil)) - (run-with-timer 0.1 nil #'kill-buffer buf))) - (run-with-timer 0.1 nil #'kill-buffer)))) - -(defun circe-gquit@kill-buffer (&rest _) - "Advice to kill all Circe related buffers after GQUIT." - ;; `circe-server-killed-confirmation' set to nil, and manually - ;; deleting all chat buffers, pending Github issue #402 - ;; (https://github.com/emacs-circe/circe/issues/402) - (let ((circe-server-killed-confirmation nil)) - (dolist (buf (circe-server-buffers)) - (with-current-buffer buf - (dolist (buf (circe-server-chat-buffers)) - (let ((circe-channel-killed-confirmation nil)) - (run-with-timer 0.1 nil #'kill-buffer buf))) - (run-with-timer 0.1 nil #'kill-buffer))))) - -;;; Patches - -(el-patch-feature circe) -(with-eval-after-load 'circe - (defvar circe-server-buffer-action 'pop-to-buffer-same-window - "What to do with `circe-server' buffers when created.") - - (el-patch-defun circe (network-or-server &rest server-options) - "Connect to IRC. - -Connect to the given network specified by NETWORK-OR-SERVER. - -When this function is called, it collects options from the -SERVER-OPTIONS argument, the user variable -`circe-network-options', and the defaults found in -`circe-network-defaults', in this order. - -If NETWORK-OR-SERVER is not found in any of these variables, the -argument is assumed to be the host name for the server, and all -relevant settings must be passed via SERVER-OPTIONS. - -All SERVER-OPTIONS are treated as variables by getting the string -\"circe-\" prepended to their name. This variable is then set -locally in the server buffer. - -See `circe-network-options' for a list of common options." - (interactive (circe--read-network-and-options)) - (let* ((options (circe--server-get-network-options network-or-server - server-options)) - (buffer (circe--server-generate-buffer options))) - (with-current-buffer buffer - (circe-server-mode) - (circe--server-set-variables options) - (circe-reconnect)) - (el-patch-swap (pop-to-buffer-same-window buffer) - (funcall circe-server-buffer-action buffer))))) - -;;; Dumb modes - -(define-minor-mode circe-cappy-hour-mode - "ENABLE CAPPY HOUR IN CIRCE!" - :lighter "CAPPY HOUR" - (when (derived-mode-p 'circe-chat-mode) - (if circe-cappy-hour-mode - (setq-local lui-input-function - (lambda (input) (circe--input (upcase input)))) - ;; XXX: It'd be better if this were more general, but whatever. - (setq-local lui-input-function #'circe--input)))) - -(provide 'acdw-circe) -;;; acdw-circe.el ends here diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el deleted file mode 100644 index 3221191..0000000 --- a/lisp/acdw-compat.el +++ /dev/null @@ -1,555 +0,0 @@ -;;; acdw-compat.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; 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 safely (&rest defines) - "Wrap DEFINES in tests to make sure they're not already defined. -Is it necessary? Who knows!!" - (let (output) - (dolist (form defines) - ;; this is one part where elisp being a lisp-2 bites us... - (push (cond ((memq (car form) - '(;; makes functions - define-global-minor-mode - define-globalized-minor-mode - define-minor-mode - defmacro - defsubst - defun)) - `(unless (fboundp ',(cadr form)) - ,form)) - ((memq (car form) - '(;; makes variables - defcustom - defvar - defvar - defvar-local - defvar-mode-local - defvaralias)) - `(unless (boundp ',(cadr form)) - ,form)) - (t form)) - output)) - `(progn ,@(nreverse output)))) - - -;;; Functions for changing capitalization that Do What I Mean -;; Defined in EMACS/lisp/simple.el -(safely - (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))) - - (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))) - - (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)))) - - -;;; Repeat.el -;; Defined in EMACS/lisp/repeat.el - -(safely - (defcustom repeat-too-dangerous '(kill-this-buffer) - "Commands too dangerous to repeat with \\[repeat]." - :group 'convenience - :type '(repeat function)) - - (defvar repeat-message-function nil - "If non-nil, function used by `repeat' command to say what it's doing. -Message is something like \"Repeating command glorp\". -A value of `ignore' will disable such messages. To customize -display, assign a function that takes one string as an arg and -displays it however you want. -If this variable is nil, the normal `message' function will be -used to display the messages.") - - (defcustom repeat-on-final-keystroke t - "Allow `repeat' to re-execute for repeating lastchar of a key sequence. -If this variable is t, `repeat' determines what key sequence -it was invoked by, extracts the final character of that sequence, and -re-executes as many times as that final character is hit; so for example -if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command -3 times. If this variable is a sequence of characters, then re-execution -only occurs if the final character by which `repeat' was invoked is a -member of that sequence. If this variable is nil, no re-execution occurs." - :group 'convenience - :type '(choice (const :tag "Repeat for all keys" t) - (const :tag "Don't repeat" nil) - (sexp :tag "Repeat for specific keys"))) - - (defvar repeat-num-input-keys-at-repeat -1 - "# key sequences read in Emacs session when `repeat' last invoked.") - - (defsubst repeat-is-really-this-command () - "Return t if this command is happening because user invoked `repeat'. -Usually, when a command is executing, the Emacs builtin variable -`this-command' identifies the command the user invoked. Some commands modify -that variable on the theory they're doing more good than harm; `repeat' does -that, and usually does do more good than harm. However, like all do-gooders, -sometimes `repeat' gets surprising results from its altruism. The value of -this function is always whether the value of `this-command' would've been -'repeat if `repeat' hadn't modified it." - (= repeat-num-input-keys-at-repeat num-input-keys)) - - (defvar repeat-previous-repeated-command nil - "The previous repeated command.") - - (defun repeat (repeat-arg) - "Repeat most recently executed command. -If REPEAT-ARG is non-nil (interactively, with a prefix argument), -supply a prefix argument to that command. Otherwise, give the -command the same prefix argument it was given before, if any. - -If this command is invoked by a multi-character key sequence, it -can then be repeated by repeating the final character of that -sequence. This behavior can be modified by the global variable -`repeat-on-final-keystroke'. - -`repeat' ignores commands bound to input events. Hence the term -\"most recently executed command\" shall be read as \"most -recently executed command not bound to an input event\"." - ;; The most recently executed command could be anything, so surprises could - ;; result if it were re-executed in a context where new dynamically - ;; localized variables were shadowing global variables in a `let' clause in - ;; here. (Remember that GNU Emacs 19 is dynamically localized.) - ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions, - ;; but that entails a very noticeable performance hit, so instead I use the - ;; "repeat-" prefix, reserved by this package, for *local* variables that - ;; might be visible to re-executed commands, including this function's arg. - (interactive "P") - (when (eq last-repeatable-command 'repeat) - (setq last-repeatable-command repeat-previous-repeated-command)) - (cond - ((null last-repeatable-command) - (error "There is nothing to repeat")) - ((eq last-repeatable-command 'mode-exit) - (error "last-repeatable-command is mode-exit & can't be repeated")) - ((memq last-repeatable-command repeat-too-dangerous) - (error "Command %S too dangerous to repeat automatically" - last-repeatable-command))) - (setq this-command last-repeatable-command - repeat-previous-repeated-command last-repeatable-command - repeat-num-input-keys-at-repeat num-input-keys) - (when (null repeat-arg) - (setq repeat-arg last-prefix-arg)) - ;; Now determine whether to loop on repeated taps of the final character - ;; of the key sequence that invoked repeat. The Emacs global - ;; last-command-event contains the final character now, but may not still - ;; contain it after the previous command is repeated, so the character - ;; needs to be saved. - (let ((repeat-repeat-char - (if (eq repeat-on-final-keystroke t) - last-command-event - ;; Allow only specified final keystrokes. - (car (memq last-command-event - (listify-key-sequence - repeat-on-final-keystroke)))))) - (if (eq last-repeatable-command (caar command-history)) - (let ((repeat-command (car command-history))) - (repeat-message "Repeating %S" repeat-command) - (eval repeat-command)) - (if (null repeat-arg) - (repeat-message "Repeating command %S" last-repeatable-command) - (setq current-prefix-arg repeat-arg) - (repeat-message - "Repeating command %S %S" repeat-arg last-repeatable-command)) - (when (eq last-repeatable-command 'self-insert-command) - ;; We used to use a much more complex code to try and figure out - ;; what key was used to run that self-insert-command: - ;; (if (<= (- num-input-keys - ;; repeat-num-input-keys-at-self-insert) - ;; 1) - ;; repeat-last-self-insert - ;; (let ((range (nth 1 buffer-undo-list))) - ;; (condition-case nil - ;; (setq repeat-last-self-insert - ;; (buffer-substring (car range) - ;; (cdr range))) - ;; (error (error "%s %s %s" ;Danger, Will Robinson! - ;; "repeat can't intuit what you" - ;; "inserted before auto-fill" - ;; "clobbered it, sorry"))))) - (setq last-command-event (char-before))) - (let ((indirect (indirect-function last-repeatable-command))) - (if (or (stringp indirect) - (vectorp indirect)) - ;; Bind last-repeatable-command so that executing the macro does - ;; not alter it. - (let ((last-repeatable-command last-repeatable-command)) - (execute-kbd-macro last-repeatable-command)) - (call-interactively last-repeatable-command)))) - (when repeat-repeat-char - (set-transient-map - (let ((map (make-sparse-keymap))) - (define-key map (vector repeat-repeat-char) - (if (null repeat-message-function) 'repeat - ;; If repeat-message-function is let-bound, preserve it for the - ;; next "iterations of the loop". - (let ((fun repeat-message-function)) - (lambda () - (interactive) - (let ((repeat-message-function fun)) - (setq this-command 'repeat) - ;; Beware: messing with `real-this-command' is *bad*, but we - ;; need it so `last-repeatable-command' can be recognized - ;; later (bug#12232). - (setq real-this-command 'repeat) - (call-interactively 'repeat)))))) - map))))) - - (defun repeat-message (format &rest args) - "Like `message' but displays with `repeat-message-function' if non-nil." - (let ((message (apply 'format format args))) - (if repeat-message-function - (funcall repeat-message-function message) - (message "%s" message)))) - - (defcustom repeat-exit-key nil - "Key that stops the modal repeating of keys in sequence. -For example, you can set it to like `isearch-exit'." - :type '(choice (const :tag "No special key to exit repeating sequence" nil) - (key-sequence :tag "Key that exits repeating sequence")) - :group 'convenience - :version "28.1") - - (defcustom repeat-exit-timeout nil - "Break the repetition chain of keys after specified timeout. -When a number, exit the repeat mode after idle time of the specified -number of seconds." - :type '(choice (const :tag "No timeout to exit repeating sequence" nil) - (number :tag "Timeout in seconds to exit repeating")) - :group 'convenience - :version "28.1") - - (defvar repeat-exit-timer nil - "Timer activated after the last key typed in the repeating key sequence.") - - (defcustom repeat-keep-prefix t - "Keep the prefix arg of the previous command." - :type 'boolean - :group 'convenience - :version "28.1") - - (defcustom repeat-echo-function #'repeat-echo-message - "Function to display a hint about available keys. -Function is called after every repeatable command with one argument: -a repeating map, or nil after deactivating the repeat mode." - :type '(choice (const :tag "Show hints in the echo area" - repeat-echo-message) - (const :tag "Show indicator in the mode line" - repeat-echo-mode-line) - (const :tag "No visual feedback" ignore) - (function :tag "Function")) - :group 'convenience - :version "28.1") - - (defvar repeat-in-progress nil - "Non-nil when the repeating map is active.") - - (defvar repeat-map nil - "The value of the repeating map for the next command. -A command called from the map can set it again to the same map when -the map can't be set on the command symbol property `repeat-map'.") - - (define-minor-mode repeat-mode - "Toggle Repeat mode. -When Repeat mode is enabled, and the command symbol has the property named -`repeat-map', this map is activated temporarily for the next command." - :global t :group 'convenience - (if (not repeat-mode) - (remove-hook 'post-command-hook 'repeat-post-hook) - (add-hook 'post-command-hook 'repeat-post-hook) - (let* ((keymaps nil) - (commands (all-completions - "" obarray (lambda (s) - (and (commandp s) - (get s 'repeat-map) - (push (get s 'repeat-map) keymaps)))))) - (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'." - (length commands) - (length (delete-dups keymaps)))))) - - (defun repeat-post-hook () - "Function run after commands to set transient keymap for repeatable keys." - (let ((was-in-progress repeat-in-progress)) - (setq repeat-in-progress nil) - (when repeat-mode - (let ((rep-map (or repeat-map - (and (symbolp real-this-command) - (get real-this-command 'repeat-map))))) - (when rep-map - (when (boundp rep-map) - (setq rep-map (symbol-value rep-map))) - (let ((map (copy-keymap rep-map))) - - ;; Exit when the last char is not among repeatable keys, - ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts - (or (lookup-key map (this-command-keys-vector)) - prefix-arg)) - - ;; Messaging - (unless prefix-arg - (funcall repeat-echo-function map)) - - ;; Adding an exit key - (when repeat-exit-key - (define-key map repeat-exit-key 'ignore)) - - (when (and repeat-keep-prefix (not prefix-arg)) - (setq prefix-arg current-prefix-arg)) - - (setq repeat-in-progress t) - (let ((exitfun (set-transient-map map))) - - (when repeat-exit-timer - (cancel-timer repeat-exit-timer) - (setq repeat-exit-timer nil)) - - (when repeat-exit-timeout - (setq repeat-exit-timer - (run-with-idle-timer - repeat-exit-timeout nil - (lambda () - (setq repeat-in-progress nil) - (funcall exitfun) - (funcall repeat-echo-function nil))))))))))) - - (setq repeat-map nil) - (when (and was-in-progress (not repeat-in-progress)) - (when repeat-exit-timer - (cancel-timer repeat-exit-timer) - (setq repeat-exit-timer nil)) - (funcall repeat-echo-function nil)))) - - (defun repeat-echo-message-string (keymap) - "Return a string with a list of repeating keys." - (let (keys) - (map-keymap (lambda (key _) (push key keys)) keymap) - (format-message "Repeat with %s%s" - (mapconcat (lambda (key) - (key-description (vector key))) - keys ", ") - (if repeat-exit-key - (format ", or exit with %s" - (key-description repeat-exit-key)) - "")))) - - (defun repeat-echo-message (keymap) - "Display available repeating keys in the echo area." - (if keymap - (let ((mess (repeat-echo-message-string keymap))) - (if (current-message) - (message "%s [%s]" (current-message) mess) - (message mess))) - (and (current-message) - (string-search "Repeat with " (current-message)) - (message nil)))) - - (defvar repeat-echo-mode-line-string - (propertize "[Repeating...] " 'face 'mode-line-emphasis) - "String displayed in the mode line in repeating mode.") - - (defun repeat-echo-mode-line (keymap) - "Display the repeat indicator in the mode line." - (if keymap - (unless (assq 'repeat-in-progress mode-line-modes) - (add-to-list 'mode-line-modes (list 'repeat-in-progress - repeat-echo-mode-line-string))) - (force-mode-line-update t))) - - (defun describe-repeat-maps () - "Describe mappings of commands repeatable by symbol property `repeat-map'." - (interactive) - (help-setup-xref (list #'describe-repeat-maps) - (called-interactively-p 'interactive)) - (let ((keymaps nil)) - (all-completions - "" obarray (lambda (s) - (and (commandp s) - (get s 'repeat-map) - (push s (alist-get (get s 'repeat-map) keymaps))))) - (with-help-window (help-buffer) - (with-current-buffer standard-output - (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") - - (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b))))) - (princ (format-message "`%s' keymap is repeatable by these commands:\n" - (car keymap))) - (dolist (command (sort (cdr keymap) 'string-lessp)) - (princ (format-message " `%s'\n" command))) - (princ "\n")))))) - -;;; Bindings! - (defvar undo-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "u" 'undo) - map) - "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.") - (put 'undo 'repeat-map 'undo-repeat-map) - - (defvar next-error-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "n" 'next-error) - (define-key map "\M-n" 'next-error) - (define-key map "p" 'previous-error) - (define-key map "\M-p" 'previous-error) - map) - "Keymap to repeat next-error key sequences. Used in `repeat-mode'.") - (put 'next-error 'repeat-map 'next-error-repeat-map) - (put 'previous-error 'repeat-map 'next-error-repeat-map) - - (defvar page-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "]" #'forward-page) - (define-key map "[" #'backward-page) - map) - "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.") - (put 'forward-page 'repeat-map 'page-navigation-repeat-map) - (put 'backward-page 'repeat-map 'page-navigation-repeat-map) - - (defvar tab-bar-switch-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'tab-next) - (define-key map "O" 'tab-previous) - map) - "Keymap to repeat tab switch key sequences `C-x t o o O'. -Used in `repeat-mode'.") - (put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) - (put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) - - (defvar tab-bar-move-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "m" 'tab-move) - (define-key map "M" (lambda () - (interactive) - (setq repeat-map 'tab-bar-move-repeat-map) - (tab-move -1))) - map) - "Keymap to repeat tab move key sequences `C-x t m m M'. -Used in `repeat-mode'.") - (put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) - - (defvar other-window-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'other-window) - (define-key map "O" (lambda () - (interactive) - (setq repeat-map 'other-window-repeat-map) - (other-window -1))) - map) - "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") - (put 'other-window 'repeat-map 'other-window-repeat-map) - - (defvar resize-window-repeat-map - (let ((map (make-sparse-keymap))) - ;; Standard keys: - (define-key map "^" 'enlarge-window) - (define-key map "}" 'enlarge-window-horizontally) - (define-key map "{" 'shrink-window-horizontally) - ;; Additional keys: - (define-key map "v" 'shrink-window) - map) - "Keymap to repeat window resizing commands. Used in `repeat-mode'.") - (put 'enlarge-window 'repeat-map 'resize-window-repeat-map) - (put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) - (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) - (put 'shrink-window 'repeat-map 'resize-window-repeat-map) - - (defvar outline-navigation-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-b") #'outline-backward-same-level) - (define-key map (kbd "b") #'outline-backward-same-level) - (define-key map (kbd "C-f") #'outline-forward-same-level) - (define-key map (kbd "f") #'outline-forward-same-level) - (define-key map (kbd "C-n") #'outline-next-visible-heading) - (define-key map (kbd "n") #'outline-next-visible-heading) - (define-key map (kbd "C-p") #'outline-previous-visible-heading) - (define-key map (kbd "p") #'outline-previous-visible-heading) - (define-key map (kbd "C-u") #'outline-up-heading) - (define-key map (kbd "u") #'outline-up-heading) - map)) - - (defvar outline-editing-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-v") #'outline-move-subtree-down) - (define-key map (kbd "v") #'outline-move-subtree-down) - (define-key map (kbd "C-^") #'outline-move-subtree-up) - (define-key map (kbd "^") #'outline-move-subtree-up) - (define-key map (kbd "C->") #'outline-demote) - (define-key map (kbd ">") #'outline-demote) - (define-key map (kbd "C-<") #'outline-promote) - (define-key map (kbd "<") #'outline-promote) - map)) - - (with-eval-after-load 'outline - (dolist (command '(outline-backward-same-level - outline-forward-same-level - outline-next-visible-heading - outline-previous-visible-heading - outline-up-heading)) - (put command 'repeat-map 'outline-navigation-repeat-map)) - - (dolist (command '(outline-move-subtree-down - outline-move-subtree-up - outline-demote - outline-promote)) - (put command 'repeat-map 'outline-editing-repeat-map)))) - - -;;; goto-address-mode -(safely - (defvar global-address-mode nil) - - (define-globalized-minor-mode global-goto-address-mode - goto-address-mode goto-addr-mode--turn-on - :version "28.1") - - (defun goto-addr-mode--turn-on () - (when (not goto-address-mode) - (goto-address-mode 1)))) - -(provide 'acdw-compat) -;;; acdw-compat.el ends here diff --git a/lisp/acdw-consult.el b/lisp/acdw-consult.el deleted file mode 100644 index 84a7fea..0000000 --- a/lisp/acdw-consult.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; acdw-consult.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Customization for consult. - -(require 'consult) - -(defun acdw-consult/sensible-grep (&optional arg) - "Perform `consult-git-grep' if in a git project, otherwise `consult-ripgrep' -if ripgrep is installed, otherwise `consult-grep'." - (interactive "P") - (call-interactively - (cond ((executable-find "rg") - (if (fboundp 'affe-grep) - #'affe-grep - #'consult-ripgrep)) - ((string-equal (vc-backend buffer-file-name) "Git") - #'consult-git-grep) - (t #'consult-grep)))) - -(defun acdw-consult/sensible-find (&optional arg) - "Peform `consult-locate' if locate is installed, otehrwise `consult-find'." - (interactive "P") - (call-interactively - (cond ((executable-find "locate") - #'consult-locate) - ((fboundp 'affe-find) - (when (executable-find "fd") - (setq affe-find-command "fd -HI -t f")) - #'affe-find) - (t #'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)))) - -(defun acdw-consult/complete-in-region (&rest args) - (apply (if vertico-mode - #'consult-completion-in-region - #'completion--in-region) - args)) - -(defmacro consult-history-to-modes (map-hook-alist) - (let (defuns) - (dolist (map-hook map-hook-alist) - (let ((map-name (symbol-name (car map-hook))) - (key-defs `(progn (define-key - ,(car map-hook) - (kbd "M-r") - (function consult-history)) - (define-key ,(car map-hook) - (kbd "M-s") nil)))) - (push (if (cdr map-hook) - `(add-hook ',(cdr map-hook) - (defun - ,(intern (concat map-name - "@consult-history-bind")) - nil - ,(concat - "Bind `consult-history' to M-r in " - map-name ".\n" - "Defined by `consult-history-to-modes'.") - ,key-defs)) - key-defs) - defuns))) - `(progn ,@ (nreverse defuns)))) - -;;; Circe buffers source - -(require 'cl-lib) -(autoload 'circe-server-buffers "circe") -(autoload 'circe-server-chat-buffers "circe") - -(defun circe-all-buffers () - (cl-loop with servers = (circe-server-buffers) - for server in servers - collect server - nconc - (with-current-buffer server - (cl-loop for buf in (circe-server-chat-buffers) - collect buf)))) - -(defvar circe-buffer-source - `(:name "circe" - :hidden t - :narrow ?c - :category buffer - :state ,#'consult--buffer-state - :items ,(lambda () (mapcar #'buffer-name (circe-all-buffers))))) - -(provide 'acdw-consult) diff --git a/lisp/acdw-cus-edit.el b/lisp/acdw-cus-edit.el deleted file mode 100644 index 89273f0..0000000 --- a/lisp/acdw-cus-edit.el +++ /dev/null @@ -1,32 +0,0 @@ -;;; acdw-cus-edit.el -*- lexical-binding: t -*- - -(defun acdw-cus/expand-widgets (&rest _) - "Expand descriptions in `Custom-mode' buffers." - (interactive) - ;; "More/Hide" widgets (thanks alphapapa!) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("More" (widget-apply-action widget))) - nil)) - ;; "Show Value" widgets (the little triangles) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("Show Value" - (widget-apply-action widget))) - nil))) - -(defvar acdw-cus/imenu-generic-expression ; thanks u/oantolin! - '(("Faces" (rx (seq bol - (or "Show" "Hide") " " - (group (zero-or-more nonl)) - " face: [sample]")) - 1) - ("Variables" (rx (seq bol - (or "Show Value" "Hide") " " - (group (zero-or-more - (not (any "\n:")))))) - 1)) - "Show faces and variables in `imenu'.") - -(provide 'acdw-cus-edit) -;;; acdw-cus-edit.el ends here diff --git a/lisp/acdw-erc.el b/lisp/acdw-erc.el deleted file mode 100644 index beea24b..0000000 --- a/lisp/acdw-erc.el +++ /dev/null @@ -1,228 +0,0 @@ -;;; acdw-erc.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: 24 May 2021 -;; 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: -;; `acdw-erc' is a dumping ground for functions and stuff for ERC, so they -;; don't clutter up `init.el'. - -;;; Code: - -(defgroup acdw-erc nil - "Customizations for ERC." - :group 'erc) - - -;;; Show a different header-line face when ERC is disconnected. -;; https://www.emacswiki.org/emacs/ErcModeline#h5o-1 - -(defface erc/header-line-disconnected - '((t (:foreground "black" :background "indianred"))) - "Face to use when ERC has been disconnected.") - -(defun erc/update-header-line-show-disconnected () - "Use a different face in the header-line when disconnected." - (erc-with-server-buffer - (cond ((erc-server-process-alive) 'erc-header-line) - (t 'erc/header-line-disconnected)))) - - -;;; Convenience functions -;; from Prelude: -;; https://github.com/bbatsov/prelude/blob/master/modules/prelude-erc.el#L114 - -(defcustom erc/servers nil - "The list of IRC servers to connect to with `erc/connect'." - :type '(list string)) - -(defcustom erc/bye-message "See You Space Cowpokes." - "Quit message sent when calling `erc/disconnect'." - :type 'string) - -(defun connect-to-erc (server &optional use-tls port nick) - "Connects to IRC SERVER at PORT with NICK. -If USE-TLS is non-nil, use TLS." - (let* ((use-tls (or use-tls t)) - (erc-fn (if use-tls #'erc-tls #'erc)) - (port (or port (if use-tls 6697 6667))) - (nick (or nick erc-nick))) - (funcall erc-fn - :server server - :port port - :nick nick))) - -(defun erc/connect () - "Connect to all the servers in `erc/servers'." - (interactive) - (require 'erc) - (mapcar #'connect-to-erc erc/servers)) - -(defun filter-server-buffers () - (delq nil (mapcar (lambda (x) - (and (erc-server-buffer-p x) x)) - (buffer-list)))) - -(defun erc/reconnect () - "Reconnect to all IRC servers." - (interactive) - (dolist (buffer (filter-server-buffers)) - (with-current-buffer buffer - (ignore-errors - (erc-cmd-RECONNECT))))) - -(defun erc/disconnect () - "Disconnect from all IRC servers." - (interactive) - (dolist (buffer (filter-server-buffers)) - (with-message (format "Killing server buffer: %s" (buffer-name buffer)) - (with-current-buffer buffer - (erc-quit-server erc/bye-message)))) - ;; TODO: kill all channel buffers - (force-mode-line-update)) - -(defun acdw-erc/prompt () - "The prompt to show for ERC." - ;; Rewrite s-truncate to avoid dependency. - (let ((name (buffer-name)) - (ellipsis "~") - (len erc-fill-static-center)) - (if (and len (> (length name) (- len 2))) - (format "%s%s>" - (substring name 0 (- len 2 (length ellipsis))) - ellipsis) - (propertize - (format "%s%s>" - name - (let ((ss) ; Rewrite s-repeat to avoid dependency. - (num (- len 2 (length name)))) - (while (> num 0) - (setq ss (cons " " ss)) - (setq num (1- num))) - (apply #'concat ss))) - 'read-only t - 'intangible t - 'cursor-intangible t)))) - -(defcustom erc-nick-truncate nil - "The width at which to truncate a nick with `erc-format-truncate-@nick'." - :group 'erc - :type 'integer) - -(defalias 'erc-propertize 'propertize) ; I guess...taken out in 28 ? - -(defun erc-format-truncate-@nick (&optional user channel-data) - "Format the nickname of USER as in `erc-format-@nick', with truncation. -Truncation is customized using the `erc-nick-truncate' variable. -See also `erc-format-nick-function'." - (when user - (let* ((nick (erc-server-user-nickname user)) - (prefix (erc-get-user-mode-prefix nick)) - (ellipsis "~") - (max-len (- erc-nick-truncate 2 ; one each for < and > - (length ellipsis) - (length prefix)))) - (concat (erc-propertize - prefix - 'font-lock-face 'erc-nick-prefix-face) - (if (and max-len (> (length nick) max-len)) - (format "%s%s" (substring nick 0 max-len) - ellipsis) - nick))))) - - -;;; Uh - -(defun acdw-erc/erc-switch-to-buffer (&optional arg) - "Prompt for ERC buffer to switch to. -Reverse prefix argument from `erc-switch-to-buffer'." - (interactive "P") - (erc-switch-to-buffer (not arg))) - - -;;; ERC-Bar -;; NEEDS MUCH WORK - -(defun erc-bar-move-back (n) - "Moves back n message lines. Ignores wrapping, and server messages." - (interactive "nHow many lines ? ") - (re-search-backward "^.*<.*>" nil t n)) - -(defun erc-bar-update-overlay () - "Update the overlay for current buffer, based on the content of -erc-modified-channels-alist. Should be executed on window change." - (interactive) - (let* ((info (assq (current-buffer) erc-modified-channels-alist)) - (count (cadr info))) - (if (and info (> count erc-bar-threshold)) - (save-excursion - (end-of-buffer) - (when (erc-bar-move-back count) - (let ((inhibit-field-text-motion t)) - (move-overlay erc-bar-overlay - (line-beginning-position) - (line-end-position) - (current-buffer))))) - (delete-overlay erc-bar-overlay)))) - -(defvar erc-bar-threshold 0 - "Display bar when there are more than erc-bar-threshold unread messages.") - -(defvar erc-bar-overlay nil - "Overlay used to set bar") - -(setq erc-bar-overlay (make-overlay 0 0)) -(overlay-put erc-bar-overlay 'face '(:overline "gray")) - -(with-eval-after-load 'erc-track - ;;put the hook before erc-modified-channels-update - (defadvice erc-track-mode (after erc-bar-setup-hook - (&rest args) activate) - (add-hook 'window-configuration-change-hook 'erc-bar-update-overlay -90)) - - (add-hook 'erc-send-completed-hook (lambda (str) - (erc-bar-update-overlay)))) - - -;;; ZNC babeee -;; needed variables are stored in private.el -(defun znc/connect (znc-server znc-port znc-nick irc-servers) - (interactive (let ((zserv (or znc/server - (read-string "ZNC Server: "))) - (zport (or znc/port - (read-number "ZNC Port: "))) - (znick (or znc/nick - (read-string "ZNC Nick: "))) - (servers (or znc/irc-servers - (list - (cons - (read-string "IRC Server to connect to: ") - (read-passwd "Password: ")))))) - (list zserv zport znick servers))) - (let ((si 0)) - (dolist (server irc-servers) - (run-at-time si nil - (lambda () - (erc-tls :server znc-server - :port znc-port - :nick znc-nick - :password (format "%s/%s:%s" - znc-nick - (car server) - (cdr server))))) - (setq si (1+ si))))) - - -(provide 'acdw-erc) -;;; acdw-erc.el ends here diff --git a/lisp/acdw-eshell.el b/lisp/acdw-eshell.el deleted file mode 100644 index eedcc8b..0000000 --- a/lisp/acdw-eshell.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; acdw-eshell.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; 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: - -;;; Code: - -(require 'cl-lib) - - -;;; Eshell starting and quitting - -(defun eshell-quit-or-delete-char (arg) - "Delete the character to the right, or quit eshell on an empty line." - (interactive "p") - (if (and (eolp) (looking-back eshell-prompt-regexp)) - (eshell-life-is-too-much) - (delete-forward-char arg))) - -;;;###autoload -(defun eshell-pop-or-quit (&optional buffer-name) - "Pop open an eshell buffer, or if in an eshell buffer, bury it." - (interactive) - (if (eq (current-buffer) (get-buffer (or buffer-name "*eshell*"))) - (eshell-life-is-too-much) - (with-message "Starting eshell" - (eshell)))) - - -;;; Insert previous arguments -;; Record arguments - -(defvar eshell-arg-history nil) -(defvar eshell-arg-history-index nil) -(add-to-list 'savehist-additional-variables 'eshell-arg-history) - -(defun eshell-record-args (&rest _) - "Record unique arguments onto the front of `eshell-arg-history'." - (setq eshell-arg-history - (cl-loop with history = eshell-arg-history - for arg in (reverse eshell-last-arguments) - do (setq history (cons arg (remove arg history))) - finally return history))) - -(defun eshell-insert-prev-arg () - "Insert an argument from `eshell-arg-history' at point." - (interactive) - (if (eq last-command 'eshell-insert-prev-arg) - (progn - (let ((pos (point))) - (eshell-backward-argument 1) - (delete-region (point) pos)) - (if-let ((text (nth eshell-arg-history-index - eshell-arg-history))) - (progn - (insert text) - (cl-incf eshell-arg-history-index)) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - (insert (cl-first eshell-arg-history)) - (setq eshell-arg-history-index 1))) - -(add-hook 'eshell-mode-hook - (lambda () - (add-hook 'eshell-post-command-hook - #'eshell-record-args nil t) - (local-set-key (kbd "M-.") #'eshell-insert-prev-arg))) - -;;;###autoload -(define-minor-mode eshell-arg-hist-mode - "Minor mode to enable argument history, like bash/zsh with M-." - :lighter "$." - :keymap (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-.") #'eshell-insert-prev-arg) - map) - (if eshell-arg-hist-mode - (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) - (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) - -(provide 'acdw-eshell) -;;; acdw-eshell.el ends here diff --git a/lisp/acdw-eww.el b/lisp/acdw-eww.el deleted file mode 100644 index 8e7f42d..0000000 --- a/lisp/acdw-eww.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; acdw-eww.el --- EWW customizations -*- lexical-binding: t -*- - -(require 'bookmark) -(require 'eww) - -(defun bookmark-eww--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'bookmark-eww-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - - - -(defun bookmark-eww-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - -(defun bookmark-eww--setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'bookmark-eww--make)) - -(provide 'acdw-eww) -;;; acdw-eww.el ends here diff --git a/lisp/acdw-fonts.el b/lisp/acdw-fonts.el deleted file mode 100644 index 0fce172..0000000 --- a/lisp/acdw-fonts.el +++ /dev/null @@ -1,176 +0,0 @@ -;;; acdw-fonts.el -- font setup -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: Sometime during Covid-19, 2020 -;; Keywords: configuration -;; URL: https://tildegit.org/acdw/emacs - -;; This file is NOT part of GNU Emacs. - -;; 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 code is based heavily on (and in fact, until I am able to tweak it, -;; will be a copy of) Oliver Taylor's code, available here: -;; https://github.com/olivertaylor/olivertaylor.github.io -;; /blob/master/notes/20210324_emacs-optical-font-adjustment.org - -;;; Code: - - -;; Variables - -(defvar acdw-fonts/monospace nil - "Monospace font to be used for `default' and `fixed-pitch' faces.") - -(defvar acdw-fonts/variable nil - "Variable font to be used for the `variable-pitch' face.") - -(defvar acdw-fonts/monospace-size 11 - "Font size, an integer, to be used for the `default' and `fixed-pitch' faces. - -This value is multiplied by 10, so 12 becomes 120, in order to -comply with Emacs's `set-face-attribute' requirements.") - -(defvar acdw-fonts/variable-size 12 - "Font size, an integer, to be used for the `variable-pitch' face. - -This value will be used to determine a relative (float) size -based on the default size. So if your default size is 12 and -your variable size is 14, the computed relative size will be -1.16.") - - -;; Functions - -(defun acdw-fonts/set () - "Set fonts according to `acdw-fonts' variables." - (interactive) - (set-face-attribute 'default nil - :family acdw-fonts/monospace - :height (* acdw-fonts/monospace-size 10)) - (set-face-attribute 'fixed-pitch nil - :family acdw-fonts/monospace - :height 1.0) - (set-face-attribute 'variable-pitch nil - :family acdw-fonts/variable - :height 1.0)) - - -;;; Larger Variable Pitch Mode - - -;; A minor mode to scale the variable-pitch face up to the height defined in -;; `acdw-fonts/variable-size' and the fixed-pitch face down to the height -;; defined in `acdw-fonts/monospace-size', buffer locally. This mode should -;; be enabled wherever you want to adjust face sizes, perhaps with a hook. - -(make-variable-buffer-local - (defvar larger-variable-pitch-mode-status nil - "Status of the larger-variable-pitch-mode")) - -(make-variable-buffer-local - (defvar variable-pitch-remapping nil - "variable-pitch remapping cookie for larger-variable-pitch-mode.")) - -(make-variable-buffer-local - (defvar fixed-pitch-remapping nil - "fixed-pitch remapping cookie for larger-variable-pitch-mode")) - -(defun larger-variable-pitch-mode-toggle () - (setq larger-variable-pitch-mode-status - (not larger-variable-pitch-mode-status)) - (if larger-variable-pitch-mode-status - (progn - (setq variable-pitch-remapping - (face-remap-add-relative - 'variable-pitch :height (/ (float acdw-fonts/variable-size) - (float acdw-fonts/monospace-size)))) - (setq fixed-pitch-remapping - (face-remap-add-relative - 'fixed-pitch :height (/ (float acdw-fonts/monospace-size) - (float acdw-fonts/variable-size)))) - (force-window-update (current-buffer))) - (progn - (face-remap-remove-relative variable-pitch-remapping) - (face-remap-remove-relative fixed-pitch-remapping)))) - -(define-minor-mode larger-variable-pitch-mode - "Minor mode to scale the variable- and fixed-pitch faces up and down." - :init-value nil - :lighter " V+" - (larger-variable-pitch-mode-toggle)) - -(defun acdw-fonts/buffer-face-hook () - "Activate and deactivate larger-variable-pitch-mode minor mode." - (if buffer-face-mode - (larger-variable-pitch-mode 1) - (larger-variable-pitch-mode -1))) - -(add-hook 'buffer-face-mode-hook #'acdw-fonts/buffer-face-hook) - - -;;; Emoji fonts -;; from https://old.reddit.com/r/emacs/comments/mvlid5/ - -(defun acdw-fonts/setup-emoji-fonts (&rest emoji-fonts) - "For all EMOJI-FONTS that exist, add them to the symbol fontset. - -This is for emoji fonts." - (let ((ffl (font-family-list))) - (dolist (font emoji-fonts) - (when (member font ffl) - (set-fontset-font t 'symbol - (font-spec :family font) nil 'append))))) - - -;;; Variable-pitch -;; from https://github.com/turbana/emacs-config#variable-pitch - -(defcustom acdw-fonts/fixed-pitch-faces '(linum - org-block - org-block-begin-line - org-block-end-line - org-checkbox - org-code - org-date - org-document-info-keyword - org-hide - org-indent - org-link - org-meta-line - org-special-keyword - org-table - whitespace-space) - "Faces to keep fixed-pitch in `acdw/variable-pitch-mode'." - :type 'sexp - :group 'faces) - -(defun acdw-fonts//variable-pitch-add-inherit (attrs parent) - "Add `:inherit PARENT' to ATTRS unless already present. -Handles cases where `:inherit' is already specified." - (let ((current-parent (plist-get attrs :inherit))) - (unless (or (eq parent current-parent) - (and (listp current-parent) - (member parent current-parent))) - (plist-put attrs :inherit (if current-parent - (list current-parent parent) - parent))))) - -(defun acdw-fonts/adapt-variable-pitch () - "Adapt `variable-pitch-mode' to keep some fonts fixed-pitch." - (when variable-pitch-mode - (mapc (lambda (face) - (when (facep face) - (apply #'set-face-attribute - face nil (acdw-fonts//variable-pitch-add-inherit - (face-attr-construct face) - 'fixed-pitch)))) - acdw-fonts/fixed-pitch-faces))) - -(provide 'acdw-fonts) -;;; acdw-fonts.el ends here diff --git a/lisp/acdw-frame.el b/lisp/acdw-frame.el deleted file mode 100644 index 753fd14..0000000 --- a/lisp/acdw-frame.el +++ /dev/null @@ -1,36 +0,0 @@ -;;; acdw-frame.el -*- lexical-binding: t; coding: utf-8-unix -*- - -;;; Fonts - -(defun acdw/set-first-face-attribute (face font-list) - "Set FACE to the first font found in FONT-LIST. -FONT-LIST is a list of `font-spec' plists to be passed to -`set-face-attribute'." - (cond - ((or (null window-system) - (null font-list)) - nil) - ((x-list-fonts (or (plist-get (car font-list) :font) - (plist-get (car font-list) :family))) - (apply #'set-face-attribute face nil (car font-list))) - (t (acdw/set-first-face-attribute face (cdr font-list))))) - -(defun acdw/set-emoji-fonts (&rest emoji-fonts) - "Add all installed EMOJI-FONTS to the symbol fontset." - (let ((ffl (font-family-list))) - (dolist (font emoji-fonts) - (when (member font ffl) - (set-fontset-font t 'symbol - (font-spec :family font) nil 'append))))) - -;;; Fringes - -(defun acdw/set-fringes (bitmap-list) - "Apply multiple fringes at once. -BITMAP-LIST is a list of arglists passed directly to -`define-fringe-bitmap', which see." - (dolist (bitmap bitmap-list) - (apply #'define-fringe-bitmap bitmap)) - (redraw-frame)) - -(provide 'acdw-frame) diff --git a/lisp/acdw-irc.el b/lisp/acdw-irc.el deleted file mode 100644 index 4427a4d..0000000 --- a/lisp/acdw-irc.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; acdw-irc.el -*- lexical-binding: t; coding: utf-8-unix -*- - -(require 's nil :noerror) - -(defgroup acdw-irc nil - "Customizations for IRC." - :group 'applications) - -(defcustom acdw-irc/left-margin 16 - "The size of the margin for nicks, etc. on the left." - :type 'integer) - -(defcustom acdw-irc/pre-nick "" - "What to show before a nick." - :type 'string) - -(defcustom acdw-irc/post-nick " | " - "What to show after a nick." - :type 'string) - -(defcustom acdw-irc/pre-my-nick "-" - "What to show before the current user's nick." - :type 'string) - -(defcustom acdw-irc/post-my-nick "-> " - "What to show after the current user's nick." - :type 'string) - -(defcustom acdw-irc/ellipsis "~" - "The ellipsis for when a string is too long." - :type 'string) - - -;;; Convenience functions (I don't want to /depend/ on s.el) - -(if (fboundp 's-repeat) - (defalias 'repeat-string 's-repeat) - (defun repeat-string (num s) - "Make a string of STR repeated NUM times. -Stolen from s.el." - (declare (pure t) (side-effect-free t)) - (let (ss) - (while (> num 0) - (setq ss (cons s ss)) - (setq num (1- num))) - (apply 'concat ss)))) - - -;;; IRC stuff - -(defun acdw-irc/margin-format (str &optional before after alignment) - "Print STR to fit in `acdw-irc/left-margin'. -Optional arguments BEFORE and AFTER specify strings to go -... before and after the string. ALIGNMENT aligns left on nil -and right on t." - (let* ((before (or before "")) - (after (or after "")) - (str-length (length str)) - (before-length (length before)) - (after-length (length after)) - (max-length (- acdw-irc/left-margin 1 (+ before-length after-length))) - (left-over (max 0 (- max-length str-length)))) - (format "%s%s%s%s%s" - before - (if alignment (repeat-string left-over " ") "") - (truncate-string max-length str acdw-irc/ellipsis) - (if alignment "" (repeat-string left-over " ")) - after))) - - -(provide 'acdw-irc) -;;; acdw-irc.el ends here diff --git a/lisp/acdw-lisp.el b/lisp/acdw-lisp.el deleted file mode 100644 index 92fe62e..0000000 --- a/lisp/acdw-lisp.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; acdw-lisp.el -*- lexical-binding: t; coding: utf-8-unix -*- -;; -;; Extras for Lisp modes. - -(defun acdw/eval-region-or-buffer () - (interactive) - (if (region-active-p) - (let ((begin (region-beginning)) - (end (region-end))) - (with-message (format "Evaluating %S -> %S" begin end) - (eval-region begin end))) - (with-message "Evaluating buffer" - (eval-buffer)))) - -(provide 'acdw-lisp) -;;; acdw-lisp.el ends here diff --git a/lisp/acdw-modeline.el b/lisp/acdw-modeline.el deleted file mode 100644 index 0dc23ff..0000000 --- a/lisp/acdw-modeline.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; acdw-modeline.el -*- lexical-binding: t; coding: utf-8-unix -*- -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: Sometime during Covid-19, 2020 -;; 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: -;; `acdw-modeline' is a dumping ground for extra modeline functions, so they -;; don't clutter up `init.el'. - -;;; Code: - -(require 'simple-modeline) -(require 'minions) - -(defcustom acdw-modeline/word-count-modes - (mapcar (lambda (m) (cons m nil)) simple-modeline-word-count-modes) - "Alist of modes to functions that `acdw-modeline/word-count' should dispatch. -If the cdr of the cons cell is nil, use the default function (`count-words'). -Otherwise, cdr should be a function that takes two points (see `count-words')." - :type '(alist :key-type (symbol :tag "Major-Mode") - :value-type function) - :group 'simple-modeline) - -(defun acdw-modeline/buffer-name () ; gonsie - "Display the buffer name in a face reflecting its modified status." - (propertize - (concat - (format " %-20s" - (truncate-string 20 - (string-trim (buffer-name) "*" "*") - "~"))) - 'face 'bold - ;; (if (buffer-modified-p) - ;; 'font-lock-warning-face - ;; 'font-lock-type-face) - 'help-echo (or (buffer-file-name) - (buffer-name)))) - -(defun acdw-modeline/erc () - "ERC indicator for the modeline." - (when (and (bound-and-true-p erc-track-mode) - (boundp 'erc-modified-channels-object)) - (format-mode-line erc-modified-channels-object))) - -(defun acdw-modeline/god-mode-indicator () - "Display an indicator if `god-local-mode' is active." - (when (bound-and-true-p god-local-mode) - " Ω")) - -(defun acdw-modeline/major-mode () - "Displays the current major mode in the mode-line." - (propertize - (concat " " - (or (and (boundp 'delighted-modes) - (cadr (assq major-mode delighted-modes))) - (format-mode-line mode-name))) - 'face 'bold - 'keymap mode-line-major-mode-keymap - 'mouse-face 'mode-line-highlight)) - -(defun acdw-modeline/minions () ; by me - "Display a button for `minions-minor-modes-menu'." - (concat - " " - (propertize - "&" - 'help-echo (format - "Minor modes menu\nmouse-1: show menu.") - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 - (lambda (event) - (interactive "e") - (with-selected-window (posn-window - (event-start event)) - (minions-minor-modes-menu))))) - 'mouse-face 'mode-line-highlight))) - -(defun acdw-modeline/nyan-cat () - "Display the nyan cat from function `nyan-mode' in the mode-line." - (when (bound-and-true-p nyan-mode) - (if (eq (bound-and-true-p actually-selected-window) - (get-buffer-window)) - '(" " (:eval (list (nyan-create)))) - `(:propertize " " - display - (space ;; pixel perfect babeeeee - . (:width (,(+ 9 (* 8 (or - (bound-and-true-p nyan-bar-length) - 20)))))))))) - -(defun acdw-modeline/modified () ; modified from `simple-modeline' - "Displays a color-coded buffer modification/read-only -indicator in the mode-line." - (let* ((read-only (and buffer-read-only (buffer-file-name))) - (modified (buffer-modified-p))) - (propertize - (concat " " - (cond - ((string-match-p "\\*.*\\*" (buffer-name)) - "*") - ((derived-mode-p 'special-mode - 'lui-mode) - "~") - (read-only "=") - (modified "+") - (t "-"))) - 'help-echo (format - (concat "Buffer is %s and %smodified\n" - "mouse-1: Toggle read-only status.") - (if read-only "read-only" "writable") - (if modified "" "not ")) - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-1 - (lambda (event) - (interactive "e") - (with-selected-window - (posn-window (event-start event)) - (read-only-mode 'toggle))))) - 'mouse-face 'mode-line-highlight))) - -(defun acdw-modeline/narrowed () - "Display an indication if the buffer is narrowed." - (when (buffer-narrowed-p) - (concat - "" - (propertize - "N" - 'help-echo (format "%s\n%s" - "Buffer is narrowed" - "mouse-2: widen buffer.") - 'local-map (purecopy (simple-modeline-make-mouse-map - 'mouse-2 #'mode-line-widen)) - 'mouse-face 'mode-line-highlight)))) - -(define-minor-mode file-percentage-mode - "Toggle the percentage display in the mode line (File Percentage Mode)." - :init-value t :global t :group 'mode-line) - -(defun acdw-modeline/position () - "Displays the current cursor position in the mode-line. - -Unlike `simple-modeline-segment-position', this changes the first -character from '+' to '-' if the region goes 'backward' -- that -is, if point < mark." - `((line-number-mode - ((column-number-mode - (column-number-indicator-zero-based - (9 " %l/%c") - (9 " %l/%C")) - (6 " L%l"))) - ((column-number-mode - (column-number-indicator-zero-based - (5 " C%c") - (5 " C%C"))) - " ")) - (file-percentage-mode - ((-3 "%p") "%% ")) - ,(if (region-active-p) - (propertize (format "%s%-5d" - (if (and (mark) - (< (point) (mark))) - "-" - "+") - (apply #'+ (mapcar - (lambda (pos) - (- (cdr pos) - (car pos))) - (region-bounds)))) - 'font-lock-face 'font-lock-variable-name-face)))) - -(defun acdw-modeline/reading-mode () - "Display an indicator if currently in reading mode, mine or EWW's." - (concat (if reading-mode "R" "") (if eww-readable-p "w" ""))) - -(defun acdw-modeline/text-scale () - "Display the text scaling from the modeline, if scaled." - ;; adapted from https://github.com/seagle0128/doom-modeline - (when (and (boundp 'text-scale-mode-amount) - (/= text-scale-mode-amount 0)) - (format - (if (> text-scale-mode-amount 0) - " (%+d)" - " (%-d)") - text-scale-mode-amount))) - -(defun acdw-modeline/track () - "Display `tracking-mode' information." - '(tracking-mode - tracking-mode-line-buffers)) - -(defun acdw-modeline/vc-branch () - "Display the version control branch of the current buffer in the modeline." - ;; from https://www.gonsie.com/blorg/modeline.html, from Doom - (if-let ((backend (vc-backend buffer-file-name))) - (concat " " (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))))) - -(defun acdw-modeline/wc () - "Display current `wc-buffer-stats'." - (when (bound-and-true-p wc-mode) - (format "%8s" (or (cadr wc-buffer-stats) "[w]")))) - -(defun acdw-modeline/winum () - "Show the `winum' number of the current window in the modeline. -Only shows if there is more than one window." - (when (and (bound-and-true-p winum-mode) - (> winum--window-count 1)) - (format winum-format (winum-get-number-string)))) - -(defun acdw-modeline/word-count () - "Display a buffer word count, depending on the major mode. -Uses `acdw-modeline/word-count-modes' to determine which function to use." - (when-let ((modefun - (assoc major-mode acdw-modeline/word-count-modes #'equal))) - (let* ((fn (or (cdr modefun) - #'count-words)) - (r (region-active-p)) - (min (if r (region-beginning) (point-min))) - (max (if r (region-end) (point-max)))) - (format " %s%dW" (if r "+" "") (funcall fn min max))))) - -(provide 'acdw-modeline) -;;; acdw-modeline.el ends here diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el deleted file mode 100644 index f0a1d49..0000000 --- a/lisp/acdw-org.el +++ /dev/null @@ -1,517 +0,0 @@ -;;; acdw-org.el --- org extras -*- lexical-binding: t; coding: utf-8-unix -*- -;; Author: Various -;; 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 is for the weird little `org-mode' functions that just take up -;; space in my main init file. I've tried to give credit where credit is due. - -;; 2021-09-13 Hi readers of "Emacs News!" I just saw that Sacha decided to -;; include this in her weekly newsletter. Thanks for the gold kind stranger, -;; etc. If you're looking for stuff in here that /isn't/ just ripped -;; wholesale from something else on the internet, you'll want the following -;; (updated as I write more/remember to update them): - -;; `acdw-org/fix-blank-lines-in-buffer' -;; `acdw-org/count-words-stupidly' -;; `acdw/org-next-heading-widen' -;; `acdw/org-previous-heading-widen' -;; `acdw-org/work-month-headings' - -;; To be honest, I could easily (and probably should) extract some of these out -;; into their own /real/ libraries. - -;; Until then, just require this file /after/ you require org -- i.e., -;; (with-eval-after-load 'org (require 'acdw-org)) -- or else it'll load every -;; time you start up Emacs. - -;;; Code: - -(require 'dom) -(require 'org) -(require 'org-element) -(require 'ox) -(require 'subr-x) -(require 'calendar) - - -;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el - -(defun acdw-org/element-descendant-of (type element) - "Return non-nil if ELEMENT is a descendant of TYPE. -TYPE should be an element type, like `item' or `paragraph'. -ELEMENT should be a list like that returned by `org-element-context'." - ;; MAYBE: Use `org-element-lineage'. - (when-let* ((parent (org-element-property :parent element))) - (or (eq type (car parent)) - (acdw-org/element-descendant-of type parent)))) - -(defun acdw-org/return-dwim (&optional prefix) - "A helpful replacement for `org-return'. With PREFIX, call `org-return'. - -On headings, move point to position after entry content. In -lists, insert a new item or end the list, with checkbox if -appropriate. In tables, insert a new row or end the table." - ;; Inspired by John Kitchin: - ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (if (listp auto-fill-function) - (dolist (func auto-fill-function) - (funcall func)) - (funcall auto-fill-function))) - (if prefix - ;; Handle prefix args - (pcase prefix - ('(4) (newline)) - ('(16) (newline 2)) - ;; this is ... not ideal. but whatever. - (_ (newline prefix))) - (cond - ;; Act depending on context around point. - ((and org-return-follows-link - (eq 'link (car (org-element-context)))) - ;; Link: Open it. - (org-open-at-point-global)) - - ((org-at-heading-p) - ;; Heading: Move to position after entry content. - ;; NOTE: This is probably the most interesting feature of this function. - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) - (= heading-start (org-entry-beginning-position))) - ;; Entry ends on its heading; add newline after - (end-of-line) - (insert "\n\n")) - (t - ;; Entry ends after its heading; back up - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; At the same heading - (forward-line) - (insert "\n") - (forward-line -1)) - (while (not - (looking-back - (rx (repeat 3 (seq (optional blank) "\n"))) - nil)) - (insert "\n")) - (forward-line -1))))) - - ((org-at-item-checkbox-p) - ;; Checkbox: Insert new item with checkbox. - (org-insert-todo-heading nil)) - - ((org-in-item-p) - ;; Plain list - (let* ((context (org-element-context)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context))) - (item-child-p - (acdw-org/element-descendant-of 'item context))) - ;; The original function from unpackaged just tested the (or ...) test - ;; in this cond, in an if. However, that doesn't auto-end nested - ;; lists. So I made this form a cond and added the (and...) test in - ;; the first position, which is clunky (the delete-region... stuff - ;; comes twice) and might not be needed. More testing, obviously, but - ;; for now, it works well enough. - (cond ((and itemp emptyp) - (delete-region (line-beginning-position) (line-end-position)) - (insert "\n\n")) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-insert-item)) - (t (delete-region (line-beginning-position) (line-end-position)) - (insert "\n"))))) - - ((when (fboundp 'org-inlinetask-in-task-p) - (org-inlinetask-in-task-p)) - ;; Inline task: Don't insert a new heading. - (org-return)) - - ((org-at-table-p) - (cond ((save-excursion - (beginning-of-line) - ;; See `org-table-next-field'. - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (equal (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - ;; Empty row: end the table. - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (t - ;; Non-empty row: call `org-return'. - (org-return)))) - (t - ;; All other cases: call `org-return'. - (org-return))))) - -(defun acdw-org/fix-blank-lines (&optional prefix) - "Ensure blank lines around headings. -Optional PREFIX argument operates on the entire buffer. -Drawers are included with their headings." - (interactive "P") - (org-map-entries (lambda () - (org-with-wide-buffer - ;; `org-map-entries' narrows the buffer, which - ;; prevents us from seeing newlines before the - ;; current heading, so we do this part widened. - (while (not (looking-back "\n\n" nil)) - ;; Insert blank lines before heading. - (insert "\n"))) - (let ((end (org-entry-end-position))) - ;; Insert blank lines before entry content - (forward-line) - (while (and (org-at-planning-p) - (< (point) (point-max))) - ;; Skip planning lines - (forward-line)) - (while (re-search-forward - org-drawer-regexp end t) - ;; Skip drawers. You might think that - ;; `org-at-drawer-p' would suffice, but for - ;; some reason it doesn't work correctly when - ;; operating on hidden text. This works, taken - ;; from `org-agenda-get-some-entry-text'. - (re-search-forward "^[ \t]*:END:.*\n?" end t) - (goto-char (match-end 0))) - (unless (or (= (point) (point-max)) - (org-at-heading-p) - (looking-at-p "\n")) - (insert "\n")))) - t - (if prefix - nil - 'tree))) - - -;;; Generate custom IDs: -;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html - -(defun acdw-org/generate-custom-ids () - "Generate CUSTOM_ID for any headings that are missing one." - (let ((existing-ids (org-map-entries (lambda () - (org-entry-get nil "CUSTOM_ID"))))) - (org-map-entries - (lambda () - (let* ((custom-id (org-entry-get nil "CUSTOM_ID")) - (heading (org-heading-components)) - (level (nth 0 heading)) - (todo (nth 2 heading)) - (headline (nth 4 heading)) - (slug (acdw-org/title-to-filename headline)) - (duplicate-id (member slug existing-ids))) - (when (and (not custom-id) - (< level 4) - (not todo) - (not duplicate-id)) - (message "Adding entry '%s' to '%s'" slug headline) - (org-entry-put nil "CUSTOM_ID" slug))))))) - -(defun acdw-org/title-to-filename (title) - "Convert TITLE to a reasonable filename." - ;; Based on the slug logic in `org-roam', but `org-roam' also uses a - ;; timestamp, and I only use the slug. - (setq title (downcase title)) - (setq title (replace-regexp-in-string "[^a-zA-Z0-9]+" "-" title)) - (setq title (replace-regexp-in-string "-+" "-" title)) - (setq title (replace-regexp-in-string "^-" "" title)) - (setq title (replace-regexp-in-string "-$" "" title)) - title) - - -;;; ADVICE AND TWEAKS - -;; I definitely got this from somewhere. -;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify' -(defun acdw-org/delete-backward-char (N) - "Keep tables aligned while deleting N characters backward. -When deleting backwards, in tables this function will insert -whitespace in front of the next \"|\" separator, to keep the -table aligned. The table will still be marked for re-alignment -if the field did fill the entire column, because, in this case -the deletion might narrow the column." - (interactive "p") - (save-match-data - (org-check-before-invisible-edit 'delete-backward) - (if (and (= N 1) - (not overwrite-mode) - (not (org-region-active-p)) - (not (eq (char-before) ?|)) - (save-excursion (skip-chars-backward " \t") (not (bolp))) - (looking-at-p ".*?|") - (org-at-table-p)) - (progn (forward-char -1) (org-delete-char 1)) - (backward-delete-char-untabify N) - (org-fix-tags-on-the-fly)))) - -;; Same here. -(defun acdw-org/org-table-copy-down (n) - "Call `org-table-copy-down', or `org-return' outside of a table. -N is passed to the functions." - (interactive "p") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down n) - (acdw-org/return-dwim n))) - -;; This isn't the best code, but it'll do. -(defun acdw-org/count-words-stupidly (start end &optional limit) - "Count words between START and END, ignoring a lot. - -Since this function is, for some reason, pricy, the optional -parameter LIMIT sets a word limit at which to stop counting. -Once the function hits that number, it'll return -LIMIT -instead of the true count." - (interactive (list nil nil)) - (cond ((not (called-interactively-p 'any)) - (let ((words 0) - (continue t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (and continue - (< (point) (point-max))) - (cond - ;; Ignore comments - ((or (org-at-comment-p) - (org-in-commented-heading-p)) - (forward-line)) - ;; Ignore headings - ((or (org-at-heading-p)) - (forward-line)) - ;; Ignore property and log drawers - ((or (looking-at org-drawer-regexp) - (looking-at org-clock-drawer-re)) - (search-forward ":END:" nil :noerror) - (forward-line)) - ;; Ignore DEADLINE and SCHEDULED keywords - ((or (looking-at org-deadline-regexp) - (looking-at org-scheduled-regexp) - (looking-at org-closed-time-regexp)) - (forward-line)) - ;; Ignore tables - ((org-at-table-p) (forward-line)) - ;; Ignore hyperlinks, but count the descriptions - ((looking-at org-link-bracket-re) - (when-let ((desc (match-string-no-properties 5))) - (save-match-data - (setq words (+ words - (length (remove "" - (org-split-string - desc "\\W"))))))) - (goto-char (match-end 0))) - ;; Ignore source blocks - ((org-in-src-block-p) (forward-line)) - ;; Ignore blank lines - ((looking-at "^$") - (forward-line)) - ;; Count everything else - (t - ;; ... unless it's in a few weird contexts - (let ((contexts (org-context))) - (cond ((or (assoc :todo-keyword contexts) - (assoc :priority contexts) - (assoc :keyword contexts) - (assoc :checkbox contexts)) - (forward-word-strictly)) - - (t (setq words (1+ words)) - (if (and limit - (> words limit)) - (setq words (- limit) - continue nil)) - (forward-word-strictly))))))))) - words)) - ((use-region-p) - (message "%d words in region" - (acdw-org/count-words-stupidly (region-beginning) - (region-end)))) - (t - (message "%d words in buffer" - (acdw-org/count-words-stupidly (point-min) - (point-max)))))) - - -;;; Zero-width spaces -;; https://blog.tecosaur.com/tmio/2021-05-31-async.html#easy-zero-width - -(defun insert-zero-width-space () - "Insert a zero-width space." - (interactive) - (insert "\u200b")) - -(defun org-export-remove-zero-width-spaces (text _backend _info) - "Remove zero-width spaces from TEXT." - (unless (org-export-derived-backend-p 'org) - (replace-regexp-in-string "\u200b" "" text))) - - -;;; Insert links .. DWIM -;; https://xenodium.com/emacs-dwim-do-what-i-mean/ - -(defun org-insert-link-dwim () - "Like `org-insert-link' but with personal dwim preferences." - (interactive) - (let* ((point-in-link (org-in-regexp org-link-any-re 1)) - (clipboard-url (when (string-match-p - (rx (sequence bos - (or "http" - "gemini" - "gopher"))) - (current-kill 0)) - (current-kill 0))) - (region-content (when (region-active-p) - (buffer-substring-no-properties (region-beginning) - (region-end))))) - (cond ((and region-content clipboard-url (not point-in-link)) - (delete-region (region-beginning) (region-end)) - (insert (org-link-make-string clipboard-url region-content))) - ((and clipboard-url (not point-in-link)) - (insert (org-link-make-string - clipboard-url - (read-string "title: " - (with-current-buffer - (url-retrieve-synchronously - clipboard-url) - (dom-text - (car - (dom-by-tag (libxml-parse-html-region - (point-min) - (point-max)) - 'title)))))))) - (t - (call-interactively 'org-insert-link))))) - - -;;; Next and previous heading, with widening -(defun acdw/org-next-heading-widen (arg) - "Find the ARGth next org heading, widening if necessary." - (interactive "p") - (let ((current-point (point)) - (point-target (if (> arg 0) (point-max) (point-min)))) - (org-next-visible-heading arg) - (when (and (buffer-narrowed-p) - (= (point) point-target) - (or (and (> arg 0)) - (and (< arg 0) - (= (point) current-point)))) - (widen) - (org-next-visible-heading arg)))) - -(defun acdw/org-previous-heading-widen (arg) - "Find the ARGth previous org heading, widening if necessary." - (interactive "p") - (acdw/org-next-heading-widen (- arg))) - - -;;; Add headings for every day of the work month -;; Gets rid of weekends. - -(defun acdw-org/work-month-headings (&optional month year) - "Create headings for every workday in MONTH and YEAR, or this month. -Workdays are Monday through Friday. This function inserts a new -heading with an inactive timestamp for each workday of MONTH in YEAR. - -I use this function to attempt to organize my work month. I'll -probably abandon it at some point for a better solution (see: -`org-agenda')." - (interactive (list - (read-number "Month: " (car (calendar-current-date))) - (read-number "Year: " (nth 2 (calendar-current-date))))) - (let ((month (or month - (car (calendar-current-date)))) - (year (or year - (car (last (calendar-current-date)))))) - (dotimes (day (calendar-last-day-of-month month year)) - (let* ((day (1+ day)) - (day-of-week (calendar-day-of-week (list month day year)))) - (unless (memq day-of-week '(0 6)) ; weekend - (end-of-line) - (org-insert-heading nil t t) - (insert (concat "[" (mapconcat (lambda (n) - (format "%02d" n)) - (list year month day) - "-") - " " - (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu" - "Fri" "Sat")) - "]"))))))) - -;;; Org task stuff - -(defun org-narrow-to-task () - "Narrow buffer to the nearest task and its subtree." - (interactive) - (save-excursion - (save-match-data - (widen) - (while (not (or (org-entry-is-todo-p) - (org-entry-is-done-p))) - ;; TODO: need a better error message - (org-previous-visible-heading 1)) - (org-narrow-to-subtree)))) - - -;;; Hide everything but the current headline -;; https://stackoverflow.com/questions/25161792/ - -(defun acdw-org/show-next-heading-tidily () - "Show next entry, keeping other entries closed." - (interactive) - (if (save-excursion (end-of-line) (outline-invisible-p)) - (progn (org-show-entry) (outline-show-children)) - (outline-next-heading) - (unless (and (bolp) (org-at-heading-p)) - (org-up-heading-safe) - (outline-hide-subtree) - (error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (outline-show-children) - (recenter-top-bottom))) - -(defun acdw-org/show-previous-heading-tidily () - "Show previous entry, keeping other entries closed." - (interactive) - (let ((pos (point))) - (outline-previous-heading) - (unless (and (< (point) pos) (bolp) (org-at-heading-p)) - (goto-char pos) - (outline-hide-subtree) - (error "Boundary reached")) - (org-overview) - (org-reveal t) - (org-show-entry) - (recenter-top-bottom) - (outline-show-children) - (recenter-top-bottom))) - - -(provide 'acdw-org) -;;; acdw-org.el ends here - -;; Local Variables: -;; flymake-inhibit: t -;; End: diff --git a/lisp/acdw-re.el b/lisp/acdw-re.el deleted file mode 100644 index eff61e1..0000000 --- a/lisp/acdw-re.el +++ /dev/null @@ -1,151 +0,0 @@ -;;; acdw-re.el -*- lexical-binding: t; coding: utf-8-unix -*- -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: 2021-04-29 -;; 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: -;; Pulled mostly from karthinks: -;; https://karthinks.com/software/bridging-islands-in-emacs-1/ - -;; UPDATED CODE: -;; https://github.com/karthink/.emacs.d/blob/master/init.el#L981 -;; https://github.com/karthink/.emacs.d/blob/master/lisp/reb-fix.el - -;;; Code: - -(require 're-builder) - -(defvar my/re-builder-positions nil - "Store point and region bounds before calling `re-builder'.") - -(defun my/re-builder-save-state (&rest _) - "Save the point and region before calling `re-builder'." - (setq my/re-builder-positions - (cons (point) - (when (region-active-p) - (list (region-beginning) - (region-end)))))) - -(defun reb-replace-regexp (&optional delimited) - "Run `query-replace-regexp' with the contents of `re-builder'. -With non-nil optional argument DELIMITED, only replace matches -surrounded by word boundaries." - (interactive "P") - (reb-update-regexp) - (let* ((re (reb-target-binding reb-regexp)) - (replacement (query-replace-read-to - re - (concat "Query replace" - (if current-prefix-arg - (if (eq current-prefix-arg '-) - " backward" - " word") - "") - " regexp" - (if (with-selected-window reb-target-window - (region-active-p)) - " in region" - "")) - t)) - (pnt (car my/re-builder-positions)) - (beg (cadr my/re-builder-positions)) - (end (caddr my/re-builder-positions))) - (with-selected-window reb-target-window - (goto-char (or pnt 0)) - (setq my/re-builder-positions nil) - (reb-quit) - (query-replace-regexp re replacement delimited beg end)))) - -;; Restrict re-builder matches to region - -(defun reb-update-overlays (&optional subexp) - "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'. -If SUBEXP is non-nil mark only the corresponding sub-expressions." - (let* ((re (reb-target-binding reb-regexp)) - (subexps (reb-count-subexps re)) - (matches 0) - (submatches 0) - firstmatch - here - start end - firstmatch-after-here) - (with-current-buffer reb-target-buffer - (setq here - (if reb-target-window - (with-selected-window reb-target-window (window-point)) - (point)) - start - (if (region-active-p) - (nth 1 my/re-builder-positions) - (nth 0 my/re-builder-positions)) - end - (if (region-active-p) - (nth 2 my/re-builder-positions) - (point-max))) - (reb-delete-overlays) - (goto-char (or start 0)) - (while (and (not (eobp)) - (re-search-forward re end t) - (or (not reb-auto-match-limit) - (< matches reb-auto-match-limit))) - (when (and (= 0 (length (match-string 0))) - (not (eobp))) - (forward-char 1)) - (let ((i 0) - suffix max-suffix) - (setq matches (1+ matches)) - (while (<= i subexps) - (when (and (or (not subexp) (= subexp i)) - (match-beginning i)) - (let ((overlay (make-overlay (match-beginning i) - (match-end i))) - ;; When we have exceeded the number of provided faces, - ;; cycle thru them where `max-suffix' denotes the maximum - ;; suffix for `reb-match-*' that has been defined and - ;; `suffix' the suffix calculated for the current match. - (face - (cond - (max-suffix - (if (= suffix max-suffix) - (setq suffix 1) - (setq suffix (1+ suffix))) - (intern-soft (format "reb-match-%d" suffix))) - ((intern-soft (format "reb-match-%d" i))) - ((setq max-suffix (1- i)) - (setq suffix 1) - ;; `reb-match-1' must exist. - 'reb-match-1)))) - (unless firstmatch (setq firstmatch (match-data))) - (unless firstmatch-after-here - (when (> (point) here) - (setq firstmatch-after-here (match-data)))) - (setq reb-overlays (cons overlay reb-overlays) - submatches (1+ submatches)) - (overlay-put overlay 'face face) - (overlay-put overlay 'priority i))) - (setq i (1+ i)))))) - (let ((count (if subexp submatches matches))) - (message "%s %smatch%s%s" - (if (= 0 count) "No" (int-to-string count)) - (if subexp "subexpression " "") - (if (= 1 count) "" "es") - (if (and reb-auto-match-limit - (= reb-auto-match-limit count)) - " (limit reached)" ""))) - (when firstmatch - (store-match-data (or firstmatch-after-here firstmatch)) - (reb-show-subexp (or subexp 0))))) - -(provide 'acdw-re) - -;;; acdw-re.el ends here diff --git a/lisp/acdw-reading.el b/lisp/acdw-reading.el deleted file mode 100644 index ff4f0c2..0000000 --- a/lisp/acdw-reading.el +++ /dev/null @@ -1,100 +0,0 @@ -;;; acdw-reading.el --- minor mode for reading -*- lexical-binding: t -*- - -;; Copyright 2021 Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; 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: - -;; here is my attempt at a reading mode. - -;;; Code: - -;;; Customizations - -(defgroup reading nil - "Group for Reading mode customizations." - :prefix "reading-" - :group 'convenience) ; i need to figure this out - -(defcustom reading-vars '((indicate-empty-lines . nil) - (indicate-buffer-boundaries . nil)) - "Alist of variables to set in function `reading-mode'. -The car of each cell is the variable name, and the cdr is the -value to set it to." - :type '(alist :key-type variable - :value-type sexp)) - -(defcustom reading-modes '((display-fill-column-indicator-mode . -1) - (blink-cursor-mode . -1)) - "Alist of modes to set in function `reading-mode'. -The car of each cell is the function name, and the cdr is the -value to call it with." - :type '(alist :key-type function - :value-type sexp)) - -;;; Internal - -(defvar reading--remembered-template "reading--remembered-%s-value" - "The template passed to `format' for remembered modes and variables.") - -(defun reading--remember (things func) - "Apply FUNC to THINGS, remembering their previous value for later." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (set (make-local-variable - (intern (format reading--remembered-template thing))) - (and (boundp thing) - (symbol-value thing))) - (funcall func thing))) - -(defun reading--recall (things func) - "Recall previously remembered THINGS by applying FUNC to them. -FUNC should be a function with the signature (THING REMEMBERED-SETTING)." - (declare (indent 1)) - (unless (listp things) - (setq things (list things))) - (dolist (thing things) - (with-demoted-errors "reading--recall: %S" - (let ((value (symbol-value - (intern - (format reading--remembered-template thing))))) - (funcall func thing value))))) - -;;; Mode - -;;;###autoload -(define-minor-mode reading-mode - "A mode for reading." - :init-value nil - :lighter " Read" - :keymap (make-sparse-keymap) - (if reading-mode - ;; turn on - (progn - (reading--remember (mapcar #'car reading-vars) - (lambda (var) - (set (make-local-variable var) - (cdr (assoc var reading-vars))))) - (reading--remember (mapcar #'car reading-modes) - (lambda (mode) - (funcall mode (cdr (assoc mode reading-modes)))))) - ;; turn off - (reading--recall (mapcar #'car reading-vars) - (lambda (var orig-val) - (set (make-local-variable var) orig-val))) - (reading--recall (mapcar #'car reading-modes) - (lambda (mode orig-setting) - (funcall mode (if orig-setting +1 -1)))))) - -(provide 'acdw-reading) -;;; acdw-reading.el ends here diff --git a/lisp/acdw-setup.el b/lisp/acdw-setup.el deleted file mode 100644 index 33ab835..0000000 --- a/lisp/acdw-setup.el +++ /dev/null @@ -1,103 +0,0 @@ -;;; acdw-setup.el -- my `setup' commands -*- lexical-binding: t -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> - -;; 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: - -;; setup.el makes defining local macros for `setup' forms quite simple, at -;; least to my mind. Here are some of the ones I've defined. - -;;; Code: - -(require 'setup) - -(setup-define :autoload - (lambda (func) - (if (listp func) - (let ((plist (cdr func))) - `(autoload ',(car func) - ,(symbol-name (setup-get 'feature)) - ,(plist-get plist :docstring) - ,(plist-get plist :interactive) - ,(plist-get plist :type))) - `(autoload ',func ,(symbol-name (setup-get 'feature))))) - :documentation "Autoload FUNC from FEATURE. -`:autoload' can be passed a list with keywords: -:docstring - The DOCSTRING to give the autoloaded function. -:interactive - Whether the function is INTERACTIVE or not. -:type - Either `nil', `keymap', or `macro': see `autoload' for details." - :repeatable t) - -(setup-define :require-after - (lambda (seconds) - `(run-with-idle-timer ,seconds nil - #'require ',(setup-get 'feature) nil t)) - :documentation "Requre FEATURE, after SECONDS idle time.") - -(setup-define :face - (lambda (face spec) - `(custom-set-faces '(,face ,spec 'now "Customized by `setup'."))) - :documentation "Customize FACE with SPEC using `custom-set-faces'." - :repeatable t) - -(setup-define :file-match - ;; Hotfix; patch here: https://github.com/phikal/setup.el/pull/1 - (lambda (pat) - `(add-to-list 'auto-mode-alist (cons ,pat ',(setup-get 'mode)))) - :documentation "Associate the current mode with files that match PAT." - :debug '(form) - :repeatable t) - -(setup-define :straight - (lambda (recipe) - `(unless (straight-use-package ',recipe) - ,(setup-quit))) - :documentation - "Install RECIPE with `straight-use-package'. -This macro can be used as HEAD, and will replace itself with the -first RECIPE's package." - :repeatable t - :shorthand (lambda (sexp) - (let ((recipe (cadr sexp))) - (if (consp recipe) - (car recipe) - recipe)))) - -(setup-define :straight-when - (lambda (recipe condition) - `(if ,condition - (straight-use-package ',recipe) - ,(setup-quit))) - :documentation - "Install RECIPE with `straight-use-package' when CONDITION is met. -If CONDITION is false, stop evaluating the body. This macro can -be used as HEAD, and will replace itself with the RECIPE's -package. This macro is not repeatable." - :repeatable nil - :indent 1 - :shorthand (lambda (sexp) - (let ((recipe (cadr sexp))) - (if (consp recipe) (car recipe) recipe)))) - -;; https://www.emacswiki.org/emacs/SetupEl -(setup-define :load-after - (lambda (&rest features) - (let ((body `(require ',(setup-get 'feature)))) - (dolist (feature (if (listp features) - (nreverse features) - (list features))) - (setq body `(with-eval-after-load ',feature ,body))) - body)) - :documentation "Load the current feature after FEATURES.") - -(provide 'acdw-setup) -;;; acdw-setup.el ends here diff --git a/lisp/acdw-ytel.el b/lisp/acdw-ytel.el deleted file mode 100644 index 276323d..0000000 --- a/lisp/acdw-ytel.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; acdw-ytel.el --- bespoke functions for ytel -*- lexical-binding: t -*- - -;;; Commentary: - -;; Extra code for the ytel package: -;; https://github.com/gRastello/ytel - -;;; Code: - -(require 'ytel nil t) - -(defun acdw/ytel-current-video-link () - "Get the link of the video at point." - (let* ((video (ytel-get-current-video)) - (id (ytel-video-id video))) - (concat "https://www.youtube.com/watch?v=" id))) - -(defun acdw/ytel-watch () ; This could possibly use `browse-url'. - "Stream video at point in mpv." - (interactive) - (start-process "ytel mpv" nil - "mpv" - (acdw/ytel-current-video-link) - "--ytdl-format=bestvideo[height<=?720]+bestaudio/best") - (message "Starting streaming...")) - -(defun acdw/ytel-copy-link () - "Copy link of the video at point." - (interactive) - (let ((link (acdw/ytel-current-video-link))) - (kill-new link) - (message "Copied %s to kill-ring" link))) - - -;;; YTDIOUS: https://github.com/spiderbit/ytdious -;; a fork of ytel that uses table-view or w/e. looks nicer - -(require 'ytdious nil t) - -(defun acdw/ytdious-current-video-link () - "Get the link of the video at point." - (let* ((video (ytdious-get-current-video)) - (id (ytdious-video-id-fun video))) - (concat "https://www.youtube.com/watch?v=" id))) - -(defun acdw/ytdious-watch () ; This could possibly use `browse-url'. - "Stream video at point in mpv." - (interactive) - (let ((link (acdw/ytdious-current-video-link))) - (start-process "ytdious mpv" nil - "mpv" - link - "--ytdl-format=bestvideo[height<=?720]+bestaudio/best") - (message "Streaming %s..." link))) - -(defun acdw/ytdious-copy-link () - "Copy link of the video at point." - (interactive) - (let ((link (acdw/ytdious-current-video-link))) - (kill-new link) - (message "Copied %s to kill-ring" link))) - -(defun acdw/ytdious-quit () - "Quit ytdious." - ;; This corrects an error with `ytdious-quit' where it doesn't have the right - ;; buffer setup. - (interactive) - (quit-window)) - -;;; Ignore `ytdious-show-image-asyncron' because it's buggy. - -(defalias 'ytdious-show-image-asyncron #'ignore) - -(provide 'acdw-ytel) -;;; acdw-ytel.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el index 56b661f..b13c9b6 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,869 +1,46 @@ -;;; acdw.el --- miscellaneous -*- lexical-binding: t; coding: utf-8-unix -*- - -;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> -;; Created: Sometime during Covid-19, 2020 -;; 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. +;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- ;;; Commentary: -;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life -;; functions for me, acdw. - -;;; Code: - -(require 'cl-lib) -(require 'auth-source) -(require 'recentf) - -;;; Variables - -(defconst acdw/system - (pcase system-type - ('gnu/linux :home) - ((or 'msdos 'windows-nt) :work) - (_ :other)) - "Which computer system is currently being used.") - -(defmacro acdw/system (&rest args) - "Macro for interfacing, depending on ARGS, with symbol `acdw/system'. - -When called without arguments, it returns symbol `acdw/system'. When -called with one (symbol) argument, it returns (eq acdw/system -ARG). When called with multiple arguments or a list, it returns -`pcase' over each argument." - (cond - ((null args) acdw/system) - ((atom (car args)) - `(when (eq acdw/system ,(car args)) - ,(car args))) - (t - `(pcase acdw/system - ,@args)))) - - -;;; Utility functions -;; I don't prefix these because ... reasons. Honestly I probably should prefix -;; them. - -(defun truncate-string (len str &optional ellipsis) - "If STR is longer than LEN, cut it down and add ELLIPSIS to the end. -When not specified, ELLIPSIS defaults to '...'." - (declare (pure t) (side-effect-free t)) - (unless ellipsis - (setq ellipsis "...")) - (if (> (length str) len) - (format "%s%s" (substring str 0 (- len (length ellipsis))) ellipsis) - str)) - -;; Why isn't this a thing??? -(defmacro fbound-and-true-p (func) - "Return the value of function FUNC if it is bound, else nil." - `(and (fboundp ,func) ,func)) - -(defmacro when-unfocused (name &rest forms) - "Define a function NAME, executing FORMS, for when Emacs is unfocused." - (declare (indent 1)) - (let ((func-name (intern (concat "when-unfocused-" (symbol-name name))))) - `(progn - (defun ,func-name () "Defined by `when-unfocused'." - (when (seq-every-p #'null - (mapcar #'frame-focus-state (frame-list))) - ,@forms)) - (add-function :after after-focus-change-function #',func-name)))) - -(defmacro with-eval-after-loads (features &rest body) - "Execute BODY after FEATURES are loaded. -This macro simplifies `with-eval-after-load' for multiple nested -features." - (declare (indent 1) - (debug (form def-body))) - (unless (listp features) - (setq features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - `(with-eval-after-load ',this - (with-eval-after-loads ,rest ,@body))))) - -(defmacro with-message (message &rest body) - "Execute BODY, messaging 'MESSAGE...' before and 'MESSAGE... Done.' after." - (declare (indent 1)) - ;; Wrap a progn inside a prog1 to return the return value of the body. - `(prog1 - (progn (message "%s..." ,message) - ,@body) - (message "%s... Done." ,message))) - -(defun clone-buffer-write-file (filename &optional confirm) - "Clone current buffer to a file named FILENAME and switch. -FILENAME and CONFIRM are passed directly to `write-file'." - (interactive ; stolen from `write-file' - (list (if buffer-file-name - (read-file-name "Write file: " - nil nil nil nil) - (read-file-name "Write file: " default-directory - (expand-file-name - (file-name-nondirectory (buffer-name)) - default-directory) - nil nil)) - (not current-prefix-arg))) - (let ((buf (clone-buffer nil nil))) - (with-current-buffer buf - (write-file filename confirm)) - (switch-to-buffer buf))) - -;; https://old.reddit.com/r/emacs/comments/pjwkts -(defun acdw/goto-last-row () - "Move point to last row of buffer, but save the column." - (interactive) - (let ((col (current-column))) - (goto-char (point-max)) - (move-to-column col t))) - -(defun acdw/goto-first-row () - "Move point to first row of buffer, but save the column." - (interactive) - (let ((col (current-column))) - (goto-char (point-min)) - (move-to-column col t))) - -(defun dos2unix (buffer) - "Replace \r\n with \n in BUFFER." - (interactive "*b") - (save-excursion - (with-current-buffer buffer - (goto-char (point-min)) - (while (search-forward (string ?\C-m ?\C-j) nil t) - (replace-match (string ?\C-j) nil t))))) - -(defun expand-file-name-exists-p (&rest args) - "Return `expand-file-name' ARGS if it exists, or nil." - (let ((file (apply #'expand-file-name args))) - (if (file-exists-p file) - file - nil))) - -(defun kill-region-or-backward-word (arg) - "If region is active, kill; otherwise kill word backward with ARG." - (interactive "p") - (if (region-active-p) - (kill-region (region-beginning) (region-end)) - (if (bound-and-true-p paredit-mode) - (paredit-backward-kill-word) - (backward-kill-word arg)))) - -(defun unfill-buffer (&optional buffer-or-name) - "Unfill entire contents of BUFFER-OR-NAME." - (with-current-buffer (or buffer-or-name (current-buffer)) - (save-excursion - (save-restriction - (unfill-region (point-min) (point-max)))))) - -(defun waterfall-list (car list rest) - "Cons CAR with each element in LIST in a waterfall fashion, end with REST. -For use with the `with-eval-after-loads' function." - (cond ((atom list) `(,car ',list ,@rest)) - ((= 1 (length list)) `(,car ',(car list) ,@rest)) - (t - `(,car ',(car list) - ,(waterfall-list car (cdr list) rest))))) - - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun uncomment-sexp (&optional n) - "Uncomment N sexps around point." - (interactive "P") - (let* ((initial-point (point-marker)) - (inhibit-field-text-motion t) - (p) - (end (save-excursion - (when (elt (syntax-ppss) 4) - (re-search-backward comment-start-skip - (line-beginning-position) - t)) - (setq p (point-marker)) - (comment-forward (point-max)) - (point-marker))) - (beg (save-excursion - (forward-line 0) - (while (and (not (bobp)) - (= end (save-excursion - (comment-forward (point-max)) - (point)))) - (forward-line -1)) - (goto-char (line-end-position)) - (re-search-backward comment-start-skip - (line-beginning-position) - t) - (ignore-errors - (while (looking-at-p comment-start-skip) - (forward-char -1))) - (point-marker)))) - (unless (= beg end) - (uncomment-region beg end) - (goto-char p) - ;; Indentify the "top-level" sexp inside the comment. - (while (and (ignore-errors (backward-up-list) t) - (>= (point) beg)) - (skip-chars-backward (rx (syntax expression-prefix))) - (setq p (point-marker))) - ;; Re-comment everything before it. - (ignore-errors - (comment-region beg p)) - ;; And everything after it. - (goto-char p) - (forward-sexp (or n 1)) - (skip-chars-forward "\r\n[:blank:]") - (if (< (point) end) - (ignore-errors - (comment-region (point) end)) - ;; If this is a closing delimiter, pull it up. - (goto-char end) - (skip-chars-forward "\r\n[:blank:]") - (when (eq 5 (car (syntax-after (point)))) - (delete-indentation)))) - ;; Without a prefix, it's more useful to leave point where - ;; it was. - (unless n - (goto-char initial-point)))) - -(defun comment-sexp--raw () - "Comment the sexp at point or ahead of point." - (pcase (or (bounds-of-thing-at-point 'sexp) - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (bounds-of-thing-at-point 'sexp))) - (`(,l . ,r) - (goto-char r) - (skip-chars-forward "\r\n[:blank:]") - (save-excursion - (comment-region l r)) - (skip-chars-forward "\r\n[:blank:]")))) - -(defun comment-or-uncomment-sexp (&optional n) - "Comment the sexp at point and move past it. -If already inside (or before) a comment, uncomment instead. -With a prefix argument N, (un)comment that many sexps." - (interactive "P") - (if (or (elt (syntax-ppss) 4) - (< (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (point)) - (save-excursion - (comment-forward 1) - (point)))) - (uncomment-sexp n) - (dotimes (_ (or n 1)) - (comment-sexp--raw)))) - - -;;; Sort sexps -;; from https://github.com/alphapapa/unpackaged.el#sort-sexps -;; and https://github.com/alphapapa/unpackaged.el/issues/20 - -(defun sort-sexps (beg end &optional key-fn sort-fn) - "Sort sexps between BEG and END. -Comments stay with the code below. - -Optional argument KEY-FN will determine where in each sexp to -start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) - -Optional argument SORT-FN will determine how to sort two sexps' -strings. It's passed to `sort'. By default, it sorts the sexps -with `string<' starting with the key determined by KEY-FN." - (interactive "r") - (cl-flet ((skip-whitespace () (while (looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0)))) - (skip-both () (while (cond ((or (nth 4 (syntax-ppss)) - (ignore-errors - (save-excursion - (forward-char 1) - (nth 4 (syntax-ppss))))) - (forward-line 1)) - ((looking-at (rx (1+ (or space "\n")))) - (goto-char (match-end 0))))))) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (skip-both) - (cl-destructuring-bind (sexps markers) - (cl-loop do (skip-whitespace) - for start = (point-marker) - for sexp = (ignore-errors - (read (current-buffer))) - for end = (point-marker) - while sexp - ;; Collect the real string, then one used for sorting. - collect (cons (buffer-substring (marker-position start) - (marker-position end)) - (save-excursion - (goto-char (marker-position start)) - (skip-both) - (if key-fn - (funcall key-fn sexp) - (buffer-substring - (point) - (marker-position end))))) - into sexps - collect (cons start end) - into markers - finally return (list sexps markers)) - (setq sexps (sort sexps (if sort-fn sort-fn - (lambda (a b) - (string< (cdr a) (cdr b)))))) - (cl-loop for (real . sort) in sexps - for (start . end) in markers - do (progn - (goto-char (marker-position start)) - (insert-before-markers real) - (delete-region (point) (marker-position end))))))))) - -(defun acdw/sort-setups () - "Sort `setup' forms in the current buffer. -Actually sorts all forms, but based on the logic of `setup'. -In short, DO NOT USE THIS FUNCTION!!!" - (save-excursion - (sort-sexps - (point-min) (point-max) - ;; Key function - nil - ;; Sort function - (lambda (s1 s2) ; oh god, this is worse. - (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves - (require-regexp (rx bos (* nonl) ":require")) - (straight-regexp (rx bos (* nonl) ":straight")) - (s1-require (string-match require-regexp s1)) - (s2-require (string-match require-regexp s2)) - (s1-straight (string-match straight-regexp s1)) - (s2-straight (string-match straight-regexp s2))) - (cond - ;; Straight forms require some weirdness - ((and s1-straight s2-straight) - (let* ((r (rx ":straight" (? "-when") (* space) (? "("))) - (s1 (replace-regexp-in-string r "" s1)) - (s2 (replace-regexp-in-string r "" s2))) - (string< s1 s2))) - ;; requires should go first - ((and s1-require (not s2-require)) t) - ((and (not s1-require) s2-require) nil) - ;; straights should go last - ((and s1-straight (not s2-straight)) nil) - ((and (not s1-straight) s2-straight) t) - ;; else, just sort em. - (t (string< s1 s2)))))))) - - -;;; Emacs configuration functions - -(defun emacs-git-pull-config (&optional remote branch) - "`git-pull' Emacs' configuration from REMOTE and BRANCH. -REMOTE defaults to 'origin', BRANCH to 'main'." - (let ((remote (or remote "origin")) - (branch (or branch "main"))) - (with-message (format "Pulling Emacs's configuration from %s" branch) - (shell-command (concat "git -C " - "\"" (expand-file-name user-emacs-directory) "\"" - " pull " remote " " branch) - (get-buffer-create "*emacs-git-pull-config-output*") - (get-buffer-create "*emacs-git-pull-config-error*"))))) - -(defun emacs-reload (&optional git-pull-first) - "Reload Emacs's configuration files. -With a prefix argument GIT-PULL-FIRST, run git pull on the repo -first." - (interactive "P") - (when git-pull-first - (emacs-git-pull-config)) - (let ((init-files (append - ;; Load lisp libraries first, in case their functionality - ;; is used by {early-,}init.el - (let* ((dir (expand-file-name "lisp/" - user-emacs-directory)) - (full-name (lambda (f) - (concat - (file-name-as-directory dir) f)))) - (mapcar full-name (directory-files dir nil "\\.el\\'"))) - ;; Load regular init files - (list (locate-user-emacs-file "early-init.el") - (locate-user-emacs-file "init.el" ".emacs")))) - (debug-on-error t)) - (with-message "Saving init files" - (save-some-buffers :no-confirm (lambda () (member (buffer-file-name) - init-files)))) - (dolist (file init-files) - (with-message (format "Loading %s" file) - (when (file-exists-p file) - (load-file file)))))) - - -;;; Specialized functions - -(defun acdw/copy-region-plain (beg end) - "Copy a region from BEG to END to clipboard, removing all Org formatting." - (interactive "r") - (let ((s (buffer-substring-no-properties beg end)) - (extracted-heading (when (derived-mode-p 'org-mode) - (acdw/org-extract-heading-text)))) - (with-temp-buffer - (insert s) - (let ((sentence-end-double-space nil)) - ;; Remove org stuff - (when extracted-heading ; Replace org heading with plaintext - (goto-char (point-min)) - (kill-line) - (insert extracted-heading)) - ;; Delete property drawers - (replace-regexp org-property-drawer-re "") - ;; Delete logbook drawers - (replace-regexp org-logbook-drawer-re "") - ;; Replace list items with their contents, paragraphed - (replace-regexp org-list-full-item-re " -\4") - ;; Delete comment lines - (replace-regexp (concat org-comment-regexp ".*$") "") - ;; Re-fill text for clipboard - (unfill-region (point-min) (point-max)) - (flush-lines "^$" (point-min) (point-max))) - ;; Copy buffer - (copy-region-as-kill (point-min) (point-max)))) - (when (called-interactively-p 'interactive) - (indicate-copied-region)) - (setq deactivate-mark t) - nil) -;; https://emacs.stackexchange.com/questions/36366/ -(defun html-body-id-filter (output backend info) - "Remove random ID attributes generated by Org." - (when (eq backend 'html) - (replace-regexp-in-string - " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\"" - "" - output t))) +;; What's that saying about how the hardest things in computer science +;; are naming and off-by-one errors? Well, the naming one I know very +;; well. I've been trying to figure out a good way to prefix my +;; bespoke functions, other stuff I found online, and various emacs +;; lisp detritus for quite some time (I reckon at over a year, as of +;; 2021-11-02). Finally, I found the answer in the writings of Daniel +;; Mendler: I'll prefix everything with a `+' ! -(defun html-body-div-filter (output backend info) - "Remove wrapping divs generated by Org." - (when (eq backend 'html) - (replace-regexp-in-string - "]*>\n*" "" - output t))) +;; To that end, pretty much everything in lisp/ will have a filename +;; like "+org.el", except of course this file, and maybe a few +;; /actually original/ libraries I haven't had the wherewithal to +;; package out properly yet. -(defun org-demote-headings (backend) - (while (/= (point) (point-max)) - (org-next-visible-heading 1) - (org-demote-subtree))) +;; Is it perfect? No. Is it fine? Yes. Here it is. -(defun acdw/org-export-copy-html () - "Copy a tree as HTML." - (interactive) - (require 'ox-html) - (org-export-with-buffer-copy - ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t) - (let ((extracted-heading (acdw/org-extract-heading-text)) - (org-export-show-temporary-export-buffer nil) - (org-export-filter-final-output-functions - '(html-body-id-filter html-body-div-filter))) - (insert "* ORG IS STUPID SOMETIMES\n") - (goto-char (point-min)) - (org-html-export-as-html nil t nil t - (list :with-smart-quotes nil - :with-special-strings t)) - (with-current-buffer "*Org HTML Export*" - (goto-char (point-min)) - (replace-regexp "

.*

" "") - (insert "

" extracted-heading "

") - (flush-lines "^$" (point-min) (point-max)) - (let ((sentence-end-double-space nil)) - (unfill-region (point-min) (point-max))) - (replace-regexp " +" "

" nil (point-min) (point-max)) - (replace-regexp " +

" "

" nil (point-min) (point-max)) - (copy-region-as-kill (point-min) (point-max))))) - (when (called-interactively-p 'interactive) - (indicate-copied-region)) - (setq deactivate-mark t) - nil) - -(defun acdw/org-export-copy () - "Copy a tree as ASCII." - (interactive) - (require 'ox-ascii) - (let ((extracted-heading (acdw/org-extract-heading-text))) - ;; Export to ASCII - not async, subtree only, visible-only, body-only - (let ((org-export-show-temporary-export-buffer nil)) - (org-ascii-export-as-ascii nil t nil t - (list :with-smart-quotes t - :with-special-strings t))) - (with-current-buffer "*Org ASCII Export*" - (goto-char (point-min)) - (insert extracted-heading) - (newline 2) - - (replace-regexp org-list-full-item-re "\n\4") - - (let ((sentence-end-double-space nil)) - (unfill-region (point-min) (point-max))) - (flush-lines "^$" (point-min) (point-max)) - - (copy-region-as-kill (point-min) (point-max))) - - (when (called-interactively-p 'interactive) - (indicate-copied-region)) - (setq deactivate-mark t) - nil)) - -(defun acdw/org-extract-heading-text () - "Extract the heading text from an `org-mode' heading." - (let ((heading (org-no-properties (org-get-heading t t t t)))) - (message - (replace-regexp-in-string org-link-bracket-re - (lambda (match) - (match-string-no-properties 2 match)) - heading)))) - -(defun acdw/sync-dir (&optional file make-directory) - "Return FILE from ~/Sync. -Optional argument MAKE-DIRECTORY makes the directory. -Logic is as in `acdw/dir', which see." - (let ((dir (expand-file-name (convert-standard-filename "~/Sync/")))) - (if file - (let ((file-name (expand-file-name (convert-standard-filename file) - dir))) - (when make-directory - (make-directory (file-name-directory file-name) 'parents)) - file-name) - dir))) - -(defun acdw/dir (&optional file make-directory) - "Place Emacs files in one place. - -If called without parameters, `acdw/dir' expands to -~/.emacs.d/var or similar. If called with FILE, `acdw/dir' -expands FILE to ~/.emacs.d/var, optionally making its directory -if MAKE-DIRECTORY is non-nil." - (let ((dir (expand-file-name (convert-standard-filename "var/") - user-emacs-directory))) - (if file - (let ((file-name (expand-file-name (convert-standard-filename file) - dir))) - (when make-directory - (make-directory (file-name-directory file-name) 'parents)) - file-name) - dir))) - -(defun acdw/find-emacs-source () ;; doesn't work right now - "Find where Emacs' source tree is." - (acdw/system - (:work (expand-file-name - (concat "~/src/emacs-" emacs-version "/src"))) - (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src")) - (:other nil))) - -(defun acdw/gc-disable () - "Functionally disable the Garbage collector." - (setq gc-cons-threshold most-positive-fixnum - gc-cons-percentage 0.8)) - -(defun acdw/gc-enable () - "Enable the Garbage collector." - (setq gc-cons-threshold (* 800 1024 1024) - gc-cons-percentage 0.1)) - -(defun acdw/insert-iso-date (arg) - "Insert the ISO-8601-formatted date, optionally including time (pass ARG)." - (interactive "P") - (let ((format (if arg "%FT%T%z" "%F"))) - (insert (format-time-string format (current-time))))) - -(defun acdw/kill-a-buffer (&optional prefix) - "Kill this buffer, or other buffers, depending on PREFIX. - -\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window -\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window -\\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows - -Prompt only if there are unsaved changes." - (interactive "P") - (pcase (or (car prefix) 0) - (0 (kill-current-buffer) - (unless (one-window-p) (delete-window))) - (4 (other-window 1) - (kill-current-buffer) - (unless (one-window-p) (delete-window))) - (16 (mapc 'kill-buffer (delq (current-buffer) (buffer-list))) - (delete-other-windows)))) - -(defun acdw/sunrise-sunset (sunrise-command sunset-command) - "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset." - (let* ((times-regex (rx (* nonl) - (: (any ?s ?S) "unrise") " " - (group (repeat 1 2 digit) ":" - (repeat 1 2 digit) - (: (any ?a ?A ?p ?P) (any ?m ?M))) - (* nonl) - (: (any ?s ?S) "unset") " " - (group (repeat 1 2 digit) ":" - (repeat 1 2 digit) - (: (any ?a ?A ?p ?P) (any ?m ?M))) - (* nonl))) - (ss (acdw/supress-messages #'sunrise-sunset)) - (_m (string-match times-regex ss)) - (sunrise-time (match-string 1 ss)) - (sunset-time (match-string 2 ss))) - (run-at-time sunrise-time (* 60 60 24) sunrise-command) - (run-at-time sunset-time (* 60 60 24) sunset-command) - (run-at-time "12:00am" (* 60 60 24) sunset-command))) - -(defun acdw/supress-messages (oldfn &rest args) ; from pkal - "Advice wrapper for suppressing `message'. -OLDFN is the wrapped function, that is passed the arguments -ARGS." - (let ((msg (current-message))) - (prog1 - (let ((inhibit-message t)) - (apply oldfn args)) - (when msg - (message "%s" msg))))) - -(defun acdw/setup-fringes () - "Set up fringes how I likes 'em." - (define-fringe-bitmap 'left-curly-arrow - [#b01100000 - #b00110000 - #b00011000 - #b00001100] - 4 8 'center) - (define-fringe-bitmap 'right-curly-arrow - [#b00000011 - #b00000110 - #b00001100 - #b00011000] - 4 8 'center) - (define-fringe-bitmap 'left-arrow - [#b01100000 - #b01010000] - 2 8 '(top t)) - (define-fringe-bitmap 'right-arrow - [#b00000011 - #b00000101] - 2 8 '(top t)) - (setq-local indicate-empty-lines nil - indicate-buffer-boundaries '((top . right) - (bottom . right))) - (custom-set-faces '(fringe - ((t (:foreground "dim gray")))))) - - -;;; Recentf renaming with dired -;; from ... somewhere. 'rjs', apparently? -;; I'm throwing these here because they look better here than in init.el. -;; Comments are "rjs"'s. - -;; Magic advice to rename entries in recentf when moving files in -;; dired. -(defun rjs/recentf-rename-notify (oldname newname &rest _args) - "Magically rename files from OLDNAME to NEWNAME when moved in `dired'." - (if (file-directory-p newname) - (rjs/recentf-rename-directory oldname newname) - (rjs/recentf-rename-file oldname newname))) - -(defun rjs/recentf-rename-file (oldname newname) - "Rename a file from OLDNAME to NEWNAME in `recentf-list'." - (setq recentf-list - (mapcar (lambda (name) - (if (string-equal name oldname) - newname - oldname)) - recentf-list))) - -(defun rjs/recentf-rename-directory (oldname newname) - "Rename directory from OLDNAME to NEWNAME in `recentf-list'." - ;; oldname, newname and all entries of recentf-list should already - ;; be absolute and normalised so I think this can just test whether - ;; oldname is a prefix of the element. - (setq recentf-list - (mapcar (lambda (name) - (if (string-prefix-p oldname name) - (concat newname (substring name (length oldname))) - name)) - recentf-list))) - - -;;; Sort setq... -;; https://emacs.stackexchange.com/questions/33039/ - -(defun sort-setq () - "Sort a setq. Must be a defun." - (interactive) - (save-excursion - (save-restriction - (let ((sort-end (progn (end-of-defun) - (backward-char) - (point-marker))) - (sort-beg (progn (beginning-of-defun) - (re-search-forward "[ \\t]*(" (point-at-eol)) - (forward-sexp) - (re-search-forward "\\_<" (point-at-eol)) - (point-marker)))) - (narrow-to-region (1- sort-beg) (1+ sort-end)) - (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record))))) - -(defun sort-setq-next-record () - "Sort the next record of a `setq' form." - (condition-case nil - (progn - (forward-sexp 1) - (backward-sexp)) - ('scan-error (goto-char (point-max))))) - -(defun sort-setq-end-record () - "Sort the end of a `setq' record." - (condition-case nil - (forward-sexp 2) - ('scan-error (goto-char (point-max))))) - - -;;; Crux tweaks - -;; `crux-other-window-or-switch-buffer' doesn't take an argument. -(defun acdw/other-window-or-switch-buffer (&optional arg) - "Call `other-window' with ARG or switch buffers, depending on window count." - (interactive "P") - (if (one-window-p) - (switch-to-buffer nil) - (other-window (or arg 1)))) - -(defun acdw/other-window-or-switch-buffer-backward () - "Do `acdw/other-window-or-switch-buffer', but backward." - (interactive) - (acdw/other-window-or-switch-buffer -1)) - - -;;; Auth-sources -;; https://github.com/emacs-circe/circe/wiki/Configuration -(defun acdw/fetch-password (&rest params) - "Fetch a password from `auth-source' using PARAMS. -This function is internal. Use `acdw/make-password-fetcher' instead." - (let ((match (car (apply #'auth-source-search params)))) - (if match - (let ((secret (plist-get match :secret))) - (if (functionp secret) - (funcall secret) - secret)) - (message "Password not found for %S" params)))) - -(defun acdw/make-password-fetcher (&rest params) - "Make a function that will call `acdw/fetch-password' with PARAMS." - (lambda (&rest _) - (apply #'acdw/fetch-password params))) - - -;;; Paren annoyances -(defun acdw/stop-paren-annoyances (&optional buffer) - "Locally turn off paren-checking functions in BUFFER." - (with-current-buffer (or buffer (current-buffer)) - (setq-local blink-matching-paren nil - show-paren-mode nil))) - - -;;; 💩 -(defun 💩 (&optional n) - "💩 x N." - (interactive "p") - (let ((n (or n 1))) - (while (> n 0) - (insert "💩") - (setq n (1- n))))) - - -;;; Fat finger solutions -(defun acdw/fat-finger-exit (&optional prefix) - "Delete a frame, or kill Emacs with confirmation. -When called with PREFIX, just kill Emacs without confirmation." - (interactive "P") - (if (or prefix - (and (= 1 (length (frame-list))) - (yes-or-no-p "This is the last frame! Wanna quit?"))) - (kill-emacs) - (ignore-errors - (delete-frame)))) - -(defun acdw/disabled-command-function (&optional cmd keys) - (let ((cmd (or cmd this-command)) - (keys (or keys (this-command-keys)))) - ;; this logic stolen from original `disabled-command-function' - (if (or (eq (aref keys 0) (if (stringp keys) - (aref "\M-x" 0) - ?\M-x)) - (and (>= (length keys) 2) - (eq (aref keys 0) meta-prefix-char) - (eq (aref keys 1) ?x))) - ;; it's been run as an M-x command, we want to do it - (call-interactively cmd) - ;; else, tell the user it's disabled. - (message (substitute-command-keys - (concat "Command `%s' has been disabled. " - "Run with \\[execute-extended-command].")) - cmd)))) - - -;;; cribbed - -;; https://jao.io/blog/2021-09-08-high-signal-to-noise-emacs-command.html -(defun jao-buffer-same-mode (&rest modes) - "Pop to a buffer with a mode among MODES, or the current one if not given." - (interactive) - (let* ((modes (or modes (list major-mode))) - (pred (lambda (b) - (let ((b (get-buffer (if (consp b) (car b) b)))) - (member (buffer-local-value 'major-mode b) modes))))) - (pop-to-buffer (read-buffer "Buffer: " nil t pred)))) - -;;; BLAH - -(defun open-paragraph () - "Open a paragraph after point. -A paragraph is defined as continguous non-empty lines of text -surrounded by empty lines, so opening a paragraph means to make -three blank lines, then place the point on the second one." - (interactive) - ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because - ;; that's weird with org, and I'm guessing other modes too. - (while (not (looking-at "^$")) - (forward-line 1)) - (newline) - (delete-blank-lines) - (newline 2) - (forward-line -1)) +;;; Code: -(defun require/ (feature &optional filename noerror) - "If FEATURE is not loaded, load it from FILENAME. -This function works just like `require', with one crucial -difference: if the FEATURE name contains a slash, the FILENAME -will as well -- unless, of course, FILENAME is set. This allows -for `require/' to require files within subdirectories of -directories of `load-path'. Of course, NOERROR isn't affected by -the change." - (let* ((feature-name (if (symbolp feature) - (symbol-name feature) - feature)) - (filename (or filename - (and (string-match-p "/" feature-name) - feature-name)))) - (require (intern feature-name) filename noerror))) +;;; Define a directory and an expanding function + +(defmacro +define-dir (name directory &optional docstring inhibit-mkdir) + "Define a variable and function NAME expanding to DIRECTORY. +DOCSTRING is applied to the variable. Ensure DIRECTORY exists in +the filesystem, unless INHIBIT-MKDIR is non-nil." + (declare (indent 2)) + (unless inhibit-mkdir + (make-directory (eval directory) :parents)) + `(progn + (defvar ,name ,directory + ,(concat docstring (when docstring "\n") + "Defined by `/define-dir'.")) + (defun ,name (file &optional mkdir) + ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" + "If MKDIR is non-nil, the directory is created.\n" + "Defined by `/define-dir'.") + (let ((file-name (expand-file-name (convert-standard-filename file) + ,name))) + (when mkdir + (make-directory (file-name-directory file-name) :parents)) + file-name)))) (provide 'acdw) ;;; acdw.el ends here diff --git a/lisp/chd.el b/lisp/chd.el deleted file mode 100644 index c6efad0..0000000 --- a/lisp/chd.el +++ /dev/null @@ -1,76 +0,0 @@ -;;; chd.el --- CHD customizations -*- lexical-binding: t -*- - -(require 'acdw-org) -(require 'org) - -(defvar chd/dir (acdw/sync-dir "Click Here Digital/") - "Where Click Here stuff is stored.") - -(defun chd/dir (file &optional make-directory) - "Expand FILE relative to variable `chd/dir'. -If MAKE-DIRECTORY is non-nil, ensure the file's -containing directory exists." - (let ((file-name (expand-file-name (convert-standard-filename file) - chd/dir))) - (when make-directory - (make-directory (file-name-directory file-name) :parents)) - file-name)) - -(defun chd/narrow-to-task (&optional point) - "Narrow the buffer to the task POINT is in." - (interactive "d") - (when point (goto-char point)) - (if (called-interactively-p 'interactive) - (save-excursion - (while (not (org-entry-is-todo-p)) - (acdw/org-previous-heading-widen 1)) - (org-narrow-to-subtree)) - ;; well this is dumb... - (while (not (org-entry-is-todo-p)) - (acdw/org-previous-heading-widen 1)) - (org-narrow-to-subtree))) - -(defun chd/clock-in () - "Clock in to the current task." - (save-excursion - (chd/narrow-to-task) - (org-clock-in))) - -(defun chd/do-the-thing () - "Copy the plain version of the current task and open its link." - (interactive) - (chd/narrow-to-task) - (save-excursion - ;; Prepare buffer - (acdw/flyspell-correct-f7) ; This is defined... elsewhere. - - ;; Export the buffer and copy it - (pcase (org-entry-get (point-min) "EXPORTAS" t) - ("html" (acdw/org-export-copy-html)) - (_ (acdw/org-export-copy))) - - ;; Open the link to the doc - (org-back-to-heading) - (org-open-at-point))) - -(defun chd/insert-client () - "Insert the current client at point." - (interactive) - (if-let ((client (org-entry-get nil "CLIENT" :inherit))) - (insert client) - (beep) - (user-error "No client found in current subtree"))) - -;;; Click Bits! -(require 'acdw-autoinsert) -(require 'acdw) -(require 'private (acdw/sync-dir "private")) -(acdw/define-auto-insert '(:replace t) - (cons (chd/dir "Click Bits" t) "Click Bits!") - chd/click-bits-skeleton) - -;;; NOTES -;; org-protocol: https://orgmode.org/worg/org-contrib/org-protocol.html -;; the bit i wanna pull from TaskIQ: 'document.getElementById("preview") -(provide 'chd) -;;; chd.el ends here diff --git a/lisp/titlecase.el b/lisp/titlecase.el deleted file mode 100644 index 64da5b4..0000000 --- a/lisp/titlecase.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; titlecase.el -*- lexical-binding: t; -*- - -;; https://hungyi.net/posts/programmers-way-to-title-case/ - -(require 'cl-lib) -(require 'subr-x) - -;;;###autoload -(defun titlecase-string (str) - "Convert string STR to title case and return the resulting string." - (let* ((case-fold-search nil) - (str-length (length str)) - ;; A list of markers that indicate start of a new phrase within the - ;; title, e.g. "The Lonely Reindeer: A Christmas Story" - ;; must be followed by one of word-boundary-chars - (new-phrase-chars '(?: ?. ?? ?\; ?\n ?\r)) - ;; immediately triggers new phrase behavior without waiting for word - ;; boundary - (immediate-new-phrase-chars '(?\n ?\r)) - ;; A list of characters that indicate "word boundaries"; used to split - ;; the title into processable segments - (word-boundary-chars (append '(? ?– ?— ?- ?‑ ?/) - immediate-new-phrase-chars)) - ;; A list of small words that should not be capitalized (in the right - ;; conditions) - (small-words '("a" "an" "and" "as" "at" "but" "by" "en" "for" "if" - "in" "of" "on" "or" "the" "to" "v" "v." "vs" "vs." - "via")) - ;; Fix if str is ALL CAPS - (str (if (string-match-p "[a-z]" str) str (downcase str))) - ;; Reduce over a state machine to do title casing - (final-state - (cl-reduce - (lambda (state char) - (let* ((result (aref state 0)) - (last-segment (aref state 1)) - (first-word-p (aref state 2)) - (was-in-path-p (aref state 3)) - (last-char (car last-segment)) - (in-path-p (or (and (eq char ?/) - (or (not last-segment) - (member last-char '(?. ?~)))) - (and was-in-path-p - (not - (or (eq char ? ) - (member - char - immediate-new-phrase-chars)))))) - (end-p - ;; are we at the end of the input string? - (eq (+ (length result) (length last-segment) 1) - str-length)) - (pop-p - ;; do we need to pop a segment onto the output result? - (or end-p (and (not in-path-p) - (member char word-boundary-chars)))) - (segment - ;; add the current char to the current segment - (cons char last-segment)) - (segment-string - ;; the readable version of the segment - (apply #'string (reverse segment))) - (small-word-p - ;; was the last segment a small word? - (member (downcase (substring segment-string 0 -1)) - small-words)) - (capitalize-p - ;; do we need to capitalized this segment or lowercase it? - (or end-p first-word-p (not small-word-p))) - (ignore-segment-p - ;; ignore explicitly capitalized segments - (or (string-match-p "[a-zA-Z].*[A-Z]" segment-string) - ;; ignore URLs - (string-match-p "^https?:" segment-string) - ;; ignore hostnames and namespaces.like.this - (string-match-p "\\w\\.\\w" segment-string) - ;; ignore windows filesystem paths - (string-match-p "^[A-Za-z]:\\\\" segment-string) - ;; ignore unix filesystem paths - was-in-path-p - ;; ignore email addresses and user handles with @ symbol - (member ?@ segment))) - (next-result - (if pop-p - (concat result - (if ignore-segment-p - ;; pop segment onto the result without - ;; processing - segment-string - ;; titlecase the segment before popping onto - ;; result - (titlecase--segment - segment-string capitalize-p))) - result)) - (next-segment - (unless pop-p segment)) - (will-be-first-word-p - (if pop-p - (or (not last-segment) - (member last-char new-phrase-chars) - (member char immediate-new-phrase-chars)) - first-word-p))) - (vector - next-result next-segment will-be-first-word-p in-path-p))) - str - :initial-value - (vector nil ; result stack - nil ; current working segment - t ; is it the first word of a phrase? - nil)))) ; are we inside of a filesystem path? - (aref final-state 0))) - -(defun titlecase--segment (segment capitalize-p) - "Convert a title's inner SEGMENT to capitalized or lower case -depending on CAPITALIZE-P, then return the result." - (let* ((case-fold-search nil) - (ignore-chars '(?' ?\" ?\( ?\[ ?‘ ?“ ?’ ?” ?_)) - (final-state - (cl-reduce - (lambda (state char) - (let ((result (aref state 0)) - (downcase-p (aref state 1))) - (cond - (downcase-p - ;; already upcased start of segment, so lowercase the rest - (vector (cons (downcase char) result) t)) - ((member char ignore-chars) - ;; check if start char of segment needs to be ignored - (vector (cons char result) downcase-p)) - (t - ;; haven't upcased yet, and we can, so do it - (vector (cons (upcase char) result) t))))) - segment - :initial-value (vector nil (not capitalize-p))))) - (thread-last (aref final-state 0) - (reverse) - (apply #'string)))) - -;;;###autoload -(defun titlecase-region (begin end) - "Convert text in region from BEGIN to END to title case." - (interactive "*r") - (let ((pt (point))) - (insert (titlecase-string (delete-and-extract-region begin end))) - (goto-char pt))) - -;;;###autoload -(defun titlecase-dwim () - "Convert the region or current line to title case. -If Transient Mark Mode is on and there is an active region, convert -the region to title case. Otherwise, work on the current line." - (interactive) - (if (and transient-mark-mode mark-active) - (titlecase-region (region-beginning) (region-end)) - (titlecase-region (point-at-bol) (point-at-eol)))) - -(provide 'titlecase) -- cgit 1.4.1-21-gabe81