I DECLARE BANKRUPTCY ... 8
Didn't think to do this till pretty .. written, so here we are.
This commit is contained in:
Case Duckworth
parent
f91fb9f3d0
commit
a2657993ba
|
|
@ -12,4 +12,6 @@ racket-mode/
|
|||
server/
|
||||
straight/
|
||||
transient/
|
||||
var/
|
||||
var/
|
||||
.etc/
|
||||
old/
|
||||
|
|
|
|||
30
README.org
30
README.org
|
|
@ -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
|
||||
230
TODO.org
230
TODO.org
|
|
@ -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 "<return>") nil)
|
||||
(define-key key-translation-map (kbd "C-m") nil)
|
||||
(define-key key-translation-map (kbd "RET") nil)
|
||||
(global-set-key (kbd "<return>") 'newline)
|
||||
(define-key erc-mode-map (kbd "<return>") 'erc-send-current-line)
|
||||
(global-set-key (kbd "C-m") (lambda () (interactive) (message "hello from C-m")))
|
||||
#+end_src
|
||||
219
early-init.el
219
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 <acdw@acdw.net>
|
||||
;; 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))))
|
||||
(+define-dir .etc (locate-user-emacs-file ".etc")
|
||||
"Directory for all of Emacs's various files.
|
||||
See `no-littering' for examples.")
|
||||
|
||||
(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 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)
|
||||
frame-resize-pixelwise t
|
||||
window-resize-pixelwise t
|
||||
inhibit-x-resources t
|
||||
indicate-empty-lines nil
|
||||
indicate-buffer-boundaries '((top . right)
|
||||
(bottom . right)))
|
||||
|
||||
(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))))))
|
||||
;; 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))
|
||||
|
||||
(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)
|
||||
;;; Packages
|
||||
|
||||
;; 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.
|
||||
(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'.
|
||||
(dolist (pkg '(el-patch
|
||||
no-littering
|
||||
setup))
|
||||
(straight-use-package pkg)
|
||||
(require pkg)
|
||||
(require (intern (format "+%s" pkg)) nil :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)
|
||||
|
||||
;;; 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)
|
||||
|
||||
(provide 'early-init)
|
||||
;;; early-init.el ends here
|
||||
|
||||
|
|
|
|||
83
eshell.el
83
eshell.el
|
|
@ -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:
|
||||
156
gnus.el
156
gnus.el
|
|
@ -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)))))
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
;;; +dired.el -*- lexical-binding: t -*-
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
|
||||
(provide '+dired)
|
||||
;;; +dired.el ends here
|
||||
|
|
@ -1,44 +1,37 @@
|
|||
;;; 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:
|
||||
;;; +eshell.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
;; 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)))))))
|
||||
|
||||
|
||||
;;; Eshell starting and quitting
|
||||
;;; Start and quit
|
||||
|
||||
(defun eshell-quit-or-delete-char (arg)
|
||||
(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
|
||||
|
||||
|
|
@ -72,12 +65,6 @@
|
|||
(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-."
|
||||
|
|
@ -89,5 +76,5 @@
|
|||
(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
|
||||
(provide '+eshell)
|
||||
;;; +eshell.el ends here
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -1,70 +1,29 @@
|
|||
;;; 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.
|
||||
;;; +org.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dom)
|
||||
(require 'org)
|
||||
(require 'org-element)
|
||||
(require 'ox)
|
||||
(require 'subr-x)
|
||||
(require 'calendar)
|
||||
|
||||
|
||||
;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el
|
||||
;;; 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 acdw-org/element-descendant-of (type element)
|
||||
(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))
|
||||
(acdw-org/element-descendant-of type parent))))
|
||||
(+org-element-descendant-of type parent))))
|
||||
|
||||
(defun acdw-org/return-dwim (&optional prefix)
|
||||
(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."
|
||||
;; 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
|
||||
|
|
@ -124,7 +83,7 @@ appropriate. In tables, insert a new row or end the table."
|
|||
(emptyp (eq (org-element-property :contents-begin context)
|
||||
(org-element-property :contents-end context)))
|
||||
(item-child-p
|
||||
(acdw-org/element-descendant-of 'item context)))
|
||||
(+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
|
||||
|
|
@ -165,7 +124,17 @@ appropriate. In tables, insert a new row or end the table."
|
|||
;; All other cases: call `org-return'.
|
||||
(org-return)))))
|
||||
|
||||
(defun acdw-org/fix-blank-lines (&optional prefix)
|
||||
(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."
|
||||
|
|
@ -203,78 +172,9 @@ Drawers are included with their headings."
|
|||
nil
|
||||
'tree)))
|
||||
|
||||
|
||||
;;; Generate custom IDs:
|
||||
;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html
|
||||
;;; org-count-words
|
||||
|
||||
(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)
|
||||
(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
|
||||
|
|
@ -334,7 +234,7 @@ instead of the true count."
|
|||
(assoc :keyword contexts)
|
||||
(assoc :checkbox contexts))
|
||||
(forward-word-strictly))
|
||||
|
||||
|
||||
(t (setq words (1+ words))
|
||||
(if (and limit
|
||||
(> words limit))
|
||||
|
|
@ -344,32 +244,16 @@ instead of the true count."
|
|||
words))
|
||||
((use-region-p)
|
||||
(message "%d words in region"
|
||||
(acdw-org/count-words-stupidly (region-beginning)
|
||||
(+org-count-words-stupidly (region-beginning)
|
||||
(region-end))))
|
||||
(t
|
||||
(message "%d words in buffer"
|
||||
(acdw-org/count-words-stupidly (point-min)
|
||||
(+org-count-words-stupidly (point-min)
|
||||
(point-max))))))
|
||||
|
||||
|
||||
;;; Zero-width spaces
|
||||
;; https://blog.tecosaur.com/tmio/2021-05-31-async.html#easy-zero-width
|
||||
;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
|
||||
|
||||
(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 ()
|
||||
(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))
|
||||
|
|
@ -402,9 +286,9 @@ instead of the true count."
|
|||
(t
|
||||
(call-interactively 'org-insert-link)))))
|
||||
|
||||
|
||||
;;; Next and previous heading, with widening
|
||||
(defun acdw/org-next-heading-widen (arg)
|
||||
;;; 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))
|
||||
|
|
@ -418,100 +302,40 @@ instead of the true count."
|
|||
(widen)
|
||||
(org-next-visible-heading arg))))
|
||||
|
||||
(defun acdw/org-previous-heading-widen (arg)
|
||||
(defun +org-previous-heading-widen (arg)
|
||||
"Find the ARGth previous org heading, widening if necessary."
|
||||
(interactive "p")
|
||||
(acdw/org-next-heading-widen (- arg)))
|
||||
(+org-next-heading-widen (- arg)))
|
||||
|
||||
|
||||
;;; Add headings for every day of the work month
|
||||
;; Gets rid of weekends.
|
||||
;;; Hooks & Advice
|
||||
|
||||
(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.
|
||||
(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)))
|
||||
|
||||
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-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))))
|
||||
|
||||
(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:
|
||||
(provide '+org)
|
||||
;;; +org.el ends here
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*-
|
||||
|
||||
;; Author: Case Duckworth <acdw@acdw.net>
|
||||
|
||||
;; 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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
;;; acdw-autoinsert.el --- autoinsert.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021 Case Duckworth
|
||||
|
||||
;; Author: Case Duckworth <acdw@acdw.ne
|
||||
|
||||
;;; 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:
|
||||
|
||||
;; - Be kind to yourself.
|
||||
|
||||
;; - Make good choices.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; These are my bespoke changes to the `autoinsert' library.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'autoinsert)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defun acdw/define-auto-insert (options condition action)
|
||||
"Associate CONDITION with ACTION in `auto-insert-alist'.
|
||||
This function differs from `define-auto-insert' in that it won't
|
||||
allow more than one duplicate entry in `auto-insert-alist'.
|
||||
|
||||
OPTIONS is a plist with three optional arguments:
|
||||
|
||||
- `:testfn' takes a function to test the given CONDITION against
|
||||
the already-existing ones in `auto-insert-alist'. It defaults
|
||||
to testing the cdr of CONDITION against the cdar of each entry
|
||||
in `auto-insert-alist'.
|
||||
|
||||
- `:replace', if non-nil, will replace the matching entry with
|
||||
the given one. Default: nil.
|
||||
|
||||
- `:after' is the third, optional argument to `define-auto-insert'."
|
||||
(declare (indent 1))
|
||||
(let ((testfn (or (plist-get options :testfn)
|
||||
(lambda (a b)
|
||||
(string= (cdr-safe a) (cdar b)))))
|
||||
(replace (or (plist-get options :replace) nil))
|
||||
(after (or (plist-get options :after) nil)))
|
||||
(if replace
|
||||
(progn (setq auto-insert-alist
|
||||
(assoc-delete-all (list condition)
|
||||
auto-insert-alist
|
||||
testfn))
|
||||
(define-auto-insert condition action after))
|
||||
(unless (assoc (list condition) auto-insert-alist testfn)
|
||||
(define-auto-insert condition action after)))))
|
||||
|
||||
(provide 'acdw-autoinsert)
|
||||
;;; acdw-autoinsert.el ends here
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
;;; acdw-bell.el --- flash mode-line on error -*- lexical-binding: t; -*-
|
||||
|
||||
;; cribbed pretty heavily from doom-themes-ext-visual-bell.el ...
|
||||
|
||||
(require 'face-remap)
|
||||
|
||||
(defface acdw-bell '((t (:inherit mode-line-highlight)))
|
||||
"Face to use for the mode-line when `doom-themes-visual-bell-config' is used."
|
||||
:group 'mode-line)
|
||||
|
||||
;;;###autoload
|
||||
(defun acdw-bell/flash-mode-line (&optional beep-p)
|
||||
"Blink the mode-line red briefly. Set `ring-bell-function' to this to use it.
|
||||
If BEEP-P is non-nil, beep too."
|
||||
(let ((acdw-bell//cookie
|
||||
(face-remap-add-relative 'mode-line 'acdw-bell)))
|
||||
(force-mode-line-update)
|
||||
(when beep-p (beep))
|
||||
(run-with-timer 0.15 nil
|
||||
(lambda (cookie buf)
|
||||
(with-current-buffer buf
|
||||
(face-remap-remove-relative cookie)
|
||||
(force-mode-line-update)))
|
||||
acdw-bell//cookie
|
||||
(current-buffer))))
|
||||
|
||||
(provide 'acdw-bell)
|
||||
;;; acdw-bell.el ends here
|
||||
|
|
@ -1,129 +0,0 @@
|
|||
;;; acdw-browse-url.el -*- lexical-binding: t; coding: utf-8-unix -*-
|
||||
;;
|
||||
;; Add-ons to `browse-url'.
|
||||
|
||||
(defvar browse-url-mpv-arguments nil
|
||||
"Arguments to pass to mpv in `browse-url-mpv'.")
|
||||
|
||||
(defun browse-url-mpv (url &optional new-window)
|
||||
"Play URL in mpv."
|
||||
(interactive (browse-url-interactive-arg "Video URL: "))
|
||||
(ignore new-window) ;; mpv always opens a new window
|
||||
(let* ((url (browse-url-encode-url url))
|
||||
(process-environment (browse-url-process-environment)))
|
||||
(message "Playing %s in mpv..." url)
|
||||
(apply #'start-process
|
||||
(concat "mpv " url) nil
|
||||
"mpv"
|
||||
(append
|
||||
browse-url-mpv-arguments
|
||||
(list url)))))
|
||||
|
||||
(defvar browse-url-feh-arguments '("--auto-zoom"
|
||||
"--geometry" "800x600")
|
||||
"Arguments to pass to feh in `browse-url-feh'.")
|
||||
|
||||
(defun browse-url-feh (url &optional new-window)
|
||||
"Open `URL' in feh."
|
||||
(interactive (browse-url-interactive-arg "Video URL: "))
|
||||
(ignore new-window) ;; mpv always opens a new window
|
||||
(let* ((url (browse-url-encode-url url))
|
||||
(process-environment (browse-url-process-environment)))
|
||||
(message "Opening %s in feh..." url)
|
||||
(apply #'start-process
|
||||
(concat "feh " url) nil
|
||||
"feh"
|
||||
(append
|
||||
browse-url-feh-arguments
|
||||
(list url)))))
|
||||
|
||||
(defun acdw/browse-url-set-handlers (handlers)
|
||||
"Set handlers for `browse-url'.
|
||||
If Emacs' version is 28 or higher, set `browse-url-handlers'.
|
||||
Else, set `browse-url-browser-function'; it's deprecated in 28+."
|
||||
(set-default (if (version< emacs-version "28")
|
||||
#'browse-url-browser-function
|
||||
#'browse-url-handlers)
|
||||
handlers))
|
||||
|
||||
;;; URL regexp
|
||||
;; really, I just want to add gemini:// protocol, but I'm going to do some
|
||||
;; reverse-engineering here.
|
||||
(defvar acdw/button-protocols '("http"
|
||||
"https"
|
||||
"shttp"
|
||||
"shttps"
|
||||
"ftp"
|
||||
"file"
|
||||
"gopher"
|
||||
"nntp"
|
||||
"news"
|
||||
"telnet"
|
||||
"wais"
|
||||
"mailto"
|
||||
"info")
|
||||
"The list of protocols to splice into `browse-url-button-regexp'.")
|
||||
|
||||
(defun acdw/build-button-url-regexp ()
|
||||
"Build `browse-url-button-regexp' from `acdw/button-protocols'.
|
||||
I used `xr' (not included in Emacs) to get the RX form of the
|
||||
default, so I can easily splice the list into it. THIS IS
|
||||
BRITTLE AF!!!"
|
||||
(rx-to-string ; thanks wgreenhouse!
|
||||
`(seq word-boundary
|
||||
(group
|
||||
(group
|
||||
(or "www."
|
||||
(seq
|
||||
(group (or ,@acdw/button-protocols))
|
||||
":")))
|
||||
(opt
|
||||
(group "//"
|
||||
(one-or-more
|
||||
(any "0-9a-z" "._-"))
|
||||
":"
|
||||
(zero-or-more
|
||||
(any "0-9"))))
|
||||
(or
|
||||
(seq
|
||||
(one-or-more
|
||||
(any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
|
||||
"("
|
||||
(one-or-more
|
||||
(any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
|
||||
(zero-or-more
|
||||
(any "0-9a-z" "#$%&*+/=@\\_~-" word))
|
||||
")"
|
||||
(opt
|
||||
(one-or-more
|
||||
(any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
|
||||
(any "0-9a-z" "#$%&*+/=@\\_~-" word)))
|
||||
(seq
|
||||
(one-or-more
|
||||
(any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
|
||||
(any "0-9a-z" "#$%&*+/=@\\_~-" word)))))))
|
||||
|
||||
(defun acdw/add-button-url-regexp-protocol (proto)
|
||||
"Add PROTO to `browse-url-button-regexp'
|
||||
First, add PROTO to `acdw/button-protocols'.
|
||||
Then, build `browse-url-button-regexp' with the new protocol."
|
||||
(add-to-list 'acdw/button-protocols proto)
|
||||
(setq-default browse-url-button-regexp (acdw/build-button-url-regexp)))
|
||||
|
||||
;;; Browse-URL tweaks
|
||||
|
||||
;; convert reddit.com to teddit
|
||||
(defun acdw/eww-browse-reddit-url (url &rest args)
|
||||
"Browse a Reddit.com URL using Teddit."
|
||||
(let* ((teddit "teddit.com")
|
||||
(url (replace-regexp-in-string "reddit\\.com" teddit url)))
|
||||
(eww-browse-url url args)))
|
||||
|
||||
;; convert twitter.com to nitter
|
||||
(defun acdw/eww-browse-twitter-url (url &rest args)
|
||||
"Browse a Twitter.com URL using Nitter."
|
||||
(let* ((nitter "nitter.snopyta.org")
|
||||
(url (replace-regexp-in-string "twitter\\.com" nitter url)))
|
||||
(eww-browse-url url args)))
|
||||
|
||||
(provide 'acdw-browse-url)
|
||||
|
|
@ -1,167 +0,0 @@
|
|||
;;; acdw-circe.el --- bespoke circe customizations -*- lexical-binding: t -*-
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Besoke Circe customizations.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'circe)
|
||||
(require 'el-patch)
|
||||
|
||||
;;; Functions
|
||||
|
||||
(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 whether circe is connected to NETWORK."
|
||||
(catch 'return
|
||||
(dolist (buffer (circe-server-buffers))
|
||||
(with-current-buffer buffer
|
||||
(if (string= network circe-server-network)
|
||||
(throw 'return t))))))
|
||||
|
||||
(defun circe-maybe-connect (network)
|
||||
"Connect to NETWORK, asking for confirmation to reconnect."
|
||||
(interactive "sNetwork: ")
|
||||
(if (or (not (circe-network-connected-p network))
|
||||
(y-or-n-p (format "Already connected to %s, reconnect? " network)))
|
||||
(circe network)))
|
||||
|
||||
(defun circe-current-topic (&optional message)
|
||||
"Return the topic of the current channel.
|
||||
When called with MESSAGE set to non-nil (or interactively), also
|
||||
message the current topic."
|
||||
(interactive "p")
|
||||
(let ((topic
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(or (re-search-backward
|
||||
(rx (group "*** Topic" (+ (not ":")) ": ")
|
||||
(group (+ nonl)))))
|
||||
(buffer-substring-no-properties
|
||||
(match-beginning 2) (match-end 2)))))
|
||||
(when message
|
||||
(message "%s" topic))
|
||||
topic))
|
||||
|
||||
;;; Chat commands
|
||||
|
||||
(defun circe-command-SHORTEN (url)
|
||||
"Shorten URL using `0x0-shorten-uri'."
|
||||
(interactive "sURL to shorten: ")
|
||||
(require '0x0)
|
||||
;; TODO: enable /shorten URL comment syntax
|
||||
(let ((short-url (0x0-shorten-uri (0x0--choose-server) url)))
|
||||
(circe-command-SAY short-url)))
|
||||
|
||||
(defun circe-command-SLAP (nick)
|
||||
"Slap NICK around a bit with a large trout."
|
||||
(interactive "sWho we slappin' today, boss? ")
|
||||
(circe-command-ME (concat "slaps "
|
||||
(string-trim nick)
|
||||
" around a bit with a large trout")))
|
||||
|
||||
;;; Hooks
|
||||
|
||||
(defun circe-chat@set-prompt ()
|
||||
"Set the prompt to the buffer name, shortening it."
|
||||
(interactive) ; set interactive to unfuck the prompt when need be
|
||||
(lui-set-prompt
|
||||
(propertize
|
||||
(concat
|
||||
(acdw-irc/margin-format (buffer-name) "" ">")
|
||||
" ")
|
||||
'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
|
||||
|
|
@ -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 <return> 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
|
||||
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
228
lisp/acdw-erc.el
228
lisp/acdw-erc.el
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
151
lisp/acdw-re.el
151
lisp/acdw-re.el
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
899
lisp/acdw.el
899
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.
|
||||
|
||||
;; 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 `+' !
|
||||
|
||||
;; 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.
|
||||
|
||||
;; Is it perfect? No. Is it fine? Yes. Here it is.
|
||||
|
||||
;;; 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)))
|
||||
|
||||
(defun html-body-div-filter (output backend info)
|
||||
"Remove wrapping divs generated by Org."
|
||||
(when (eq backend 'html)
|
||||
(replace-regexp-in-string
|
||||
"</?div[^>]*>\n*" ""
|
||||
output t)))
|
||||
|
||||
(defun org-demote-headings (backend)
|
||||
(while (/= (point) (point-max))
|
||||
(org-next-visible-heading 1)
|
||||
(org-demote-subtree)))
|
||||
|
||||
(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 "<h2>.*</h2>" "")
|
||||
(insert "<h2>" extracted-heading "</h2>")
|
||||
(flush-lines "^$" (point-min) (point-max))
|
||||
(let ((sentence-end-double-space nil))
|
||||
(unfill-region (point-min) (point-max)))
|
||||
(replace-regexp "<h" "\n<h" nil (1+ (point-min)) (point-max))
|
||||
(replace-regexp "<p" "\n<p" nil (point-min) (point-max))
|
||||
(replace-regexp "<p> +" "<p>" nil (point-min) (point-max))
|
||||
(replace-regexp " +</p>" "</p>" 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))
|
||||
|
||||
(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
|
||||
|
|
|
|||
76
lisp/chd.el
76
lisp/chd.el
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
Loading…
Reference in New Issue