From 43bed1f97e6f1a229553d7a25dc437741326772e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 May 2023 13:08:35 -0500 Subject: Bankruptcy 10 --- .gitattributes | 5 - .gitignore | 35 +- basics.el | 680 --------------------- definitions.el | 149 +++++ early-init.el | 58 -- init.el | 1623 +++++++++++++++----------------------------------- lisp/+completions.el | 65 -- lisp/+link-hint.el | 175 ------ lisp/+org-capture.el | 49 -- lisp/+scratch.el | 75 --- lisp/acdw-chat.el | 206 ------- lisp/acdw-mail.el | 439 -------------- lisp/acdw-org.el | 548 ----------------- lisp/acdw-shell.el | 141 ----- lisp/acdw-web.el | 374 ------------ lisp/acdw.el | 384 ------------ lisp/ical2org.el | 56 -- packages.el | 129 ++++ 18 files changed, 750 insertions(+), 4441 deletions(-) delete mode 100644 .gitattributes delete mode 100644 basics.el create mode 100644 definitions.el delete mode 100644 early-init.el delete mode 100644 lisp/+completions.el delete mode 100644 lisp/+link-hint.el delete mode 100644 lisp/+org-capture.el delete mode 100644 lisp/+scratch.el delete mode 100644 lisp/acdw-chat.el delete mode 100644 lisp/acdw-mail.el delete mode 100644 lisp/acdw-org.el delete mode 100644 lisp/acdw-shell.el delete mode 100644 lisp/acdw-web.el delete mode 100644 lisp/acdw.el delete mode 100644 lisp/ical2org.el create mode 100644 packages.el diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index 78e9377..0000000 --- a/.gitattributes +++ /dev/null @@ -1,5 +0,0 @@ -* text eol=lf - -*.lisp diff=lisp -*.el diff=lisp -*.org diff=org diff --git a/.gitignore b/.gitignore index 67825c8..aebf66d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,30 +1,5 @@ -*~ -.#* -.* -*.elc -.etc/ -.org-id-locations -auto-save-list/ -eln-cache/ -elpa/ -etc/ -feeds.txt -gnus/ -old/ -pkg/ -racket-mode/ -server/ -straight/ -transient/ -var/ -eshell/* -!eshell/aliases -url/ -spell-fu/ -yoke/ -lisp/*-autoloads.el - -# put random stuff in here -scratch.el -jabber-avatar-cache/ -tree-sitter/ \ No newline at end of file +* +!init.el +!packages.el +!definitions.el +!.gitignore \ No newline at end of file diff --git a/basics.el b/basics.el deleted file mode 100644 index 1405c84..0000000 --- a/basics.el +++ /dev/null @@ -1,680 +0,0 @@ -;;; basics.el --- Super basic Emacs settings -*- lexical-binding: t -*- - -;;; Commentary: - -;; These are the settings that I literally cannot live without. Basic -;; settings, built-in packages, that kind of stuff. Everything else -;; goes in init.el. - -;;; Code: - -(push (locate-user-emacs-file "lisp/") load-path) -(require 'acdw) - -;;; Directories - -(defdir etc/ (locate-user-emacs-file "etc/") - "Where various Emacs files are placed." - :makedir) - -(defdir sync/ "~/sync/" - "My Syncthing directory." - :makedir) - -(defdir private/ (sync/ "emacs/private/") - "Private files and stuff." - :makedir) - -(use-package no-littering - :ensure t :demand t - :preface - (setq-default no-littering-etc-directory etc/ - no-littering-var-directory etc/)) - - -;;; Settings - -;; Async -(setq-default async-shell-command-buffer 'new-buffer - async-shell-command-display-buffer nil) - -;; Scrolling -(setq-default auto-hscroll-mode t - auto-window-vscroll nil - fast-but-imprecise-scrolling t - hscroll-margin 1 - hscroll-step 1 - scroll-conservatively 25 - scroll-margin 0 - scroll-preserve-screen-position 1 - scroll-step 1) -(scroll-bar-mode -1) -(horizontal-scroll-bar-mode -1) - -;; Cursor -(setq-default cursor-in-non-selected-windows 'hollow - cursor-type 'bar - blink-cursor-blinks 1 - blink-cursor-interval 0.25 - blink-cursor-delay 0.25) -(blink-cursor-mode) - -;; Mouse -(setq-default mouse-drag-copy-region t - mouse-wheel-progressive-speed nil - mouse-yank-at-point t) - -;; Dialogs -(unless (boundp 'use-short-answers) - (fset 'yes-or-no-p 'y-or-n-p)) - -(setq-default read-answer-short t - use-dialog-box nil - use-file-dialog nil - use-short-answers t) - -;; Minibuffer -(setq-default completion-ignore-case t - read-buffer-completion-ignore-case t - read-file-name-completion-ignore-case t - completions-detailed t - enable-recursive-minibuffers t - file-name-shadow-properties '(invisible t intangible t) - minibuffer-eldef-shorten-default t - minibuffer-prompt-properties '( read-only t - cursor-intangible t - face minibuffer-prompt)) -(file-name-shadow-mode) -(minibuffer-electric-default-mode) - -(define-minor-mode truncate-lines-local-mode - "Truncate lines locally in a buffer." - :lighter " ..." - :group 'display - (setq-local truncate-lines truncate-lines-local-mode)) - -(add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) - -(require 'savehist) -(setq-default history-length 1024 - history-delete-duplicates t - ;; savehist-file (etc/ "savehist.el") - savehist-save-minibuffer-history t - savehist-autosave-interval 30) -(savehist-mode) - -;; Killing and yanking -(setq-default kill-do-not-save-duplicates t - kill-read-only-ok t - ;; XXX: This setting causes an error message the first time it's - ;; called: "Selection owner couldn't convert: TIMESTAMP". I have - ;; absolutely no idea why I get this error, but it's generated in - ;; `x_get_foreign_selection'. I also can't inhibit the message or - ;; do anything else with it, so for now, I'll just live with the - ;; message. - save-interprogram-paste-before-kill t - yank-pop-change-selection t) -(delete-selection-mode) - -;; Notifying the user -(setq-default echo-keystrokes 0.01 - ring-bell-function #'ignore) - -;; Point and mark -(setq-default set-mark-command-repeat-pop t) - -;; The system -(setq-default read-process-output-max (* 10 1024 1024)) - -;; Startup -(setq-default inhibit-startup-screen t - initial-buffer-choice t - initial-scratch-message nil) - -(define-advice startup-echo-area-message (:override ()) - (if (get-buffer "*Warnings*") - ";_;" - "^_^")) - -(menu-bar-mode -1) -(tool-bar-mode -1) -(tooltip-mode -1) - -;; Text editing -(setq-default fill-column 80 - sentence-end-double-space nil - tab-width 8 - tab-always-indent 'complete) -(global-so-long-mode) - -(setq-default show-paren-delay 0.01 - show-paren-style 'parenthesis - show-paren-when-point-in-periphery t - show-paren-when-point-inside-paren t) -(show-paren-mode) -(electric-pair-mode) - -;; Encodings -(set-language-environment "UTF-8") -(setq-default buffer-file-coding-system 'utf-8-unix - coding-system-for-read 'utf-8-unix - coding-system-for-write 'utf-8-unix - default-process-coding-system '(utf-8-unix . utf-8-unix) - locale-coding-system 'utf-8-unix) -(set-charset-priority 'unicode) -(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))) - -;; Abbrev -(setq-default abbrev-file-name (sync/ "abbrev.el") - save-abbrevs 'silently) - -;; Files -(setq-default auto-revert-verbose nil - global-auto-revert-non-file-buffers t - create-lockfiles nil - find-file-visit-truename t - mode-require-final-newline t - view-read-only t - save-silently t) -(global-auto-revert-mode) - -(setq-default auto-save-default nil - auto-save-interval 1 - auto-save-no-message t - auto-save-timeout 1 - auto-save-visited-interval 1 - remote-file-name-inhibit-auto-save-visited t) -(add-to-list 'auto-save-file-name-transforms - `(".*" ,(etc/ "auto-save/" t) t)) -(auto-save-visited-mode) - -(setq-default backup-by-copying t - version-control t - kept-new-versions 8 - kept-old-versions 8 - delete-old-versions t - backup-directory-alist - `(("^/dev/shm" . nil) - ("^/tmp" . nil) - (,(getenv "XDG_RUNTIME_DIR") . nil) - ("." . ,(no-littering-expand-etc-file-name "backup")))) - -(require 'recentf) -(setq-default ;; recentf-save-file (etc/ "recentf" t) - recentf-max-menu-items 500 - recentf-max-saved-items nil ; Save the whole list - recentf-auto-cleanup 'mode - recentf-case-fold-search t) -(add-to-list 'recentf-exclude etc/) -(add-to-list 'recentf-exclude "-autoloads.el\\'") -(add-hook 'buffer-list-update-hook #'recentf-track-opened-file) -(add-hook 'after-save-hook #'recentf-save-list) -(recentf-mode) - -(require 'saveplace) -(setq-default ;; save-place-file (etc/ "places.el") - save-place-forget-unreadable-files (eq system-type - 'gnu/linux)) -(save-place-mode) - -(require 'uniquify) -(setq uniquify-after-kill-buffer-p t - uniquify-buffer-name-style 'forward - uniquify-ignore-buffers-re "^\\*" - uniquify-separator path-separator) - -(setq-local vc-follow-symlinks t - vc-make-backup-files t) - -;; Whitespace -(require 'whitespace) -(setq-default whitespace-style - '(face trailing tabs tab-mark)) -(global-whitespace-mode) -(add-hook 'before-save-hook - (defun delete-trailing-whitespace-except-current-line () - (save-excursion - (delete-trailing-whitespace (point-min) - (line-beginning-position)) - (delete-trailing-whitespace (line-end-position) - (point-max))))) - -;; Native compilation -(setq-default native-comp-async-report-warnings-errors 'silent - native-comp-deferred-compilation t - native-compile-target-directory (etc/ "eln" t)) -(when (boundp 'native-comp-eln-load-path) - (add-to-list 'native-comp-eln-load-path native-compile-target-directory)) -(when (fboundp 'startup-redirect-eln-cache) - (startup-redirect-eln-cache native-compile-target-directory)) - -;; Custom file -(setq-default custom-file (private/ "custom.el")) -(define-advice package--save-selected-packages - (:around (orig &rest args) no-custom) - "Don't save `package-selected-packages' to `custom-file'." - (let ((custom-file (expand-file-name "custom.el" - temporary-file-directory))) - (apply orig args))) - -;; Goto Address -(if (fboundp 'global-goto-address-mode) - (global-goto-address-mode) - (add-hook 'after-change-major-mode-hook #'goto-address-mode)) - -;; Winner -(winner-mode) - - -;;; Keybindings - -(defun other-window|switch-buffer (arg) - "Call `other-window' or `switch-buffer' depending on windows. -When called with prefix ARG, unconditionally switch buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) - -(defun delete-window|bury-buffer () - "Delete the current window, or bury the current buffer. -If the current window is the only window, bury the buffer." - (interactive) - (condition-case e - (delete-window) - (t (bury-buffer)))) - -(defun +cycle-spacing (&optional n) - ;; `cycle-spacing' is wildly different in 29.1 over 28. - "Negate N argument on `cycle-spacing'. -That is, with a positive N, deletes newlines as well, leaving -N -spaces. If N is negative, it will not delete newlines and leave -N spaces." - (interactive "*p") - (cycle-spacing (- n))) - -(defun +comment-dwim (&optional prefix) - "Comments or uncomments current line or region. -When called with PREFIX, start a comment at the end of the -current line." - (interactive "P") - (if prefix - (comment-indent) - (apply #'comment-or-uncomment-region - (if (region-active-p) - (list (region-beginning) - (region-end)) - (list (line-beginning-position) - (line-end-position)))))) - -(defun +kill-buffer (&optional buffer-or-name) - "Kill the current buffer, or BUFFER-OR-NAME. -When called interactively, prompt the user when given a prefix -argument." - (interactive "P") - (cond - ((bufferp buffer-or-name) - (kill-buffer buffer-or-name)) - ((null buffer-or-name) - (kill-current-buffer)) - (:else - (kill-buffer (read-buffer "Kill: " nil :require-match))))) - -(defun +backward-kill-word (arg) - "Kill ARG words backward unless at the beginning of a line. -When at the beginning of a line, delete blank lines before point." - (interactive "p") - (cond - ((bolp) - ;; This is the first bit of `delete-blank-lines'. -- acdw - (let (thisblank singleblank) - (save-excursion - (beginning-of-line) - (setq thisblank (looking-at "[ \t]*$")) - ;; Set singleblank if there is just one blank line here. - (setq singleblank - (and thisblank - (not (looking-at "[ \t]*\n[ \t]*$")) - (or (bobp) - (progn (forward-line -1) - (not (looking-at "[ \t]*$"))))))) - ;; Delete preceding blank lines, and this one too if it's the only one. - (if thisblank - (progn - (beginning-of-line) - (if singleblank (forward-line 1)) - (delete-region (point) - (if (re-search-backward "[^ \t\n]" nil t) - (progn (forward-line 1) (point)) - (point-min))))) - (if (or (not thisblank) - singleblank) - (progn - (beginning-of-line) - (backward-delete-char 1))))) - (:else - (backward-kill-word arg)))) - -(global-set-key [remap eval-expression] #'pp-eval-expression) -(global-set-key (kbd "M-o") #'other-window|switch-buffer) -(global-set-key [remap delete-window] #'delete-window|bury-buffer) -(global-set-key [remap cycle-spacing] #'+cycle-spacing) -(global-set-key (kbd "C-x C-k") #'+kill-buffer) -(global-set-key [remap comment-dwim] #'+comment-dwim) -(global-set-key [remap undo] #'undo-only) -(global-set-key [remap backward-kill-word] #'+backward-kill-word) - -(global-set-key [f10] #'tmm-menubar) -(advice-add 'tmm-add-prompt :after 'minibuffer-hide-completions) - -(when (fboundp '+lisp-comment-or-uncomment-sexp) - (define-key lisp-mode-map (kbd "C-M-;") #'+lisp-comment-or-uncomment-sexp) - (define-key emacs-lisp-mode-map (kbd "C-M-;") - #'+lisp-comment-or-uncomment-sexp) - (with-eval-after-load 'scheme - (define-key scheme-mode-map (kbd "C-M-;") - #'+lisp-comment-or-uncomment-sexp))) - -(define-key emacs-lisp-mode-map (kbd "C-c C-c") - #'eval-defun) -(define-key emacs-lisp-mode-map (kbd "C-c C-k") - #'elisp-eval-region-or-buffer) -(define-key lisp-interaction-mode-map (kbd "C-c C-c") - #'eval-defun) -(define-key lisp-interaction-mode-map (kbd "C-c C-k") - #'elisp-eval-region-or-buffer) -(define-advice eval-region (:around (orig start end &rest args) pulse) - (apply orig start end args) - (pulse-momentary-highlight-region start end)) - -(global-set-key (kbd "C-x C-b") #'ibuffer) - - -;;; Hooks - -(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) - -(add-hook 'find-file-not-found-functions - (defun create-missing-directories () - "Automatically create missing directories." - (let ((target-dir (file-name-directory buffer-file-name))) - (unless (file-exists-p target-dir) - (make-directory target-dir :parents))))) - -(add-hook 'find-file-hook - (defun vc-remote-off () - "Turn VC off when remote." - (when (file-remote-p (buffer-file-name)) - (setq-local vc-handled-backends nil)))) - - -;;; Advice - -(define-advice switch-to-buffer (:after (&rest _) normal-mode) - "Automatically determine the mode for non-file buffers." - (when-let ((_ (and (eq major-mode 'fundamental-mode))) - (buffer-file-name (buffer-name))) - (normal-mode))) - -(define-advice canonically-space-region - (:around (orig &rest args) double-space-sentences) - "Always double-space sentences canonically." - (let ((sentence-end-double-space t)) - (apply orig args))) - - -;;; Packages - -(use-package _acdw - :load-path private/) - -(use-package custom-allowed - :load-path "~/src/custom-allowed.el/" - :config - (add-to-list 'custom-allowed-variables 'safe-local-variable-values) - (add-to-list 'custom-allowed-variables 'ispell-buffer-session-localwords) - (add-to-list 'custom-allowed-variables 'warning-suppress-types) - (add-to-list 'custom-allowed-variables 'calendar-latitude) - (add-to-list 'custom-allowed-variables 'calendar-longitude) - (add-to-list 'custom-allowed-variables 'user-full-name) - (add-to-list 'custom-allowed-variables 'user-mail-address) - :hook - (after-init-hook . custom-allowed-load-custom-file)) - -(use-package sophomore - :load-path "~/src/sophomore.el/" - :config - (sophomore-enable-all) - (sophomore-disable 'view-hello-file - 'describe-gnu-project - 'suspend-frame) - (sophomore-mode)) - -(use-package compat - ;; This shouldn't be necessary, but sadly I believe that it is. - :ensure t) - -(use-package vertico - :ensure t :demand t - :config - (setq vertico-cycle t) - (add-hook 'vertico-mode-hook - (defun vertico-mode@fix-completions () - (setq completion-in-region-function - (if vertico-mode - #'consult-completion-in-region - #'completion--in-region)))) - (vertico-mode)) - -(use-package vertico-directory - :after vertico - :bind (:map vertico-map - ("C-" . vertico-directory-delete-word)) - :hook (rfn-shadow-update-overlay-hook . vertico-directory-tidy)) - -(use-package vertico-mouse - :after vertico - :config (vertico-mouse-mode)) - -;; Example configuration for Consult -(use-package consult - :ensure t - ;; Replace bindings. Lazily loaded due by `use-package'. - :bind (;; C-c bindings (mode-specific-map) - ("C-c h" . consult-history) - ("C-c m" . consult-mode-command) - ("C-c k" . consult-kmacro) - ;; C-x bindings (ctl-x-map) - ("C-x M-:" . consult-complex-command) - ("C-x b" . consult-buffer) - ("C-x 4 b" . consult-buffer-other-window) - ("C-x 5 b" . consult-buffer-other-frame) - ("C-x r b" . consult-bookmark) - ("C-x p b" . consult-project-buffer) - ;; Custom M-# bindings for fast register access - ("M-#" . consult-register-load) - ("M-'" . consult-register-store) - ("C-M-#" . consult-register) - ;; Other custom bindings - ("M-y" . consult-yank-pop) - ;; M-g bindings (goto-map) - ("M-g e" . consult-compile-error) - ("M-g f" . consult-flymake) - ("M-g g" . consult-goto-line) - ("M-g M-g" . consult-goto-line) - ("M-g o" . consult-outline) - ("M-g m" . consult-mark) - ("M-g k" . consult-global-mark) - ("M-g i" . consult-imenu) - ("M-g I" . consult-imenu-multi) - ;; M-s bindings (search-map) - ("M-s d" . consult-find) - ("M-s D" . consult-locate) - ("M-s g" . consult-grep) - ("M-s G" . consult-git-grep) - ("M-s r" . consult-ripgrep) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi) - ("M-s k" . consult-keep-lines) - ("M-s u" . consult-focus-lines) - ;; Isearch integration - ("M-s e" . consult-isearch-history) - :map isearch-mode-map - ("M-e" . consult-isearch-history) - ("M-s e" . consult-isearch-history) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi) - ;; Minibuffer history - :map minibuffer-local-map - ("M-s" . consult-history) - ("M-r" . consult-history)) - - ;; Enable automatic preview at point in the *Completions* buffer. This is - ;; relevant when you use the default completion UI. - :hook (completion-list-mode . consult-preview-at-point-mode) - - ;; The :init configuration is always executed (Not lazy) - :init - - ;; Optionally configure the register formatting. This improves the register - ;; preview for `consult-register', `consult-register-load', - ;; `consult-register-store' and the Emacs built-ins. - (setq register-preview-delay 0.5 - register-preview-function #'consult-register-format) - - ;; Optionally tweak the register preview window. - ;; This adds thin lines, sorting and hides the mode line of the window. - (advice-add #'register-preview :override #'consult-register-window) - - (define-advice completing-read-multiple (:filter-args (args) indicator) - (cons (format "[CRM%s] %s" - (replace-regexp-in-string - "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" - crm-separator) - (car args)) - (cdr args))) - - ;; Use Consult to select xref locations with preview - (setq xref-show-xrefs-function #'consult-xref - xref-show-definitions-function #'consult-xref) - - (setq completion-in-region-function #'consult-completion-in-region) - - ;; Configure other variables and modes in the :config section, - ;; after lazily loading the package. - :config - - ;; Optionally configure preview. The default value - ;; is 'any, such that any key triggers the preview. - ;; (setq consult-preview-key 'any) - ;; (setq consult-preview-key (kbd "M-.")) - ;; (setq consult-preview-key (list (kbd "") (kbd ""))) - ;; For some commands and buffer sources it is useful to configure the - ;; :preview-key on a per-command basis using the `consult-customize' macro. - (consult-customize - consult-theme :preview-key '(:debounce 0.2 any) - consult-ripgrep consult-git-grep consult-grep - consult-bookmark consult-recent-file consult-xref - consult--source-bookmark consult--source-file-register - consult--source-recent-file consult--source-project-recent-file - ;; :preview-key (kbd "M-.") - :preview-key '(:debounce 0.4 any)) - - ;; (consult-customize consult-line - ;; consult-ripgrep - ;; :initial (when (use-region-p) - ;; (buffer-substring-no-properties - ;; (region-beginning) (region-end)))) - - ;; Optionally configure the narrowing key. - ;; Both < and C-+ work reasonably well. - (setq consult-narrow-key "<") ;; (kbd "C-+") - - ;; Optionally make narrowing help available in the minibuffer. - ;; You may want to use `embark-prefix-help-command' or which-key instead. - (define-key consult-narrow-map (vconcat consult-narrow-key "?") - #'consult-narrow-help)) - -(use-package orderless - :ensure t :demand t - :init - (setq completion-styles '(orderless substring basic) - completion-category-defaults nil - completion-category-overrides - '((file (styles basic partial-completion orderless))))) - -(use-package marginalia - :ensure t :demand t - :config - (marginalia-mode)) - -(use-package embark - :ensure t - :bind - (("C-." . embark-act) - ("M-." . embark-dwim) - ("C-h B" . embark-bindings)) - :init - (setq prefix-help-command #'embark-prefix-help-command) - :config - (add-to-list 'display-buffer-alist - '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" - nil - (window-parameters (mode-line-format . none))))) - -(use-package embark-consult - :ensure t - :hook - (embark-collect-mode . consult-preview-at-point-mode)) - -(use-package undo-fu - :ensure t - :init - (setq undo-limit 67108864) ; 64mb. - (setq undo-strong-limit 100663296) ; 96mb. - (setq undo-outer-limit 1006632960) ; 960mb. - :bind (("C-/" . undo-fu-only-undo) - ("C-?" . undo-fu-only-redo))) - -(use-package undo-fu-session - :ensure t - :config - (setq undo-fu-session-compression (cond - ((executable-find "gunzip") 'gz) - ((executable-find "bzip2") 'bz2)) - undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" - "/git-rebase-todo\\'")) - (global-undo-fu-session-mode)) - -(use-package crux - :ensure t :demand t - :bind (("C-x 4 t" . crux-transpose-windows)) - :config - (crux-with-region-or-buffer indent-region) - (crux-with-region-or-buffer tabify) - (crux-with-region-or-buffer untabify) - (crux-reopen-as-root-mode)) - -(use-package pixel-scroll - :demand t - :bind (([right-margin wheel-down] . pixel-scroll-precision) - ([right-margin double-wheel-down] . pixel-scroll-precision) - ([right-margin triple-wheel-down] . pixel-scroll-precision) - ([right-margin wheel-up] . pixel-scroll-precision) - ([right-margin double-wheel-up] . pixel-scroll-precision) - ([right-margin triple-wheel-up] . pixel-scroll-precision)) - :config - (when (fboundp 'pixel-scroll-precision-mode) - (pixel-scroll-precision-mode))) - -;;; basics.el ends here diff --git a/definitions.el b/definitions.el new file mode 100644 index 0000000..125c87e --- /dev/null +++ b/definitions.el @@ -0,0 +1,149 @@ +;;; definitions.el --- definitions for my Emacs config -*- lexical-binding: t; -*- + +(defun other-window-or-switch-buffer (&optional arg) + "Switch to the other window. +If a window is the only buffer on a frame, switch buffer. When +run with \\[universal-argument], unconditionally switch buffer." + (interactive "P") + (if (or arg (one-window-p)) + (switch-to-buffer (other-buffer) nil t) + (other-window 1))) + +(defun cycle-spacing@ (&optional n) + ;; `cycle-spacing' is wildly different in 29.1 over 28. + "Negate N argument on `cycle-spacing'. +That is, with a positive N, deletes newlines as well, leaving -N +spaces. If N is negative, it will not delete newlines and leave +N spaces." + (interactive "*p") + (cycle-spacing (- n))) + +(defun first-frame@set-fonts () + (remove-hook 'server-after-make-frame-hook + #'first-frame@set-fonts) + (face-spec-set 'default + `((t :family "Recursive Mono Casual Static" + :height 110))) + ;; Emojis + (cl-loop with ffl = (font-family-list) + for font in '("Noto Emoji" "Noto Color Emoji" + "Segoe UI Emoji" "Apple Color Emoji" + "FreeSans" "FreeMono" "FreeSerif" + "Unifont" "Symbola") + if (member font ffl) + do (set-fontset-font t 'symbol font)) + ;; International fonts + (cl-loop with ffl = (font-family-list) + for (charset . font) + in '((latin . "Noto Sans") + (han . "Noto Sans CJK SC Regular") + (kana . "Noto Sans CJK JP Regular") + (hangul . "Noto Sans CJK KR Regular") + (cjk-misc . "Noto Sans CJK KR Regular") + (khmer . "Noto Sans Khmer") + (lao . "Noto Sans Lao") + (burmese . "Noto Sans Myanmar") + (thai . "Noto Sans Thai") + (ethiopic . "Noto Sans Ethiopic") + (hebrew . "Noto Sans Hebrew") + (arabic . "Noto Sans Arabic") + (gujarati . "Noto Sans Gujarati") + (devanagari . "Noto Sans Devanagari") + (kannada . "Noto Sans Kannada") + (malayalam . "Noto Sans Malayalam") + (oriya . "Noto Sans Oriya") + (sinhala . "Noto Sans Sinhala") + (tamil . "Noto Sans Tamil") + (telugu . "Noto Sans Telugu") + (tibetan . "Noto Sans Tibetan")) + if (member font ffl) + do (set-fontset-font t charset font))) + +(defun switch-themes () + (interactive) + (let ((current-theme (car custom-enabled-themes))) + (mapc #'disable-theme custom-enabled-themes) + (enable-theme (pcase current-theme + ('modus-operandi 'modus-vivendi) + ('modus-vivendi 'modus-operandi))))) + +(defun renz/sort-by-alpha-length (elems) + "Sort ELEMS first alphabetically, then by length." + (sort elems (lambda (c1 c2) + (or (string-version-lessp c1 c2) + (< (length c1) (length c2)))))) + +(defun renz/sort-by-history (elems) + "Sort ELEMS by minibuffer history. +Use `mct-sort-sort-by-alpha-length' if no history is available." + (if-let ((hist (and (not (eq minibuffer-history-variable t)) + (symbol-value minibuffer-history-variable)))) + (minibuffer--sort-by-position hist elems) + (renz/sort-by-alpha-length elems))) + +(defun renz/completion-category () + "Return completion category." + (when-let ((window (active-minibuffer-window))) + (with-current-buffer (window-buffer window) + (completion-metadata-get + (completion-metadata (buffer-substring-no-properties + (minibuffer-prompt-end) + (max (minibuffer-prompt-end) (point))) + minibuffer-completion-table + minibuffer-completion-predicate) + 'category)))) + +(defun renz/sort-multi-category (elems) + "Sort ELEMS per completion category." + (pcase (renz/completion-category) + ('nil elems) ; no sorting + ('kill-ring elems) + ('project-file (renz/sort-by-alpha-length elems)) + (_ (renz/sort-by-history elems)))) + +(defvar no-tabs-modes '(emacs-lisp-mode + lisp-mode + scheme-mode + python-mode + haskell-mode) + "Modes /not/ to indent with tabs.") + +(defun indent-tabs-mode-maybe () + (if (apply #'derived-mode-p no-tabs-modes) + (indent-tabs-mode -1) + (indent-tabs-mode 1))) + +(define-minor-mode truncate-lines-mode + "Buffer-local mode to toggle `truncate-lines'." + :lighter "" + (setq-local truncate-lines truncate-lines-mode)) + +;;; Region or buffer stuff + +(defun call-with-region-or-buffer (fn &rest _r) + "Call function FN with current region or buffer. +Good to use for :around advice." + (if (region-active-p) + (funcall fn (region-beginning) (region-end)) + (funcall fn (point-min) (point-max)))) + +(defun delete-trailing-whitespace-except-current-line () + (save-excursion + (delete-trailing-whitespace (point-min) + (line-beginning-position)) + (delete-trailing-whitespace (line-end-position) + (point-max)))) + +(defun create-missing-directories () + "Automatically create missing directories." + (let ((target-dir (file-name-directory buffer-file-name))) + (unless (file-exists-p target-dir) + (make-directory target-dir :parents)))) + + +(defun vc-remote-off () + "Turn VC off when remote." + (when (file-remote-p (buffer-file-name)) + (setq-local vc-handled-backends nil))) + + diff --git a/early-init.el b/early-init.el deleted file mode 100644 index 80d91db..0000000 --- a/early-init.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; early-init.el -*- lexical-binding: t -*- - -;; Bankruptcy: 9.4 - -;; Debugging -;; (setq debug-on-error t -;; use-package-verbose t) -;; (setq debug-on-message "Selection owner couldn’t convert: TIMESTAMP") - -;; Frames -(setq default-frame-alist '((tool-bar-lines . 0) - (menu-bar-lines . 0) - (vertical-scroll-bars . nil) - (horizontal-scroll-bars . nil)) - frame-inhibit-implied-resize t - frame-resize-pixelwise t - window-resize-pixelwise t - inhibit-x-resources t - indicate-empty-lines nil - indicate-buffer-boundaries nil) - -;; Packages -(require 'package) -(add-to-list 'package-archives - '("melpa" . "https://melpa.org/packages/") :append) -(add-to-list 'package-archives - '("melpa-stable" . "https://stable.melpa.org/packages/") :append) -(setq package-priorities '(("melpa" . 3) - ("nongnu" . 2) - ("gnu" . 1) - ("melpa-stable" . 0)) - package-enable-at-startup nil) - -(package-initialize) -(unless package-archive-contents - (package-refresh-contents)) -(unless (package-installed-p 'use-package) - (package-install 'use-package)) - -(setq use-package-enable-imenu-support t - use-package-hook-name-suffix nil) - -(eval-when-compile - (require 'use-package)) -(setq use-package-compute-statistics debug-on-error) - -(define-advice use-package (:before (name &rest body) select) - "Add NAME to `package-selected-packages'." - (when (memq :ensure body) - (add-to-list 'package-selected-packages name))) - -;; (use-package use-package-vc -;; :load-path "~/src/emacs/use-package-vc.el/" -;; :config -;; (define-advice package-vc-install (:around (orig &rest args) wtf) -;; "Don't freak out about `package-archives' shit." -;; (let ((package-archives nil)) -;; (apply orig args)))) diff --git a/init.el b/init.el index 707125e..4648042 100644 --- a/init.el +++ b/init.el @@ -1,1163 +1,474 @@ -;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*- +;;; Emacs init.el -*- lexical-binding: t; -*- +;; by Case Duckworth +;; Bankruptcy 10: "Annoyance" -;; Author: Case Duckworth , with inspo from many others -;; Homepage: https://git.acdw.net/emacs -;; Config-Requires: ((emacs "29.0")) -;; Bankruptcy: 9.4 +;;; Commentary: -;; This configuration is Free Software. Everyone is permitted to do whatever -;; they want with it, without limitation. This software comes without any -;; warranty whatsoever, but with two pieces of advice: +;; This is my Emacs configuration. There are many like it but this +;; one is mine. ;; -;; - Don't hurt others. -;; - Make good choices. - -;;; Code: - -(load (locate-user-emacs-file "basics")) ; super basic stuff - - -;;; Built-ins - -(use-package emacs ; Misc. config - :config - (setq recenter-positions '(top middle bottom) - initial-major-mode 'lisp-interaction-mode - initial-scratch-message ";; Emacs!\n\n" - ;; (format "%s\n\n" - ;; (mapconcat (lambda (s) (format ";; %s" s)) - ;; (process-lines "fortune" "-s") - ;; "\n")) - eval-expression-print-level nil - eval-expression-print-length nil - x-select-enable-clipboard-manager nil) - ;; TODO: move this ... elsewhere - (setq mode-line-format - '("%e" - mode-line-front-space - ;; (:propertize ("" mode-line-mule-info - ;; mode-line-client - ;; mode-line-modified - ;; mode-line-remote) - ;; display (min-width (5.0))) - ("" mode-line-mule-info +;; For the tenth time! + +;;; Packages + +(require 'package) +(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) +(package-initialize) + +(dolist (pkg `(consult + marginalia + visual-fill-column + adaptive-wrap + geiser + ,(when (executable-find "csi") 'geiser-chicken) + avy + zzz-to-char + hungry-delete + undohist + jinx)) + (when (and pkg (not (package-installed-p pkg))) + (unless (ignore-errors (package-install pkg)) + (package-refresh-contents) + (package-install pkg)))) + +(load (locate-user-emacs-file "definitions")) +(load (locate-user-emacs-file "packages")) +(load (locate-user-emacs-file "private")) + +(setopt custom-file (locate-user-emacs-file "custom.el")) +(load custom-file :noerror) + +;;; General keybinding changes + +(keymap-global-set "M-o" #'other-window-or-switch-buffer) + +(keymap-global-set "M-SPC" #'cycle-spacing@) + +(keymap-global-set "M-u" #'universal-argument) +(keymap-set universal-argument-map "M-u" #'universal-argument-more) + +;;; Theme + +(if (daemonp) + (add-hook 'server-after-make-frame-hook #'first-frame@set-fonts) + (run-with-idle-timer 1 nil #'first-frame@set-fonts)) + +(tool-bar-mode -1) + +(load-theme 'modus-vivendi :no-confirm :no-enable) +(load-theme 'modus-operandi :no-confirm) + +(add-hook 'text-mode-hook #'visual-line-mode) + +;;; Mode line + +(defvar mode-line-position + '("" + (:eval (if line-number-mode "%3l" "")) + (:eval (if column-number-mode + (if column-number-indicator-zero-based + "/%2c" + "/%2C") + "")) + " (" (-3 "%p") ") ")) + +(setopt mode-line-format + '(("%e" mode-line-front-space mode-line-client mode-line-modified - mode-line-remote) - mode-line-frame-identification - mode-line-buffer-identification - " " - mode-line-position - (vc-mode vc-mode) - " " - minions-mode-line-modes - mode-line-misc-info - mode-line-end-spaces)) - (keymap-global-unset "C-\\") - (keymap-global-unset "") - (setf (alist-get "\\*Compile-Log\\*" display-buffer-alist nil nil #'equal) - '(display-buffer-no-window)) - ;; (add-hook 'after-init-hook - ;; (defun global-mode-string@setup () - ;; (defvar jabber-activity-mode-string) - ;; (defvar org-mode-line-string) - ;; (defvar display-time-mode) - ;; (defvar display-time-string) - ;; (setf global-mode-string - ;; '((t jabber-activity-mode-string) - ;; org-mode-line-string - ;; (display-time-mode display-time-string))))) - (keymap-global-set "C-c t" - (define-keymap - :prefix 'toggle-map - "e" #'toggle-debug-on-error - "q" #'toggle-debug-on-quit - "c" #'column-number-mode - "l" #'line-number-mode - "L" #'display-line-numbers-mode))) - -(use-package faces - :config - (add-hook 'server-after-make-frame-hook - (defun first-frame@set-fonts () - (remove-hook 'server-after-make-frame-hook - #'first-frame@set-fonts) - (face-spec-set 'default - `((t :family ,(find-font - "Recursive Mono Casual Static" - "Comic Code" - "DejaVu Sans Mono") - :height 110))) - (face-spec-set 'fixed-pitch - `((t :family ,(find-font - "Recursive Mono Linear Static" - "Comic Code" - "DejaVu Sans Mono") - :height 1.0))) - (face-spec-set 'variable-pitch - `((t :family ,(find-font - "Recursive Sans Casual Static" - "Atkinson Hyperlegible" - "DejaVu Serif") - :height 1.0))) - (face-spec-set 'font-lock-comment-face - `((t :slant italic - :inherit variable-pitch))) - ;; Emojis - (cl-loop with ffl = (font-family-list) - for font in '("Noto Emoji" "Noto Color Emoji" - "Segoe UI Emoji" "Apple Color Emoji" - "FreeSans" "FreeMono" "FreeSerif" - "Unifont" "Symbola") - if (member font ffl) - do (set-fontset-font t 'symbol font)) - ;; International scripts - (cl-loop with ffl = (font-family-list) - for (charset . font) - in '((latin . "Noto Sans") - (han . "Noto Sans CJK SC Regular") - (kana . "Noto Sans CJK JP Regular") - (hangul . "Noto Sans CJK KR Regular") - (cjk-misc . "Noto Sans CJK KR Regular") - (khmer . "Noto Sans Khmer") - (lao . "Noto Sans Lao") - (burmese . "Noto Sans Myanmar") - (thai . "Noto Sans Thai") - (ethiopic . "Noto Sans Ethiopic") - (hebrew . "Noto Sans Hebrew") - (arabic . "Noto Sans Arabic") - (gujarati . "Noto Sans Gujarati") - (devanagari . "Noto Sans Devanagari") - (kannada . "Noto Sans Kannada") - (malayalam . "Noto Sans Malayalam") - (oriya . "Noto Sans Oriya") - (sinhala . "Noto Sans Sinhala") - (tamil . "Noto Sans Tamil") - (telugu . "Noto Sans Telugu") - (tibetan . "Noto Sans Tibetan")) - if (member font ffl) - do (set-fontset-font t charset font)))) - (unless (daemonp) - (run-with-idle-timer 1 nil #'first-frame@set-fonts))) - -(use-package text-mode - :config - (add-hook 'text-mode-hook #'abbrev-mode)) - -(use-package prog-mode - :config - ;;; TABS - (setq tab-width 8 - sh-indentation tab-width - ) - ;;; Hooks - (add-hook 'prog-mode-hook #'auto-fill-mode) - (add-hook 'prog-mode-hook - (defun prog@indent-tabs-maybe () - (indent-tabs-mode - (if (derived-mode-p 'emacs-lisp-mode - 'lisp-mode - 'scheme-mode - 'python-mode - 'haskell-mode) - -1 1)))) - (global-prettify-symbols-mode)) - -(use-package auth-source - :config - (setq auth-sources '(default "secrets:passwords")) - (add-hook 'auth-info-hook #'truncate-lines-local-mode)) - -(use-package fringe - :config - (fringe-mode '(nil . 0))) - -(use-package ispell - :config - (setq ispell-program-name (choose-executable "aspell" "ispell")) - ;; (add-hook 'before-save-hook - ;; #'+ispell-move-buffer-words-to-dir-locals-hook) - (put 'ispell-buffer-session-localwords 'safe-local-variable - '+ispell-safe-local-p)) - -(use-package dired - :bind (("C-x C-j" . dired-jump) - ([remap list-directory] . dired) - :map dired-mode-map - ("C-j" . dired-up-directory) - ("" . dired-up-directory)) - :config - (require 'dired-x) - (setq dired-recursive-copies 'always - dired-recursive-deletes 'always - dired-create-destination-dirs 'always - dired-do-revert-buffer t - dired-hide-details-hide-symlink-targets nil - dired-isearch-filenames 'dwim - delete-by-moving-to-trash t - dired-auto-revert-buffer t - dired-listing-switches "-AlFhv --group-directories-first" - ls-lisp-dirs-first t - dired-ls-F-marks-symlinks t - dired-clean-confirm-killing-deleted-buffers nil - dired-no-confirm '(byte-compile - load chgrp chmod chown - copy move hardlink symlink - shell touch) - dired-dwim-target t) - (add-hook 'dired-mode-hook #'dired-hide-details-mode) - (add-hook 'dired-mode-hook #'hl-line-mode) - (add-hook 'dired-mode-hook #'truncate-lines-local-mode)) - -(use-package dictionary - :custom - (dictionary-server (if (or (executable-find "dictd") - (file-exists-p "/usr/sbin/dictd")) ; debian - "localhost" - "dict.org")) - :bind - (("C-c w d" . dictionary-search)) - :config - (setf (alist-get "\\*Dictionary\\*" display-buffer-alist nil nil #'equal) - '(display-buffer-in-side-window - (window-width . 80) - (side . right)))) - -(use-package calendar - :custom - (diary-file (private/ "diary"))) - -(use-package mouse - :config - (setq context-menu-functions '(context-menu-undo - context-menu-region - context-menu-middle-separator - context-menu-local - context-menu-minor)) - (context-menu-mode)) - -(use-package password-cache - :config - (setq password-cache t - password-cache-expiry 3600)) - -(use-package time - :config - (setq display-time-format " %H:%M" - display-time-interval 60 - display-time-use-mail-icon t - display-time-mail-function - (defun +notmuch-new-mail-p () - (plist-get (cl-find "inbox+unread" - (ignore-errors - (notmuch-hello-query-counts notmuch-saved-searches)) - :key (lambda (l) (plist-get l :name)) - :test #'equal) - :count)) - display-time-default-load-average nil) - (with-eval-after-load 'notmuch - (add-hook 'notmuch-after-tag-hook #'display-time-update)) - ;; (display-time-mode) - ) - -(use-package tab-bar - :config - (setq tab-bar-show t - tab-bar-close-button-show t) - (setopt tab-bar-format - `(tab-bar-format-history - tab-bar-format-tabs - tab-bar-separator - tab-bar-format-add-tab - tab-bar-format-align-right - ,(defun tab-bar-extra-info () - `((global menu-item - ,(format-mode-line - '((jabber-activity-mode jabber-activity-mode-string) - (:eval (when (and (fboundp 'org-clocking-p) - (org-clocking-p)) - (format " %s" - (truncate-string-to-width - org-mode-line-string - 16 - nil - nil - (truncate-string-ellipsis))))) - (:eval (tmr-mode-line)) - (display-time-mode - (:eval (format " %s" (string-trim display-time-string)))) - ("" " "))) - ignore)))) - mode-line-misc-info (cl-delete-if (lambda (x) - (eq (car x) 'global-mode-string)) - mode-line-misc-info)) - (if (daemonp) - (add-hook 'server-after-make-frame-hook - (defun after-frame@tab-bar () - (tab-bar-mode) - (remove-hook 'server-after-make-frame-hook - #'after-frame@tab-bar))) - (run-with-idle-timer 2 nil #'tab-bar-mode))) - -(use-package info - :preface - (defun Info-copy-current-node-name-0 () - "Call `Info-copy-current-node-name' with a 0 prefix arg." - (interactive) - (Info-copy-current-node-name 0)) - :bind (:map Info-mode-map - ("w" . Info-copy-current-node-name-0) - ("c" . Info-copy-current-node-name))) - -(use-package make-mode - :defer t - :config - (add-hook 'makefile-mode-hook - (defun make-mode@setup () - (remove-hook 'write-file-functions - #'makefile-warn-suspicious-lines t) - (remove-hook 'write-file-functions - #'makefile-warn-continuations t)))) - -(use-package eglot - :preface - (defun +eglot-eldoc () - ;; https://www.masteringemacs.org/article/seamlessly-merge-multiple-documentation-sources-eldoc - (setq eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly)) - :hook - ((bash-ts-mode . eglot-ensure) - (scheme-mode . eglot-ensure)) - :config - (add-to-list 'eglot-server-programs - '(scheme-mode . ("chicken-lsp-server"))) - (add-hook 'eglot-managed-mode #'+eglot-eldoc)) - -(use-package eldoc - :config - (setq eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) - (setf (alist-get "^\\*eldoc for" display-buffer-alist nil nil #'equal) - '(display-buffer-at-bottom - (window-height . 4))) - (eldoc-add-command-completions "paredit-")) - -(use-package pulse - :config - (setq pulse-flag nil - pulse-delay 1 - pulse-iterations 1)) - -(use-package flyspell - :hook (org-mode-hook)) - -;; (use-package display-fill-column-indicator -;; :hook (prog-mode-hook)) - -(use-package package - :config - (defun package-update-async-in-progress (&rest _) - (message "Package async update in progress.")) - - (defun package-update-all-async () - "Update packages asyncronously." - (interactive) - (let ((message "Package update (async)...") - (disable-fns '(package-update - package-update-all - package-update-all-async))) - (dolist (fn disable-fns) - (advice-add fn :override #'package-update-async-in-progress)) - (message "%s" message) - (unwind-protect - (async-start - `(lambda () - (package-initialize) - (package-update-all)) - `(lambda (result) - (message "%s %s" ,message result))) - (dolist (fn ',disable-fns) - (advice-remove fn 'package-update-async-in-progress)))))) - -(use-package ielm - ;; https://www.n16f.net/blog/making-ielm-more-comfortable/ - :preface - (defun +ielm-init-history () - (let ((path (etc/ "ielm/history" t))) - (setq-local comint-input-ring-file-name path)) - (setq-local comint-input-ring-size 10000) - (setq-local comint-input-ignoredups t) - (ignore-errors (comint-read-input-ring))) - (defun +ielm-write-history (&rest _args) - (with-file-modes #o600 - (comint-write-input-ring))) - (defun +ielm (&optional buf-name) - "Interactively evaluate Emacs Lisp expressions. -Switches to the buffer named BUF-NAME if provided (`*ielm*' by default), -or creates it if it does not exist. -See `inferior-emacs-lisp-mode' for details." - (interactive) - (let (old-point - (buf-name (or buf-name "*ielm*"))) - (unless (comint-check-proc buf-name) - (with-current-buffer (get-buffer-create buf-name) - (unless (zerop (buffer-size)) (setq old-point (point))) - (inferior-emacs-lisp-mode))) - (pop-to-buffer buf-name) - (when old-point (push-mark old-point)))) - :bind (:map emacs-lisp-mode-map - ("C-c C-z" . +ielm)) - :config - (add-hook 'ielm-mode-hook #'eldoc-mode) - (add-hook 'ielm-mode-hook #'+ielm-init-history) - (advice-add 'ielm-send-input :after #'+ielm-write-history)) - -(use-package elec-pair - :config - (setopt electric-pair-skip-whitespace 'chomp) - (electric-pair-mode)) - -(use-package bookmark - :config - (setopt bookmark-save-flag 1)) - -(use-package sh-script - :config - (sh-electric-here-document-mode -1)) - -(use-package cc-mode - :config - (setopt c-basic-offset 8)) - - -;;; Applications - -(use-package acdw-mail - :load-path "lisp/" - :demand t - :bind (("C-c n" . +notmuch-goto))) - -(use-package acdw-org - :load-path "lisp/" - :config - (global-set-key [f8] #'org-clock-out)) - -(use-package acdw-shell - :load-path "lisp/") - -(use-package acdw-web - :load-path "lisp/") - -(use-package acdw-chat - :load-path "lisp/") - -(use-package _work - :load-path "~/sync/emacs/private/") - - -;;; Locally-developed packages - -(use-package +scratch - :load-path "lisp/" - :config - (setq +scratch-save-dir (sync/ "emacs/scratch.d/" t)) - (add-hook 'kill-buffer-query-functions #'+scratch@immortal) - (add-hook 'kill-emacs-hook #'+scratch-save-on-exit) - (with-current-buffer (get-scratch-buffer-create) - (local-set-key (kbd "C-x C-s") #'+scratch-save)) - ;; Save *scratch* every hour - (run-at-time t (* 60 60) #'+scratch-save "%FT%H%z") - ;; Clean old *scratch* saves every day - (run-at-time t (* 60 60 24) #'+scratch-clean)) - -(use-package pulse-location - :load-path "~/src/pulse-location.el/" - :config - (pulse-location-mode)) - -(use-package emacs ; `modus-themes' isn't a package ... - :config - (setopt modus-themes-mixed-fonts t) - (add-hook 'modus-themes-after-load-theme-hook - (defun +reset-faces () - (dolist (face '(font-lock-regexp-face - font-lock-variable-name-face - font-lock-preprocessor-face - font-lock-remove-face - font-lock-delimiter-face - font-lock-label-face - font-lock-operator-face - font-lock-property-face - font-lock-builtin-face - font-lock-number-face - font-lock-set-face - font-lock-warning-face - font-lock-punctuation-face - font-lock-constant-face - font-lock-type-face - font-lock-function-name-face - font-lock-reference-face - font-lock-negation-char-face - font-lock-misc-punctuation-face - font-lock-escape-face - font-lock-bracket-face)) - (face-spec-set face '((t :foreground unspecified - :background unspecified)))) - (face-spec-set 'font-lock-keyword-face - '((t :foreground unspecified - :background unspecified - :weight bold))) - (face-spec-set 'font-lock-doc-face - '((t :slant italic))))) - (add-hook 'after-init-hook - (defun modus@load () - (+reset-faces) - (pcase (string-trim (shell-command-to-string "darkman get")) - ("light" (load-theme 'modus-operandi t)) - ("dark" (load-theme 'modus-vivendi t)))))) - -(use-package electric-cursor - :load-path "~/src/electric-cursor.el/" - :config - (setq electric-cursor-alist '((overwrite-mode . box) - (t . bar))) - (electric-cursor-mode)) - -(use-package mode-line-bell - :load-path "~/src/mode-line-bell.el/" - :config - (setq mode-line-bell-flash-time 0.25) - (mode-line-bell-mode)) - -(use-package titlecase - :load-path "~/src/titlecase.el/" - :preface - (defun +titlecase-sentence-style-dwim (&optional arg) - "Titlecase a sentence. -With prefix ARG, toggle the value of -`titlecase-downcase-sentences' before sentence-casing." - (interactive "P") - (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) - titlecase-downcase-sentences))) - (titlecase-dwim 'sentence))) - (defun +titlecase-org-headings () - (interactive) - (require 'org) - (save-excursion - (goto-char (point-min)) - ;; See also `org-map-tree'. I'm not using that function because I want to - ;; skip the first headline. A better solution would be to patch - ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). - (let ((level (funcall outline-level)) - (org-special-ctrl-a/e t)) - (while (and (progn (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (titlecase-region (progn (org-beginning-of-line) (point)) - (progn (org-end-of-line) (point))))))) - :config - (with-eval-after-load 'scule - (keymap-set scule-map "M-t" #'titlecase-dwim))) - -(use-package scule - :load-path "~/src/scule.el/" - :bind-keymap ("M-c" . scule-map) - :init - ;; Use M-u for prefix keys - (keymap-global-set "M-u" #'universal-argument) - (keymap-set universal-argument-map "M-u" #'universal-argument-more)) - -(use-package filldent - :load-path "~/src/filldent.el/" - :bind ("M-q" . filldent-dwim) - :config - (setq filldent-fill-modes '(web-mode))) - -(use-package frowny - :load-path "~/src/frowny.el/" - :config - (global-frowny-mode)) - -(use-package keepassxc-shim - :load-path "~/src/keepassxc-shim.el/" - :config - (keepassxc-shim-activate)) - -(use-package hippie-completing-read - :load-path "~/src/hippie-completing-read.el/" - :bind (("M-/" . hippie-completing-read))) - - -;;; External packages - -(use-package async - :ensure t - :config - ;; https://github.com/jwiegley/emacs-async/issues/64 - ;; (setq message-send-mail-function #'async-smtpmail-send-it) - (dired-async-mode) - (async-bytecomp-package-mode)) - -(use-package trashed - :ensure t) - -(use-package form-feed - :ensure t - :hook (prog-mode-hook)) - -;; (use-package clean-kill-ring -;; :vc (:url "https://github.com/NicholasBHubbard/clean-kill-ring.el") -;; :config -;; (setq clean-kill-ring-prevent-duplicates t) -;; (clean-kill-ring-mode)) - -(use-package minions - :ensure t - :config (minions-mode)) - -(use-package visual-fill-column - :preface - (defcustom visual-fill-column-widen-amount 4 - "Amount to widen `fill-column' by in `visual-fill-column-mode'." - :type 'natnum - :group 'visual-fill-column) - (defun visual-fill-column--widen/narrow-handle-arg (cols) - (cond - ((null cols) visual-fill-column-widen-amount) - ((listp cols) (* visual-fill-column-widen-amount - (1+ (/ (car cols) 4)))) - ((eq '- cols) (- visual-fill-column-widen-amount)) - (:else cols))) - (defun visual-fill-column-widen (&optional cols) - "Widen `fill-column' by COLS, and re-display. -If COLS is missing or nil, widen by -`visual-fill-column-widen-amount'. When called with a plain -\\[universal-argument], multiply that amount by 1 + the amount of -\\[universal-argument]s. If called with a numerical prefix -argument, widen by that number of columns." - (interactive "P") - (let ((cols (visual-fill-column--widen/narrow-handle-arg cols))) - (cl-incf fill-column cols) - (visual-fill-column-adjust) - (message "Fill-column: %s" fill-column))) - (defun visual-fill-column-narrow (&optional cols) - "Narrow `fill-column' by COLS, then redisplay. -The prefix argument is as in `visual-fill-column-widen' but negated." - (interactive "P") - (let ((cols (visual-fill-column--widen/narrow-handle-arg cols))) - (cl-decf fill-column cols) - (visual-fill-column-adjust) - (message "Fill-column: %s" fill-column))) - :ensure t - :config - (setopt visual-fill-column-center-text t - visual-fill-column-extra-text-width '(3 . 3) - visual-fill-column-width (+ fill-column 4)) - (keymap-set toggle-map "v" #'visual-fill-column-mode) - (keymap-set visual-fill-column-mode-map "C-x C->" #'visual-fill-column-widen) - (keymap-set visual-fill-column-mode-map "C-x C-<" #'visual-fill-column-narrow) - (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) - (add-hook 'eww-mode-hook #'visual-fill-column-mode) - (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) - -(use-package mlscroll - :ensure t :defer 1 - :after modus-themes - :preface - (define-advice load-theme (:after (&rest _) mlscroll) - (mlscroll-mode -1) - (when (seq-intersection '(modus-vivendi modus-operandi) - custom-enabled-themes) - (modus-themes-with-colors - (setq mlscroll-in-color fg-dim - mlscroll-out-color bg-inactive))) - (run-with-idle-timer 1 nil #'mlscroll-mode)) - :config - (load-theme@mlscroll)) - -(use-package cape - :ensure t - :config - (add-hook 'completion-at-point-functions #'cape-file 90) - (add-hook 'completion-at-point-functions #'cape-dabbrev 91) - (advice-add 'emacs-completion-at-point - :around #'cape-wrap-nonexclusive)) - -(use-package wgrep - :ensure t - :config - (setq wgrep-enable-key (kbd "C-x C-q")) - :bind (:map grep-mode-map - ("C-x C-q" . wgrep-change-to-wgrep-mode))) - -(use-package avy - :ensure t - :bind (("M-j" . avy-goto-char-timer) - :map isearch-mode-map - ("M-j" . avy-isearch)) - :config - (setq avy-background t - avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm"))) - -(use-package zzz-to-char - :ensure t - :bind (("M-z" . zzz-to-char))) - -(use-package anzu - :ensure t - :bind (("M-%" . anzu-query-replace-regexp) - ("C-M-%" . anzu-query-replace))) - -(use-package isearch-mb - :ensure t - :config - (setq isearch-lazy-count t - isearch-regexp-lax-whitespace t - search-whitespace-regexp "\\W+" - search-default-mode t ; Search regexp by default - isearch-wrap-pause 'no) - (define-advice isearch-cancel (:before (&rest _) add-search-to-history) - "Add search string to history when canceling." - (unless (equal "" isearch-string) - (isearch-update-ring isearch-string isearch-regexp))) - (define-advice perform-replace (:around (orig &rest r) no-anykey-exit) - "Don't exit replace for any key that's not in `query-replace-map'." - (save-window-excursion - (cl-letf* ((lookup-key-orig (symbol-function 'lookup-key)) - ((symbol-function 'lookup-key) - (lambda (map key &optional accept-default) - (or (apply lookup-key-orig map key accept-default) - (when (eq map query-replace-map) 'help))))) - (apply orig r)))) - ;; Consult - (autoload 'consult-line "consult" nil t) - (autoload 'consult-isearch-history "consult" nil t) - (add-to-list 'isearch-mb--after-exit #'consult-line) - (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) - (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line) - (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history) - ;; Anzu - (autoload 'anzu-isearch-query-replace "anzu" nil t) - (autoload 'anzu-isearch-query-replace-regexp "anzu" nil t) - (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) - (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace-regexp) - (keymap-set isearch-mb-minibuffer-map - "M-%" #'anzu-isearch-query-replace-regexp) - (keymap-set isearch-mb-minibuffer-map - "C-M-%" #'anzu-isearch-query-replace) - (isearch-mb-mode)) - -;; (use-package paredit -;; :ensure t -;; :hook ( emacs-lisp-mode-hook ielm-mode-hook -;; eval-expression-minibuffer-setup-hook -;; lisp-interaction-mode-hook -;; lisp-mode-hook scheme-mode-hook -;; fennel-mode-hook fennel-repl-mode-hook -;; geiser-mode-hook geiser-repl-mode-hook) -;; :config -;; (keymap-set paredit-mode-map "C-j" -;; (defun +paredit-newline () -;; (interactive) -;; (call-interactively -;; (if (derived-mode-p 'lisp-interaction-mode) -;; #'eval-print-last-sexp #'paredit-newline)))) -;; (keymap-unset paredit-mode-map "RET" t) -;; (keymap-unset paredit-mode-map "M-s" t) -;; (keymap-unset paredit-mode-map "M-r" t) -;; (add-to-list 'paredit-space-for-delimiter-predicates -;; (defun paredit@dont-space-@ (endp delimiter) -;; "Don't add a space after @ in `paredit-mode'." -;; (let ((point (point))) -;; (or endp -;; (seq-every-p -;; (lambda (prefix) -;; (and (> point (length prefix)) -;; (let ((start (- point (length prefix))) -;; (end point)) -;; (not (string= (buffer-substring start end) -;; prefix))))) -;; ;; Add strings to this list to inhibit adding a space -;; ;; after them. -;; '(",@"))))))) - -(use-package hungry-delete - :ensure t - :config - (setq hungry-delete-chars-to-skip " \t" + mode-line-remote " " + mode-line-buffer-identification + (vc-mode vc-mode) + " " + (mode-line-position mode-line-position) + mode-line-modes + mode-line-misc-info + mode-line-end-spaces))) + +;; Remove modes from mode-line +(dolist (minor-mode '(frowny-mode + whitespace-mode + hungry-delete-mode)) + (setf (alist-get minor-mode minor-mode-alist) (list "")) + (add-hook (intern (format "%s-hook" minor-mode)) + (lambda () + (setf (alist-get minor-mode minor-mode-alist) (list ""))))) + +;;; Completion & minibuffer + +(setopt icomplete-in-buffer t + icomplete-tidy-shadowed-file-names t) +(fido-vertical-mode) + +(setopt completion-auto-help (not icomplete-mode) + completion-auto-select 'second-tab + completions-header-format nil + completions-max-height 12 + completions-format 'one-column + completion-styles '(basic partial-completion flex) + completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t + completions-detailed t + enable-recursive-minibuffers t + file-name-shadow-properties '(invisible t intangible t) + minibuffer-eldef-shorten-default t + minibuffer-prompt-properties '( read-only t + cursor-intangible t + face minibuffer-prompt) + window-resize-pixelwise t + frame-resize-pixelwise t) + +(add-hook 'completion-list-mode-hook #'truncate-lines-mode) +(add-hook 'minibuffer-setup-hook #'truncate-lines-mode) + +;; Up/down when completing in the minibuffer +(define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion) +(define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion) + +;; Up/down when competing in a normal buffer +(define-key completion-in-region-mode-map (kbd "C-p") #'minibuffer-previous-completion) +(define-key completion-in-region-mode-map (kbd "C-n") #'minibuffer-next-completion) + +(setopt completions-sort #'renz/sort-multi-category) + +(setopt tab-always-indent 'complete) + +(file-name-shadow-mode) +(minibuffer-electric-default-mode) + +(scroll-bar-mode -1) +(menu-bar-mode -1) + +(add-hook 'prog-mode-hook #'indent-tabs-mode-maybe) + +(setopt electric-pair-skip-whitespace 'chomp) +(electric-pair-mode) + +(setopt sh-basic-offset tab-width) + +(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun) +(keymap-set emacs-lisp-mode-map "C-c C-k" #'eval-buffer) +(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun) +(keymap-set lisp-interaction-mode-map "C-c C-k" #'eval-buffer) + +(advice-add 'indent-region :around #'call-with-region-or-buffer) +(advice-add 'tabify :around #'call-with-region-or-buffer) +(advice-add 'untabify :around #'call-with-region-or-buffer) + +(with-eval-after-load 'scheme + (keymap-unset scheme-mode-map "M-o" t) + ;; Comparse "keywords" --- CHICKEN (http://wiki.call-cc.org/eggref/5/comparse) + (put 'sequence* 'scheme-indent-function 1) + (put 'satisfies 'scheme-indent-function 1) + (add-hook 'scheme-mode-hook #'geiser-mode)) +(with-eval-after-load 'geiser-mode + (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go) + (keymap-unset geiser-mode-map "C-." t)) + +(setopt visual-fill-column-center-text t + visual-fill-column-width (+ fill-column 2)) +(advice-add 'text-scale-adjust :after #'visual-fill-column-adjust) +(add-hook 'visual-line-mode-hook #'visual-fill-column-mode) +(add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode) + +(setopt major-mode + (lambda () ; guess major mode from buffer name + (unless buffer-file-name + (let ((buffer-file-name (buffer-name))) + (set-auto-mode))))) + +;; Dialogs +(unless (boundp 'use-short-answers) + (fset 'yes-or-no-p 'y-or-n-p)) + +(setopt read-answer-short t + use-dialog-box nil + use-file-dialog nil + use-short-answers t) + +(require 'savehist) +(setopt history-length 1024 + history-delete-duplicates t + ;; savehist-file (etc/ "savehist.el") + savehist-save-minibuffer-history t + savehist-autosave-interval 30) +(savehist-mode) + +;; Killing and yanking +(setopt kill-do-not-save-duplicates t + kill-read-only-ok t + ;; XXX: This setting causes an error message the first time it's + ;; called: "Selection owner couldn't convert: TIMESTAMP". I have + ;; absolutely no idea why I get this error, but it's generated in + ;; `x_get_foreign_selection'. I also can't inhibit the message or + ;; do anything else with it, so for now, I'll just live with the + ;; message. + save-interprogram-paste-before-kill t + yank-pop-change-selection t) +(delete-selection-mode) + +;; Notifying the user +(setopt echo-keystrokes 0.01 + ring-bell-function #'ignore) + +;; Point and mark +(setopt set-mark-command-repeat-pop t) + +;; The system +(setopt read-process-output-max (* 10 1024 1024)) + +;; Startup +(setopt inhibit-startup-screen t + initial-buffer-choice t + initial-scratch-message nil) + +(define-advice startup-echo-area-message (:override ()) + (if (get-buffer "*Warnings*") + ";_;" + "^_^")) + +;; Text editing +(setopt fill-column 80 + sentence-end-double-space nil + tab-width 8 + tab-always-indent 'complete) +(global-so-long-mode) + +(setopt show-paren-delay 0.01 + show-paren-style 'parenthesis + show-paren-when-point-in-periphery t + show-paren-when-point-inside-paren t) +(show-paren-mode) + + +;; Encodings +(set-language-environment "UTF-8") +(setopt buffer-file-coding-system 'utf-8-unix + coding-system-for-read 'utf-8-unix + coding-system-for-write 'utf-8-unix + default-process-coding-system '(utf-8-unix . utf-8-unix) + locale-coding-system 'utf-8-unix) +(set-charset-priority 'unicode) +(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))) + + +;; Files +(setopt auto-revert-verbose nil + global-auto-revert-non-file-buffers t + create-lockfiles nil + find-file-visit-truename t + mode-require-final-newline t + view-read-only t + save-silently t) +(global-auto-revert-mode) + +(setopt auto-save-default nil + auto-save-interval 1 + auto-save-no-message t + auto-save-timeout 1 + auto-save-visited-interval 1 + remote-file-name-inhibit-auto-save-visited t) +(add-to-list 'auto-save-file-name-transforms + `(".*" ,(locate-user-emacs-file "auto-save/") t)) +(auto-save-visited-mode) + +(setopt backup-by-copying t + version-control t + kept-new-versions 8 + kept-old-versions 8 + delete-old-versions t) +(setq-default backup-directory-alist + `(("^/dev/shm" . nil) + ("^/tmp" . nil) + (,(getenv "XDG_RUNTIME_DIR") . nil) + ("." . ,(locate-user-emacs-file "backup")))) + +(require 'recentf) +(setopt + recentf-max-menu-items 500 + recentf-max-saved-items nil ; Save the whole list + recentf-auto-cleanup 'mode + recentf-case-fold-search t) +;; (add-to-list 'recentf-exclude etc/) +(add-to-list 'recentf-exclude "-autoloads.el\\'") +(add-hook 'buffer-list-update-hook #'recentf-track-opened-file) +(add-hook 'after-save-hook #'recentf-save-list) +(recentf-mode) + +(require 'saveplace) +(setopt + save-place-forget-unreadable-files (eq system-type + 'gnu/linux)) +(save-place-mode) + +(require 'uniquify) +(setq uniquify-after-kill-buffer-p t + uniquify-buffer-name-style 'forward + uniquify-ignore-buffers-re "^\\*" + uniquify-separator path-separator) + +(setq-local vc-follow-symlinks t + vc-make-backup-files t) + +;; Whitespace +(require 'whitespace) +(setopt whitespace-style + '(face trailing tabs tab-mark)) +(global-whitespace-mode) +(add-hook 'before-save-hook #'delete-trailing-whitespace-except-current-line) + +;; Native compilation +(setopt native-comp-async-report-warnings-errors 'silent + native-comp-deferred-compilation t + native-compile-target-directory + (locate-user-emacs-file "eln")) +(when (boundp 'native-comp-eln-load-path) + (add-to-list 'native-comp-eln-load-path native-compile-target-directory)) +(when (fboundp 'startup-redirect-eln-cache) + (startup-redirect-eln-cache native-compile-target-directory)) + +(global-goto-address-mode) + +;; Winner +(winner-mode) + +;;; Hooks +(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) +(add-hook 'find-file-not-found-functions #'create-missing-directories) +(add-hook 'find-file-hook #'vc-remote-off) +(add-hook 'dired-mode-hook #'hl-line-mode) +(add-hook 'org-agenda-mode-hook #'hl-line-mode) + +;;; Tab bar + +(defun tab-bar-end-space () + `((end menu-item " " ignore))) + +(setopt tab-bar-show t) +(add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) +(add-to-list 'tab-bar-format 'tab-bar-format-global :append) +(add-to-list 'tab-bar-format 'tab-bar-end-space :append) +(tab-bar-mode) + +;;; Org mode + +(keymap-global-set "C-c a" #'org-agenda) +(setopt org-clock-clocked-in-display 'frame-title + org-clock-frame-title-format + '("%b" " - " (t org-mode-line-string))) + +;;; Spelling + +(defun list-of-strings-p (x) + "Is X a list of strings?" + (and x + (listp x) + (cl-every #'stringp x))) + +(put 'ispell-local-words 'safe-local-variable + 'list-of-strings-p) + +(add-hook 'text-mode-hook #'jinx-mode) +(with-eval-after-load 'jinx + (keymap-set jinx-mode-map "M-$" #'jinx-correct) + (keymap-set jinx-mode-map "C-M-$" #'jinx-languages)) + +;;; Copy rich text to the keyboard + +;; Thanks to Oleh Krehel: +;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard +;; So. Emacs can't do this itself because it doesn't support sending clipboard +;; or selection contents as text/html. We have to use xclip instead. +;; (defun org-to-html-to-clipboard (&rest org-export-args) +;; "Export current org buffer to HTML, then copy it to the clipboard. +;; ORG-EXPORT-ARGS are passed to `org-export-to-file'." +;; (let ((f (make-temp-file "org-html-export"))) +;; (apply #'org-export-to-file 'html f org-export-args) +;; (start-process "xclip" " *xclip*" +;; "xclip" "-verbose" "-i" f +;; "-t" "text/html" "-selection" "clipboard") +;; (message "HTML pasted to clipboard."))) + +;; Wayland version.. TODO: make it work for both +(defun org-to-html-to-clipboard (&rest org-export-args) + "Export current org buffer to HTML, then copy it to the clipboard. +ORG-EXPORT-ARGS are passed to `org-export-to-file'." + (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) + (apply #'org-export-to-buffer 'html buf org-export-args) + (with-current-buffer buf + (call-process-region (point-min) (point-max) + "wl-copy" nil nil nil + "-t" "text/html") + (kill-buffer-and-window)) + (message "HTML copied to clipboard."))) + +(defun org-subtree-to-html-to-clipboard () + "Export current subtree to HTML." + (interactive) + (org-to-html-to-clipboard nil :subtree)) + +(undohist-initialize) + +(require 'hungry-delete) +(setopt hungry-delete-chars-to-skip " \t" hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip) hungry-delete-join-reluctantly nil) - (add-to-list 'hungry-delete-except-modes 'eshell-mode) - (add-to-list 'hungry-delete-except-modes 'nim-mode) - (add-to-list 'hungry-delete-except-modes 'python-mode) - ;; Keys - (with-eval-after-load 'paredit - (define-key paredit-mode-map [remap paredit-backward-delete] - (defun paredit/hungry-delete-backward (arg) - (interactive "*p") - (if (looking-back hungry-delete-skip-regexp) - (hungry-delete-backward (or arg 1)) - (paredit-backward-delete arg)))) - (define-key paredit-mode-map [remap paredit-forward-delete] - (defun paredit/hungry-delete-forward (arg) - (interactive "*p") - (if (looking-at hungry-delete-skip-regexp) - (hungry-delete-forward (or arg 1)) - (paredit-forward-delete arg))))) - ;; Mode - (global-hungry-delete-mode)) - -(use-package macrostep - :ensure t - :after elisp-mode - :bind ( :map emacs-lisp-mode-map - ("C-c e" . macrostep-expand) - :map lisp-interaction-mode-map - ("C-c e" . macrostep-expand))) - -(use-package package-lint - :ensure t) - -(use-package sly - :ensure t - :when inferior-lisp-program - :preface - (setq inferior-lisp-program (choose-executable "sbcl")) - (defun +sly-start-or-mrepl () - (interactive) - (if (ignore-errors (sly-connection)) - (sly-mrepl (lambda (buf) - (display-buffer-pop-up-window buf nil))) - (call-interactively #'sly))) - :config - (autoload 'sly-mrepl "sly-mrepl" nil t) - (keymap-set sly-mode-map "C-c C-z" #'+sly-start-or-mrepl) - (setq sly-net-coding-system 'utf-8-unix) - (sly-symbol-completion-mode -1)) - -(use-package pdf-tools - :ensure t - :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode) - :magic ("%PDF" . pdf-view-mode) - :config - (pdf-tools-install)) - -(use-package keychain-environment - :ensure t - :when (executable-find "keychain") - :hook (after-init-hook . keychain-refresh-environment)) - -(use-package web-mode - :ensure t - :mode ("\\.phtml\\'" - "\\.tpl\\.php\\'" - "\\.[agj]sp\\'" - "\\.as[cp]x\\'" - "\\.erb\\'" - "\\.mustache\\'" - "\\.djhtml\\'" - "\\.html?\\'") - :config - (add-hook 'web-mode-hook - (defun web-mode@setup () - (indent-tabs-mode -1)))) - -(use-package nginx-mode - :ensure t - :mode "/nginx/sites-\\(?:available\\|enabled\\)/") - -(use-package markdown-mode - :ensure t - :mode "\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" - :config - (setq markdown-command (choose-executable - '("pandoc" "--from=markdown" "--to=html5") - "markdown")) - (add-hook 'markdown-mode-hook #'visual-fill-column-mode)) - -(use-package pandoc-mode - :ensure t - :hook ((markdown-mode-hook . pandoc-mode) - (pandoc-mode-hook . pandoc-load-default-settings))) - -(use-package edit-indirect - :ensure - :bind (("C-c '" . edit-indirect-region))) - -(use-package transpose-frame - :ensure t - :bind (("C-x 5 t" . transpose-frame) - ("C-x 5 h" . flop-frame) ; horizontal - ("C-x 5 v" . flip-frame) ; vertical - )) - -(use-package magit - :pin melpa-stable - :ensure t - :bind ("C-x g" . magit)) - -(use-package git-modes - :ensure t) - -(use-package eradio - :ensure t - :preface - (defun eradio-toggle|play (&optional arg) - "Run `eradio-toggle', or `eradio-play' with prefix ARG." - (interactive "P") - (if arg (eradio-play) (eradio-toggle))) - :bind (("C-c r p" . eradio-toggle|play) - ("C-c r s" . eradio-stop)) - :config - (setq eradio-player '("mpv" "--no-video" "--no-terminal") - eradio-channels - ;; (name . url) - '(("Nightwave Plaza" . "http://radio.plaza.one/ogg") - ("Radio Paradise - Main Mix" . - "http://stream.radioparadise.com/rp_192m.ogg") - ("Radio Paradise - Mellow Mix" . - "http://stream.radioparadise.com/mellow-96m.ogg") - ("Radio Paradise - Rock Mix" . - "http://stream.radioparadise.com/rock-96m.ogg") - ("Radio Paradise - Global Mix" . - "http://stream.radioparadise.com/global-96m.ogg") - ("KLSU" . "http://130.39.238.143:8010/stream.mp3")) - ;; At some point I should actually ... write this in to this file or - ;; something. But until I decide to quit using radish altogether, this - ;; what I got. - ;; (with-current-buffer (find-file-noselect "~/etc/radish/stations") - ;; (let (chans) - ;; (dolist (line (string-split (buffer-substring-no-properties - ;; (point-min) (point-max)) - ;; "\n") - ;; chans) - ;; (unless (string-match-p "^#" line) - ;; (let* ((ll (string-split line "\t")) - ;; (url (cl-first ll)) - ;; (name (cl-second ll)) - ;; (tags (cl-third ll))) - ;; (when (and name - ;; (string-match-p "[^ \n\t]*://[^ \n\t]*" url)) - ;; (push (cons (format "%s - %s" name tags) url) - ;; chans))))))) - )) - -(use-package wiki-abbrev - :after org ; Don't need abbrevs til I load org. - :load-path "~/src/wiki-abbrev.el/" - :config - (setq wiki-abbrev-file (etc/ "wiki-abbrevs")) - (wiki-abbrev-insinuate)) - -(use-package flyspell-correct - :ensure t - :preface - (defun +flyspell-correct-buffer (&optional prefix) - "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. -With PREFIX, prompt to change the current dictionary." - (interactive "P") - (flyspell-buffer) - (when prefix - (let ((current-prefix-arg nil)) - (call-interactively #'ispell-change-dictionary))) - (flyspell-correct-move (point-min) :forward :rapid)) - :after flyspell - :bind (("" . +flyspell-correct-buffer) - (:map flyspell-mode-map - ("C-;" . flyspell-correct-wrapper))) - :config - (setq flyspell-correct--cr-key ";") - (keymap-unset flyspell-mode-map "C-," t) - (keymap-unset flyspell-mode-map "C-." t)) - -(use-package dired-subtree - :ensure t - :after dired - :bind (:map dired-mode-map - (("TAB" . dired-subtree-cycle) - ("i" . dired-subtree-toggle)))) - -(use-package dired-hide-dotfiles - ;; I could maybe use a more general package for this ... see - ;; https://emacs.grym.io/#orgbbda609 - :ensure t - :bind (:map dired-mode-map - ("." . dired-hide-dotfiles-mode))) - -(use-package dired-git-info - :ensure t - :bind (:map dired-mode-map - (")" . dired-git-info-mode)) - :config - (setq dgi-auto-hide-details-p nil)) - -(use-package expand-region ; needed for embrace anyway - :ensure t - :bind (("C-=" . er/expand-region))) - -(use-package embrace - :ensure t - :preface - (defmacro org-insert-or-embrace (char) - "Define a function to insert CHAR, or `embrace' the region with it." - (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) - (char (cond ((characterp char) char) - ((stringp char) (string-to-char char)) - (t (user-error "Bad format for char: %S" char))))) - `(defun ,fn-name (n) - ,(format "Insert N %ss, or surround the region with them." - (char-to-string char)) - (interactive "p") - (if (region-active-p) - (dotimes (_ n) - (embrace--add-internal (region-beginning) (region-end) ,char) - (forward-char 1)) - (self-insert-command n ,char))))) - (with-eval-after-load 'org - (require 'embrace) - (keymap-set org-mode-map "*" (org-insert-or-embrace "*")) - (keymap-set org-mode-map "/" (org-insert-or-embrace "/")) - (keymap-set org-mode-map "_" (org-insert-or-embrace "_")) - (keymap-set org-mode-map "=" (org-insert-or-embrace "=")) - (keymap-set org-mode-map "~" (org-insert-or-embrace "~")) - (keymap-set org-mode-map "+" (org-insert-or-embrace "+"))) - :bind (("C-'" . embrace-commander)) - :hook ((org-mode-hook . embrace-org-mode-hook) - (ruby-mode-hook . embrace-ruby-mode-hook) - (emacs-lisp-mode-hook . embrace-emacs-lisp-mode-hook) - (latex-mode-hook . embrace-LaTeX-mode-hook))) - -(use-package apheleia - :ensure t - :config - (setq apheleia-hide-log-buffers t) - (setf (alist-get 'shfmt apheleia-formatters) - '("shfmt" "--case-indent")) - (global-set-key (kbd "M-C-\\") - (defun +apheleia-format|indent-buffer () - (interactive) - (if-let ((formatters (apheleia--get-formatters))) - (apheleia-format-buffer - formatters - (lambda () - (with-demoted-errors "Apheleia: %s" - (when buffer-file-name - (let ((apheleia--format-after-save-in-progress t)) - (apheleia--save-buffer-silently))) - (run-hooks 'apheleia-post-format-hook)))) - (indent-region (point-min) (point-max)) - (when buffer-file-name - (save-buffer)))))) - -(use-package php-mode - :ensure t) - -(use-package rec-mode - :ensure t) - - -(use-package geiser - :ensure t - :config - (when (executable-find "guile") - (use-package geiser-guile :ensure t)) - (when (executable-find "chicken") - (use-package geiser-chicken :ensure t)) - (when (or (prog1 (executable-find "chez") - (setopt geiser-chez-binary - (executable-find "chez"))) - (executable-find "petite") - (executable-find "scheme")) - (use-package geiser-chez :ensure t)) - (when (executable-find "gambit") - (use-package geiser-gambit :ensure t)) - (when (executable-find "chibi-scheme") - (use-package geiser-chibi :ensure t)) - (use-package macrostep-geiser - :ensure t - :config - (eval-after-load 'geiser-mode - '(add-hook 'geiser-mode-hook #'macrostep-geiser-setup)) - (eval-after-load 'geiser-repl - '(add-hook 'geiser-repl-mode-hook #'macrostep-geiser-setup))) - (with-eval-after-load 'geiser-mode - (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go) - (keymap-unset geiser-mode-map "C-." t) - (keymap-unset scheme-mode-map "M-o" t))) - -(use-package detached - :when (executable-find "dtach") - :ensure t - :init - (add-hook 'after-init-hook #'detached-init) - :bind (([remap async-shell-command] . detached-shell-command) - ([remap compile] . detached-compile) - ([remap recompile] . detached-compile-recompile)) - :config - (setf detached-terminal-data-command system-type) - (with-eval-after-load 'consult - (global-set-key [remap detached-open-session] #'detached-consult-session))) - -(use-package lin - :ensure t - :config - (setq lin-face 'lin-cyan - lin-mode-hooks - '(dired-mode-hook - ;; bongo-mode-hook - ;; elfeed-search-mode-hook - git-rebase-mode-hook - grep-mode-hook - ibuffer-mode-hook - ilist-mode-hook - ;; ledger-report-mode-hook - log-view-mode-hook - magit-log-mode-hook - ;; mu4e-headers-mode-hook - notmuch-search-mode-hook - notmuch-tree-mode-hook - occur-mode-hook - org-agenda-mode-hook - pdf-outline-buffer-mode-hook - proced-mode-hook - tabulated-list-mode-hook)) - (lin-global-mode)) - -(use-package gcmh - :ensure t - :config - (setq gcmh-idle-delay 'auto - gcmh-verbose nil) - (gcmh-mode)) - -(use-package tmr - :ensure t - :preface - (defun tmr-mode-line () - (if (seq-find (lambda (tmr) - (not (tmr--timer-finishedp tmr))) - tmr--timers) - (propertize "⏲" 'face 'font-lock-warning-face) - "")) - ;; (add-to-list 'global-mode-string - ;; '("" (:eval (tmr-mode-line))) - ;; 'append) - ) - -(use-package dumb-jump - :ensure t - :hook ((xref-backend-functions . dumb-jump-xref-activate))) - -(use-package le-thesaurus - :ensure t - :bind (("C-c w s" . le-thesaurus-get-synonyms) - ("C-c w a" . le-thesaurus-get-antonyms))) - -(use-package devdocs - :ensure t - ;; not sure what to bind anything to yet ... so M-x it is - ) - -(use-package comment-dwim-2 - :ensure t - :bind (("M-;" . comment-dwim-2) - :map org-mode-map - ("M-;" . org-comment-dwim-2))) +(add-to-list 'hungry-delete-except-modes 'eshell-mode) +(add-to-list 'hungry-delete-except-modes 'nim-mode) +(add-to-list 'hungry-delete-except-modes 'python-mode) +(global-hungry-delete-mode) + +(setopt avy-background t + avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) +(keymap-global-set "M-j" #'avy-goto-char-timer) +(keymap-set isearch-mode-map "M-j" #'avy-isearch) +(keymap-global-set "M-z" #'zzz-to-char) + +(marginalia-mode) + +(keymap-global-set "C-x b" #'consult-buffer) +(keymap-global-set "C-x 4 b" #'consult-buffer-other-window) +(keymap-global-set "C-x 5 b" #'consult-buffer-other-frame) +(keymap-global-set "C-x r b" #'consult-bookmark) +(keymap-global-set "M-y" #'consult-yank-pop) +(keymap-global-set "M-g g" #'consult-goto-line) +(keymap-global-set "M-g M-g" #'consult-goto-line) +(keymap-global-set "M-g o" #'consult-outline) +(keymap-global-set "M-g m" #'consult-mark) +(keymap-global-set "M-g i" #'consult-imenu) +(keymap-global-set "M-s d" #'consult-find) +(keymap-global-set "M-s D" #'consult-locate) +(keymap-global-set "M-s g" #'consult-grep) +(keymap-global-set "M-s G" #'consult-git-grep) +(keymap-global-set "M-s r" #'consult-ripgrep) +(keymap-global-set "M-s l" #'consult-line) +(keymap-global-set "M-s k" #'consult-keep-lines) +(keymap-global-set "M-s u" #'consult-focus-lines) + +(keymap-global-set "M-s e" #'consult-isearch-history) +(keymap-set isearch-mode-map "M-e" #'consult-isearch-history) +(keymap-set isearch-mode-map "M-s e" #'consult-isearch-history) +(keymap-set isearch-mode-map "M-s l" #'consult-line) + +(keymap-set minibuffer-local-map "M-n" #'consult-history) +(keymap-set minibuffer-local-map "M-p" #'consult-history) + +(setopt completion-in-region-function #'consult-completion-in-region + xref-show-xrefs-function #'consult-xref + xref-show-definitions-function #'consult-xref) + +(setopt initial-scratch-message ";;; Emacs!\n\n") + +(keymap-global-set "C-x C-b" #'ibuffer) +(add-hook 'ibuffer-hook #'hl-line-mode) diff --git a/lisp/+completions.el b/lisp/+completions.el deleted file mode 100644 index 9baaaf8..0000000 --- a/lisp/+completions.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; +completions.el --- Better default completions -*- lexical-binding: t; -*- - -;; From https://robbmann.io/posts/emacs-29-completions/ - -(defun minibuffer@bindings () - (unless vertico-mode - ;; Up/down when completing in the minibuffer - (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion) - (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion) - - ;; Up/down when competing in a normal buffer - (define-key completion-in-region-mode-map (kbd "C-p") - #'minibuffer-previous-completion) - (define-key completion-in-region-mode-map (kbd "C-n") - #'minibuffer-next-completion))) - -(add-hook 'vertico-mode-hook #'minibuffer@bindings) - -(defun renz/sort-by-alpha-length (elems) - "Sort ELEMS first alphabetically, then by length." - (sort elems (lambda (c1 c2) - (or (string-version-lessp c1 c2) - (< (length c1) (length c2)))))) - -(defun renz/sort-by-history (elems) - "Sort ELEMS by minibuffer history. -Use `mct-sort-sort-by-alpha-length' if no history is available." - (if-let ((hist (and (not (eq minibuffer-history-variable t)) - (symbol-value minibuffer-history-variable)))) - (minibuffer--sort-by-position hist elems) - (renz/sort-by-alpha-length elems))) - -(defun renz/completion-category () - "Return completion category." - (when-let ((window (active-minibuffer-window))) - (with-current-buffer (window-buffer window) - (completion-metadata-get - (completion-metadata (buffer-substring-no-properties - (minibuffer-prompt-end) - (max (minibuffer-prompt-end) (point))) - minibuffer-completion-table - minibuffer-completion-predicate) - 'category)))) - -(defun renz/sort-multi-category (elems) - "Sort ELEMS per completion category." - (pcase (renz/completion-category) - ('nil elems) ; no sorting - ('kill-ring elems) - ('project-file (renz/sort-by-alpha-length elems)) - (_ (renz/sort-by-history elems)))) - -(setq completion-auto-help 'always - completion-auto-select 'second-tab - completions-max-height 10 - completions-header-format nil - completion-show-help nil - completions-format 'one-column - save-completions-file-name (etc/ "completions") - completions-sort #'renz/sort-multi-category) - -(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode) - -(provide '+completions) -;;; +completions.el ends here diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 0e0b9b1..0000000 --- a/lisp/+link-hint.el +++ /dev/null @@ -1,175 +0,0 @@ -;;; +link-hint.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'link-hint) - -(defgroup +link-hint nil - "Extra customizations for `link-hint'." - :group 'link-hint) - -(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url - gnus-w3m-url - markdown-link - mu4e-attachment - mu4e-url - notmuch-hello - nov-link - org-link - shr-url - text-url - w3m-link - w3m-message-link) - "Link types to define `:open-secondary' for.") - -(defvar +link-hint-map (make-sparse-keymap) - "Keymap for `link-hint' functionality.") - -(cl-defmacro +link-hint-define-keyword (keyword handler docstring - &optional (types 'link-hint-types) - &rest rest - &key multiple &allow-other-keys) - "Set up a `link-hint' KEYWORD, with optional TYPES. -If TYPES is not present, use `link-hint-types'. - -KEYWORD defines the link-hint type. It will be used to create a -function for opening links of the form \"link-hint-openKEYWORD\". - -HANDLER is the function to open a link with. - -DOCSTRING is the macro's documentation. - -Keyword arguments are passed to `link-hint-define-type' prefixed -with the KEYWORD." - (declare (indent 2) - (doc-string 3)) - (let ((types (symbol-value types)) - (func-sym (intern (format "+link-hint-open%s" keyword))) - (mult-sym (intern (format "%s-multiple" keyword))) - (expr)) - ;; Define the type - (push `(dolist (type ',types) - (link-hint-define-type type - ,keyword ,handler - ,@(mapcar (lambda (el) - (if (eq el :multiple) - mult-sym - el)) - rest))) - expr) - ;; Define an opener - (push `(defun ,func-sym () - ,(format "%s\n\nDefined by `+link-hint-define'." docstring) - (interactive) - (avy-with link-hint-open-link - (link-hint--one ,keyword))) - expr) - ;; Handle `:multiple' - (when multiple - (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () - ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-multiple-links - (link-hint--multiple ,keyword))) - expr) - (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () - ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." - func-sym) - (avy-with link-hint-open-all-links - (link-hint--all ,keyword))) - expr)) - ;; Return the built expression - `(progn ,@(nreverse expr)))) - -(+link-hint-define-keyword :secondary browse-url-secondary-browser-function - "Open a link in the secondary browser." - +link-hint-open-secondary-types - :multiple t) - -(progn - (dolist - (type - '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link)) - (link-hint-define-type type :download - (function +browse-url-download) - :download-multiple t)) - (defun +link-hint-open:download nil "Download a link to `eww-download-directory'. - -Defined by `+link-hint-define'." - (interactive) - (avy-with link-hint-open-link - (link-hint--one :download))) - (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'. - -Defined by `+link-hint-define'." - (avy-with link-hint-open-multiple-links - (link-hint--multiple :download))) - (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'. - -Defined by `+link-hint-define'." - (avy-with link-hint-open-all-links - (link-hint--all :download)))) - -;; (defun +link-hint-open-secondary-setup (&optional types) -;; "Define the `:open-secondary' link-hint type for TYPES. -;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." -;; (dolist (type (or types +link-hint-open-secondary-types)) -;; (link-hint-define-type type -;; :open-secondary browse-url-secondary-browser-function -;; :open-secondary-multiple t))) - -;; (defun +link-hint-open-secondary () -;; "Open a link in the secondary browser." -;; (interactive) -;; (avy-with link-hint-open-link -;; (link-hint--one :open-secondary))) - -(+link-hint-define-keyword :chrome #'browse-url-chrome - "Open a link with `browse-url-chrome'." - +link-hint-open-secondary-types - :multiple t) - -;; (defun +link-hint-open-chrome-setup (&optional types) -;; "Define the `:open-chrome' link-hint type for TYPES. -;; If TYPES is nil, define it for `+link-hint-open-secondary-types'." -;; (dolist (type (or types +link-hint-open-secondary-types)) -;; (link-hint-define-type type -;; :open-chrome #'browse-url-chrome -;; :open-chrome-multiple t))) - -;; (defun +link-hint-open-chrome () -;; "Open a link with chrome." -;; (interactive) -;; (avy-with link-hint-open-link -;; (link-hint--one :open-chrome))) - -(defun +link-hint-open-link (prefix) - "Open a link. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (let ((current-prefix-arg nil)) - (avy-with link-hint-open-link - (link-hint--one (if prefix :open-secondary :open))))) - -;; test: https://www.acdw.net - -(defun +link-hint-open-multiple-links (prefix) - "Open multiple links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-multiple-links - (link-hint--one (if prefix :open-secondary :open)))) - -(defun +link-hint-open-all-links (prefix) - "Open all visible links. -Without a PREFIX, open using `browse-url-browser-function'; with -a PREFIX, use `browse-url-secondary-browser-function'." - (interactive "P") - (avy-with link-hint-open-all-links - (link-hint--one (if prefix :open-secondary :open)))) - -(provide '+link-hint) -;;; +link-hint.el ends here diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; +org-capture.el -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll -;; take a minute. Just let the compiler know that this variable exists. -(defvar org-capture-templates nil) - -;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 -(defun +org-capture-template-define (description &rest args) - "Define a capture template. -Creates a list and adds it to `org-capture-templates', if it's -not already there. ARGS is a plist, which in addition to the -additional options `org-capture-templates' accepts (which see), -takes the following and puts them in the right spot: `:keys', -`:description', `:type', `:target', and `:template'." - (declare (indent 1)) - (let* ((keys (plist-get args :keys)) - (type (plist-get args :type)) - (target (plist-get args :target)) - (template (plist-get args :template)) - (template-value (append - (list description) - (when (or type target template) - (list (or type 'entry) target template)) - (cl-loop for i from 0 below (length args) by 2 - unless (member (nth i args) - '(:keys :description :type - :target :template)) - append (list (nth i args) - (plist-get args (nth i - args))))))) - ;; The only way I know how to do this properly (add a value to the end of - ;; the list, if it exists; otherwise update it) is to do this weird if-setf - ;; dance. - (if (seq-find (lambda (el) (equal (car el) keys)) - org-capture-templates) - (setf (alist-get keys org-capture-templates nil nil #'equal) - template-value) - (setf org-capture-templates - (append org-capture-templates - (list (cons keys template-value))))) - ;; Regardless of what we do, return the new value of - ;; `org-capture-templates'. - org-capture-templates)) - -(provide '+org-capture) -;;; +org-capture.el diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 5d749c6..0000000 --- a/lisp/+scratch.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*- - -;; Copyright (C) 2023 Case Duckworth - -;; Author: Case Duckworth -;; Keywords: convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d") - "Where to save scratch files." - :type 'file) - -(defcustom +scratch-max-age (* 60 60 24 365) - "Maximum age of a saved scratch buffer. Default: one year." - :type 'natnum) - -(defun +scratch@immortal () - "Don't kill *scratch* with `kill-buffer'." - (if (equal (buffer-name) "*scratch*") - (progn (bury-buffer) nil) - t)) - -(defun +scratch-save (time-format) - "Save *scratch* buffer to `+scratch-save-dir'. -TIME-FORMAT will be used to name the buffer." - (interactive (list "%FT%H%z")) - (with-current-buffer (get-scratch-buffer-create) - (let ((buffer-file-name (expand-file-name (format "%s.%s" - (format-time-string - time-format) - (pcase major-mode - ('org-mode "org") - ('emacs-lisp-mode "el") - (_ "txt"))) - +scratch-save-dir))) - (unless (string-equal (buffer-substring (point-min) (point-max)) - initial-scratch-message) - (save-buffer 0))))) - -(defun +scratch-save-on-exit () - (+scratch-save "%FT%T%z") - (+scratch-clean)) - -(defun +scratch-clean () - "Clean up saved scratches. -Scratch files older than `+scratch-max-age' will be removed." - (dolist (f (directory-files +scratch-save-dir)) - (when (and (not (equal f ".")) - (not (equal f "..")) - (> (time-convert (file-attribute-modification-time - (file-attributes f)) - 'integer) - +scratch-max-age)) - (delete-file (expand-file-name f +scratch-save-dir) :trash)))) - -(provide '+scratch) -;;; +scratch.el ends here diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el deleted file mode 100644 index 9294ffe..0000000 --- a/lisp/acdw-chat.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*- - -;;; Code: - -(defcustom jabber-prefix-width 10 - "Width of jabber prompts and other prefixes." - :type 'number - :group 'jabber) - -(defun jabber-ui-setup () - "Setup the `jabber' user interface." - (visual-fill-column-mode) - (electric-pair-local-mode -1) - (auto-fill-mode -1) - (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20) - visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width) - . 1))) - -(defcustom jabber-biboumi-server "localhost" - "Biboumi server for `jabber-biboumi-muc-connect'." - :type 'string - :group 'jabber) - -(defcustom jabber-biboumi-irc-servers '("irc.libera.chat") - "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'." - :type '(repeat string) - :group 'jabber) - -(defcustom jabber-biboumi-default-nick "" - "Default nick for biboumi rooms." - :type 'string - :group 'jabber) - -(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server) - "Connect to a biboumi (IRC gateway) server MUC. -CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to -`jabber-muc-join'. If BIBOUMI-SERVER isn't given, -`jabber-biboumi-server' is used." - (interactive (list (concat "#" (string-remove-prefix "#" (read-string - "Channel: "))) - (completing-read "Server: " jabber-biboumi-irc-servers) - (read-string (format "Nick [%s]: " - jabber-biboumi-default-nick) - nil nil jabber-biboumi-default-nick))) - (let ((room (format "%s%%%s@%s" channel server (or biboumi-server - jabber-biboumi-server)))) - (if (assoc room *jabber-active-groupchats*) - (switch-to-buffer (jabber-muc-get-buffer room)) - (jabber-muc-join (jabber-read-account) - room - nick - 'popup)))) - -(defalias 'jabber-irc-join 'jabber-biboumi-muc-connect) - -(defun jabber-connect-all* (&optional arg) - "Run `jabber-connect-all'. -With a prefix ARG, disconnect first." - (interactive "p") - (when arg - (jabber-disconnect)) - (jabber-connect-all)) - -(defun jabber-group-yank-join-url () - "Yank a url for joining the focused group." - (interactive) - (let ((s (format "xmpp:%s?join" jabber-group))) - (kill-new s) - (message s))) - - -;;; Packages - -(use-package jabber - :load-path "~/src/jabber.el/" - :custom-face - (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign - :foreground unspecified - :weight normal))) - (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local - :foreground unspecified - :weight bold))) - (jabber-chat-prompt-local ((t :inherit minibuffer-prompt - :foreground unspecified - :weight normal - :slant italic))) - (jabber-chat-prompt-foreign ((t :inherit warning - :foreground unspecified - :weight normal))) - (jabber-chat-prompt-system ((t :inherit font-lock-doc-face - :foreground unspecified))) - (jabber-rare-time-face ((t :inherit font-lock-comment-face - :foreground unspecified - :underline nil))) - :bind-keymap ("C-c j" . jabber-global-keymap) - :bind (("C-c C-SPC" . jabber-activity-switch-to)) - :config - (setq jabber-account-list '(("acdw@hmm.st")) - jabber-auto-reconnect t - jabber-biboumi-server "irc.hmm.st" - jabber-biboumi-irc-servers '("irc.libera.chat" - "irc.oftc.net" - "irc.tilde.chat" - "tilde.town" - "m455.casa" - "irc.twitch.tv") - jabber-biboumi-default-nick "acdw" - jabber-last-read-marker (make-string fill-column ?.) - jabber-muc-decorate-presence-patterns - '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) - ("Mode #.*" . jabber-muc-presence-dim) - ("." . jabber-muc-presence-dim)) - jabber-activity-make-strings #'jabber-activity-make-strings-shorten - jabber-rare-time-format " - - - - - - %H:%M %F" - jabber-chat-header-line-format - '("" (jabber-chat-buffer-show-avatar - (:eval - (let ((buddy (jabber-jid-symbol jabber-chatting-with))) - (jabber-propertize " " - 'display (get buddy 'avatar))))) - (:eval (replace-regexp-in-string "%" "%%" - (jabber-jid-displayname - jabber-chatting-with))) - "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with))) - (propertize - (or - (cdr (assoc (get buddy 'show) jabber-presence-strings)) - (get buddy 'show)) - 'face - (or (cdr (assoc (get buddy 'show) jabber-presence-faces)) - 'jabber-roster-user-online)))) - "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status))) - "\t" jabber-events-message - "\t" jabber-chatstates-message) - jabber-muc-header-line-format - '(" " (:eval (replace-regexp-in-string "%" "%%" - (jabber-jid-displayname - jabber-group))) - " / " jabber-muc-topic) - ;; buffer name formats - jabber-chat-buffer-format "*xmpp* %n" - jabber-browse-buffer-format "*xmpp-browse* %n" - jabber-groupchat-buffer-format "*xmpp-muc* %n" - jabber-muc-private-buffer-format "*xmpp-muc-private* %n" - ;; "prompt" (speaker) formats - jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width) - jabber-muc-private-foreign-prompt-format "\n%g/%n . ") - ;; jabber muc nick coloring - ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus) - ;; (setopt jabber-muc-nick-value 1.0 - ;; jabber-muc-nick-saturation 1.0 - ;; jabber-muc-colorize-local t - ;; jabber-muc-colorize-foreign t) - ;; When changing the above values, make sure to - ;; (setq jabber-muc-participant-colors nil) - (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup) - (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix - ;; For each binding in `jabber-global-keymap', also bind the non-control - ;; character (lowercase) - (map-keymap (lambda (key command) - (define-key jabber-global-keymap (vector (+ key #x60)) command)) - jabber-global-keymap) - (define-key jabber-global-keymap "c" #'jabber-connect-all*) - (require 'jabber-httpupload nil t) - (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) - (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) - (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) - (add-hook 'jabber-alert-muc-hooks - (defun jabber@highlight-acdw (&optional _ _ buf _ _) - (when buf - (with-current-buffer buf - (let ((regexp (rx word-boundary - "acdw" ; maybe get from the config? - word-boundary))) - (hi-lock-unface-buffer regexp) - (highlight-regexp regexp 'jabber-chat-prompt-local)))))) - (add-hook 'jabber-chat-mode-hook - (defun jabber-chat@leave-when-kill () - (add-hook 'kill-buffer-hook - (defun @jabber-leave@kill () - (ignore-errors - (apply #'jabber-muc-leave (jabber-muc-argument-list)))) - nil :local))) - (when (fboundp 'jabber-chat-update-focus) - (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)) - (with-eval-after-load 'consult - (defvar jabber-chat-buffer-source - `( :name "Jabber" - :hidden nil - :narrow ?j - :category buffer - :state ,#'consult--buffer-state - :items ,(lambda () - (mapcar #'buffer-name - (seq-filter (lambda (buf) - (with-current-buffer buf - (eq major-mode 'jabber-chat-mode))) - (buffer-list)))))) - (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) - (consult-customize - consult-buffer :preview-key "M-."))) - -(provide 'acdw-chat) -;;; acdw-chat.el ends here diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el deleted file mode 100644 index bf20c9b..0000000 --- a/lisp/acdw-mail.el +++ /dev/null @@ -1,439 +0,0 @@ -;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'message) - -;;; Variables - -(defcustom +message-send-dispatch-rules nil - "Alist to set variables based on the current from address." - :group 'message - :type '(alist :key-type (string :tag "From address") - :value-type (alist :tag "Rules" - :key-type (symbol :tag "Variable") - :value-type (sexp :tag "Value")))) - -(defcustom +notmuch-spam-tags '("+spam -inbox -unread") - "List of tag changes to apply when marking a thread as spam." - :group 'notmuch - :type '(repeat string)) - -;;; Functions - -(defun +message-send-set-variables () - "Set variables for `message-send' depending on the From: header. -Useful in `message-send-hook'." - (unless +message-send-dispatch-rules - (load notmuch-init-file) - (or +message-send-dispatch-rules - (error "`+message-send-dispatch-rules' isn't set!"))) - (let ((from (message-fetch-field "from"))) - (cl-loop for (var . val) in (cl-loop for (address . bindings) - in +message-send-dispatch-rules - if (string-match-p address from) - return bindings) - do (set (make-local-variable var) val)))) - -;; Thanks to Alex Schroeder! -;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically -(defun +message-check-for-signature-change (&rest ignore) - "Check for a change in the To: or Cc: fields" - (when (and (message--in-tocc-p) - (not (buffer-narrowed-p))) - (save-excursion - (goto-char (point-max)) - (let ((end (point))) - (when (re-search-backward message-signature-separator nil t) - (delete-region (1- (match-beginning 0)) end))) - (message-insert-signature)))) - -(defun +message-signature-setup () - (make-local-variable 'after-change-functions) - (push '+message-check-for-signature-change after-change-functions)) - -(defun +notmuch-field-match-p (field regexp) - "Return whether message FIELD matches REGEXP." - (string-match-p regexp (or (message-fetch-field field) ""))) - -(defun +notmuch-query-concat (&rest queries) - "Concatenate `notmuch' QUERIES with AND." - (mapconcat #'identity queries " AND ")) - -;;;###autoload -(defun +notmuch-goto (&optional prefix) - "Perform a saved `notmuch' search. -Without a PREFIX argument, perform the first search in -`notmuch-saved-searches'. With a single PREFIX argument -(\\[universal-argument]), prompt the user as to which saved -search to perform. With two PREFIX arguments, prompt the user -for a free-form search. With any other PREFIX argument, open -`notmuch-hello'." - (interactive "P") - (pcase prefix - ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) - ('(4) (notmuch-search - (plist-get (cl-find (completing-read "Saved search: " - (mapcar (lambda (elt) - (plist-get elt :name)) - notmuch-saved-searches)) - notmuch-saved-searches - :key (lambda (elt) (plist-get elt :name)) - :test #'equal) - :query))) - ('(16) (notmuch-search)) - (_ (notmuch-hello)))) - -(defun +notmuch-search-mark-spam (&optional ham start end) - "Mark the current thread or region as spam. -That is, add the tags in `+notmuch-spam-tags' to the message. -With an optional HAM argument (interactively, -\\[universal-argument]), mark the message as not-spam, or ham, by -reversing the tag changes." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham) - start end)) - (when (eq start end) - (notmuch-search-next-thread))) - -(defun +notmuch-tree-mark-spam (&optional ham _ _) - "Mark the current message as spam. -That is, add the tags in `+notmuch-spam-tags' to the message. -With an optional HAM argument (interactively, -\\[universal-argument]), mark the message as not-spam, or ham, by -reversing the tag changes." - (interactive (cons current-prefix-arg (notmuch-interactive-region))) - (when +notmuch-spam-tags - (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham))) - (notmuch-tree-next-matching-message)) - -(defun +notmuch-define-saved-search (name key search-type &rest queries) - "Wrapper to ease `notmuch-saved-searches' defining. -NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in -`notmuch-saved-searches', which see. QUERIES are all concatenated together with -AND. If QUERIES is prepended with more keyword arguments, those are added to -the saved search as well." - (declare (indent 3)) - (let (extra-keywords) - (while (keywordp (car queries)) - (push (cadr queries) extra-keywords) - (push (car queries) extra-keywords) - (setf queries (cddr queries))) - (add-to-list 'notmuch-saved-searches - (append (list :name name - :key key - :search-type search-type - :query (apply #'+notmuch-query-concat queries)) - (reverse extra-keywords)) - :append - (lambda (a b) - (equal (plist-get a :name) - (plist-get b :name)))))) - -(defun notmuch-async-poll () - "Run `notmuch-poll' in an async process." - (interactive) - (if (require 'async nil t) - (progn - (message "Polling mail (async)...") - (async-start - (lambda () - (ignore-errors - (push "~/usr/share/emacs/site-lisp/" load-path) - (require 'notmuch-lib) - (notmuch-poll))) - (lambda (_) - (message "Polling mail (async)...done")))) - (user-error "Feature `async' not found!") - (notmuch-poll))) - -;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/ - -(defun email-says-attach-p () - "Return t if email suggests there could be an attachment." - (save-excursion - (goto-char (point-min)) - (re-search-forward "attach" nil t))) - -(defun email-has-attachment-p () - "Return t if the currently open email has an attachment." - (save-excursion - (goto-char (point-min)) - (re-search-forward "<#part" nil t))) - -(defun email-pre-send-check-attachment () - (when (and (email-says-attach-p) - (not (email-has-attachment-p))) - (unless - (y-or-n-p - "Your email suggests an attachment, but none was found. Send anyway?") - (error "No attachment. Aborting send.")))) - -;;; Process ical attachments -;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/ - -(defun ical2org (&optional replace output-buffer) - "Run ical2org on contents of this buffer. -If REPLACE (interactive prefix argument), replace contents of the -buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to -minibuffer." - (interactive "P") - (shell-command-on-region (point-min) (point-max) - "ical2org.awk" - output-buffer - replace - "*ical2org errors*" - 'display-errors)) - -(defun ical2org-capture () - "Run `ical2org' on this buffer, then `org-capture' the result. -Leaves current buffer as-was afterwards." - (interactive) - (let ((buf (current-buffer)) - (ics (buffer-string))) - (ical2org 'replace buf) - (mark-whole-buffer) - (org-capture nil "a") - (mark-whole-buffer) - (delete-region (point-min) (point-max)) - (insert ics))) - -(defun notmuch-ics-refile (filename header) - "Refile the current ICS buffer to FILENAME, under HEADER." - (org-refile nil nil - (list header - filename - nil - (with-current-buffer (find-file-noselect filename) - (org-find-exact-headline-in-buffer header)))) - (notmuch-ics-kill)) - -(defun notmuch-ics-kill () - "Kill the current ICS buffer and delete its file." - (let ((kill-buffer-hook nil) - (kill-buffer-query-functions nil) - (file (buffer-file-name))) - (set-buffer-modified-p nil) - (kill-buffer-and-window) - (delete-file file))) - -(defun notmuch-ics-cancel () - "Cancel saving ICS buffer." - (interactive) - (notmuch-ics-kill)) - -(define-derived-mode notmuch-save-ics-mode org-mode - "Org-mode but with a different keymap.") - -(defun notmuch-save-ics () - ;; XXX: this is hacky as hell - "Save a .ics file in a message." - (interactive) - (with-current-notmuch-show-message - (notmuch-foreach-mime-part - (lambda (part) - (when (and (listp part) - (or (equal "application/ics" (caadr part)) - ;; (equal "text/calendar" (caadr part)) - )) - (let* ((filename (format "/dev/shm/notmuch-%s.ics" - (time-convert (current-time) 'integer)))) - (mm-save-part-to-file part filename) - (message "Converting ICS to org ...") - (with-current-buffer (find-file-other-window filename) - (ical2org 'replace (current-buffer)) - (deactivate-mark) - (let ((org-mode-hook nil)) - (notmuch-save-ics-mode)) - (local-set-key (kbd "C-c C-c") - (lambda () (interactive) - (notmuch-ics-refile (sync/ "org/diary.org") "Appointments"))) - (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel) - (setq-local header-line-format - (concat "ICAL buffer. " - "Finish: `C-c C-c'. " - "Abort: `C-c C-k'.")))))) - (mm-dissect-buffer t t)))) - -(add-hook 'notmuch-show-hook #'notmuch-save-ics) - - -;;; Fixes - -;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net - -(defun notmuch--indent-rigidly (start end count) - (cond - ((zerop count) t) - ((< count 0) (indent-rigidly start end count)) - (t - (save-excursion - (let ((startpt (progn (goto-char start) (line-beginning-position))) - (endpt (progn (goto-char end) (line-end-position))) - (spaces (spaces-string count))) - (goto-char startpt) - (while - (progn - (insert spaces) - (cl-incf endpt count) - (and (zerop (forward-line 1)) (bolp) - (<= (point) endpt))))))))) - -(with-eval-after-load 'notmuch-show - ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way - ;; of doing this - (defun notmuch-show-lazy-part (part-args button) - ;; Insert the lazy part after the button for the part. We would just - ;; move to the start of the new line following the button and insert - ;; the part but that point might have text properties (eg colours - ;; from a message header etc) so instead we start from the last - ;; character of the button by adding a newline and finish by - ;; removing the extra newline from the end of the part. - (save-excursion - (goto-char (button-end button)) - (insert "\n") - (let* ((inhibit-read-only t) - ;; We need to use markers for the start and end of the part - ;; because the part insertion functions do not guarantee - ;; to leave point at the end of the part. - (part-beg (copy-marker (point) nil)) - (part-end (copy-marker (point) t)) - ;; We have to save the depth as we can't find the depth - ;; when narrowed. - (depth (notmuch-show-get-depth))) - (save-restriction - (narrow-to-region part-beg part-end) - (delete-region part-beg part-end) - (apply #'notmuch-show-insert-bodypart-internal part-args) - (notmuch--indent-rigidly part-beg - part-end - (* notmuch-show-indent-messages-width depth))) - (goto-char part-end) - (delete-char 1) - (notmuch-show-record-part-information (cadr part-args) - (button-start button) - part-end) - ;; Create the overlay. If the lazy-part turned out to be empty/not - ;; showable this returns nil. - (notmuch-show-create-part-overlays button part-beg part-end)))) - ) - - -;;; Packages - -(use-package bbdb - :ensure t - :config - (setopt bbdb-complete-mail-allow-cycling t - bbdb-file (private/ "bbdb")) - (add-hook 'custom-allowed-after-load-hook - (defun bbdb@after-custom () - (require 'bbdb) - (require 'bbdb-message) - (bbdb-initialize 'message)))) - -(use-package bbdb-vcard - :ensure t - :after bbdb) - -(use-package notmuch - :when (executable-find "notmuch") - :load-path "~/usr/share/emacs/site-lisp/" - :defer 30 - :commands (notmuch-mua-new-mail - notmuch-search - notmuch-hello) - :preface (defdir notmuch/ (sync/ "emacs/notmuch/") - "Notmuch configuration directory." - :makedir) - :config - ;; Options - (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t) - notmuch-address-save-filename (notmuch/ "addresses" t) - notmuch-address-use-company (featurep 'company) - notmuch-search-oldest-first nil - notmuch-archive-tags '("-inbox" "-unread") - notmuch-draft-tags '("+draft" "-inbox" "-unread") - +notmuch-spam-tags '("+spam") - mail-user-agent 'notmuch-user-agent - message-mail-user-agent t - notmuch-show-indent-content nil - message-kill-buffer-on-exit t - message-auto-save-directory nil - message-signature "Case Duckworth\nhttps://www.acdw.net" - send-mail-function #'sendmail-send-it - mail-specify-envelope-from t - message-sendmail-envelope-from 'header - message-envelope-from 'header - notmuch-saved-searches nil - notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option - ) - (load notmuch-init-file) - ;; Key bindings - (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam) - (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread) - (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread) - (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam) - ;; Saved searches - (+notmuch-define-saved-search "inbox+unread" "m" 'tree - "tag:inbox" "tag:unread" "NOT tag:Spam") - (+notmuch-define-saved-search "inbox" "i" 'tree - "tag:inbox" "NOT tag:Spam") - (+notmuch-define-saved-search "lists+unread" "l" 'tree - "tag:/List/" "tag:unread") - (+notmuch-define-saved-search "lists" "L" 'tree - "tag:/List/") - (+notmuch-define-saved-search "unread" "u" 'tree - "tag:unread" "NOT tag:Spam") - (+notmuch-define-saved-search "flagged" "f" 'tree - "tag:flagged") - (+notmuch-define-saved-search "sent" "t" 'tree - "tag:sent") - (+notmuch-define-saved-search "drafts" "d" 'tree - "tag:draft") - (+notmuch-define-saved-search "all mail" "a" 'tree "*") - ;; Hooks and advice - (add-hook 'message-send-hook #'+message-send-set-variables) - (add-hook 'message-send-hook #'email-pre-send-check-attachment) - (add-hook 'message-setup-hook #'+message-signature-setup) - (autoload 'visual-fill-column-mode "visual-fill-column" nil t) - (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode) - (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode) - - (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async) - (call-process "swaymail")) - - (define-advice notmuch-address-selection-function - (:override (prompt collection _) no-initial-input) - "Call `completing-read' with `notmuch-address-history'. -This version doesn't add any initial-input." - (completing-read prompt collection nil nil nil 'notmuch-address-history)) - - (add-to-list 'notmuch-message-headers "List-Post" :append #'equal) - (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) - "Make `notmuch-mua-new-reply' list-aware." - (let ((ml (notmuch-show-get-header :List-Post))) - (apply orig r) - (require 'message) - (when ml - (with-buffer-modified-unmodified - (message-remove-header "To") - (message-add-header - (format "To: %s" (replace-regexp-in-string "" "\\1" - ml))) - (message-goto-body))))) - - (define-advice notmuch-tag (:filter-args (args) trim) - "Trim whitespace from ends of tags." - (list (car args) (mapcar #'string-trim (cadr args)))) - ;; Load init file - (load notmuch-init-file :noerror)) - -(use-package notmuch-tags - :load-path "~/src/emacs/notmuch-tags.el/" - :commands (notmuch-tags-mode)) - -(provide 'acdw-mail) -;;; acdw-mail.el ends here diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el deleted file mode 100644 index 2ec3339..0000000 --- a/lisp/acdw-org.el +++ /dev/null @@ -1,548 +0,0 @@ -;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) - -;;; Variables - -(defcustom org-agenda-skip-file-regexp nil - "Files matching this regexp are removed from `org-agenda-files'." - :group 'org-agenda - :type 'regexp) - -;;; Functions - - -;;; DWIM - -;; https://github.com/alphapapa/unpackaged.el, -;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ -(defun +org-return-dwim (&optional arg) - "A helpful replacement for `org-return'. -When called interactively with \\[universal-argument], call `org-return' -itself. Other values of ARG will call `newline' with that ARG." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (dolist (func (ensure-list auto-fill-function)) - (funcall func))) - (cl-letf* ((el (org-element-at-point)) - ((symbol-function 'el-child-of) - (lambda (&rest types) - (org-element-lineage el types t)))) - (cond ; Figure out what we're going to do - (arg ; Handle prefix ARG - (pcase arg - ('(4) (org-return t nil t)) - (_ (newline arg t)))) - ((and org-return-follows-link ; Open a link - (el-child-of 'link)) - (org-open-at-point-global)) - ((org-at-heading-p) ; Open a paragraph after a heading - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) ; Entry is only a heading - (= heading-start (org-entry-beginning-position))) - (end-of-line) - (newline 2)) - (:else ; Entry is more than a heading - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; Open a paragraph - (forward-line) - (newline) - (forward-line -1)) - (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) - (newline)) - (forward-line -1))))) - ((org-at-item-checkbox-p) ; Insert a new checkbox item - (end-of-line) - (org-insert-todo-heading nil)) - ((org-in-item-p) ; Insert a new list item - (let* ((context (org-element-context el)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; This (regular) list item is empty - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; This (definition) list item is empty - (looking-at " *::"))) - (item-child-p (el-child-of 'item))) - (cond ((and itemp emptyp) - ;; This test has to be here even though it's the same as the - ;; :else clause, because an item that's empty will also satisfy - ;; the next clause. - (delete-region (line-beginning-position) (line-end-position)) - (newline)) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-end-of-item) - (org-insert-item)) - (:else - (delete-region (line-beginning-position) (line-end-position)) - (newline))))) - ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks - (org-inlinetask-in-task-p)) - (org-return)) - ((org-at-table-p) ; Insert a new table row - (cond ((save-excursion ; Empty row: end the table - (beginning-of-line) - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (eq (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (:else ; Non-empty row - (org-return)))) - (:else ; Something else - (org-return))))) - -(defun +org-table-copy-down|+org-return-dwim (&optional n) - "Call `org-table-copy-down' or `+org-return' depending on context." - (interactive "P") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down (or n 1)) - (+org-return-dwim n))) - - -;;; Buffer view cleanup - -(defun +org-hide-drawers-except-point () - "Hide all drawers except for the one point is in." - ;; Most of this bit is taken from `org-fold--hide-drawers'. - (let ((pt (point)) - (begin (point-min)) - (end (point-max))) - (save-excursion - (goto-char begin) - (while (and (< (point) end) - (re-search-forward org-drawer-regexp end t)) - (if (org-fold-folded-p nil 'drawer) - (goto-char (org-fold-next-folding-state-change 'drawer nil end)) - (let* ((drawer (org-element-at-point)) - (type (org-element-type drawer)) - (el-begin (org-element-property :begin drawer)) - (el-end (org-element-property :end drawer))) - (when (memq type '(drawer property-drawer)) - (org-fold-hide-drawer-toggle - (if (< el-begin pt el-end) 'off 'on) - nil drawer) - (goto-char el-end)))))))) - - -;;; Copy rich text to the keyboard - -;; Thanks to Oleh Krehel: -;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard -;; So. Emacs can't do this itself because it doesn't support sending clipboard -;; or selection contents as text/html. We have to use xclip instead. -;; (defun org-to-html-to-clipboard (&rest org-export-args) -;; "Export current org buffer to HTML, then copy it to the clipboard. -;; ORG-EXPORT-ARGS are passed to `org-export-to-file'." -;; (let ((f (make-temp-file "org-html-export"))) -;; (apply #'org-export-to-file 'html f org-export-args) -;; (start-process "xclip" " *xclip*" -;; "xclip" "-verbose" "-i" f -;; "-t" "text/html" "-selection" "clipboard") -;; (message "HTML pasted to clipboard."))) - -;; Wayland version.. TODO: make it work for both -(defun org-to-html-to-clipboard (&rest org-export-args) - "Export current org buffer to HTML, then copy it to the clipboard. -ORG-EXPORT-ARGS are passed to `org-export-to-file'." - (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) - (apply #'org-export-to-buffer 'html buf org-export-args) - (with-current-buffer buf - (call-process-region (point-min) (point-max) - "wl-copy" nil nil nil - "-t" "text/html") - (kill-buffer-and-window)) - (message "HTML copied to clipboard."))) - -(defun org-subtree-to-html-to-clipboard () - "Export current subtree to HTML." - (interactive) - (org-to-html-to-clipboard nil :subtree)) - - -;;; Prompting - -(defun +org-prompt-for-property (property &optional clipboardp insert list) - "Prompt for PROPERTY and return a properly-formatted string. -Pre-fill the input with clipboard contents if they match CLIPBOARDP. If -CLIPBOARDP is nil or missing, don't pre-fill. - -If INSERT is non-nil, insert the property into the property -drawer of the current org tree. - -If LIST is non-nil, return the result as a list instead of a string." - (let* ((kill (current-kill 0)) - (value (read-string (concat property ": ") - (when (and clipboardp - (or (eq clipboardp t) - (funcall clipboardp kill))) - kill)))) - (when insert - (org-set-property property value)) - (if list - (list property value) - (format ":%s: %s" property value)))) - -(defun +org-prompt-tags (&optional prompt global) - (let* ((buffer (org-capture-get :buffer)) - (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (org-last-tags-completion-table - (org-global-tags-completion-table - (if global (org-agenda-files) (list file)))) - (org-add-colon-after-tag-completion t) - (ins (mapconcat - #'identity - (let ((crm-separator "[ \t]*:[ \t]*")) - (completing-read-multiple - (or prompt "Tags: ") - org-last-tags-completion-table nil nil nil - 'org-tags-history)) - ":"))) - (when (org-string-nw-p ins) - (prog1 (concat - (unless (eq (char-before) ?:) ":") - ins - (unless (eq (char-after) ?:) ":")) - (when (org-at-heading-p) (org-align-tags)))))) - - -;;; Navigating headings - -(defun org-next-visible-heading-unfolding (arg) - (interactive "p") - (when (let ((pt (org-next-visible-heading arg))) - (and (buffer-narrowed-p) - (or (= (point) (point-min)) - (and pt - (= pt (point-max)))))) - (widen) - (org-next-visible-heading arg) - (org-narrow-to-subtree))) - -(defun org-previous-visible-heading-unfolding (arg) - (interactive "p") - (org-next-visible-heading-unfolding (- arg))) - -(defun org-up-heading-unfolding (arg) - (interactive "p") - (when (let ((pt (outline-up-heading arg))) - (and (buffer-narrowed-p) - (= (point) (point-min)))) - (widen) - (org-up-heading-unfolding arg) - (org-narrow-to-subtree))) - - -;;; Misc. - -(defun org-clock-in-or-out (prefix) - "If clocked in, clock out. Otherwise, clock in." - (interactive "P") - (if (org-clocking-p) - (org-clock-out prefix) - (org-clock-in prefix))) - - -;;; Faces - -(defface org-bold '((t (:weight bold))) - "Bold face in `org-mode' documents.") - -(defface org-italic '((t (:slant italic))) - "Italic face in `org-mode' documents.") - -(defface org-underline '((t (:underline t))) - "Underline face in `org-mode' documents.") - -(defface org-strikethrough '((t (:strike-through t))) - "Strike-through face for `org-mode' documents.") - - -;;; Packages - -(use-package org - :defer t - :custom-face - (org-level-1 ((t :inherit fixed-pitch - :weight bold - :slant italic - :height 1.0))) - (org-level-2 ((t :inherit fixed-pitch - :weight bold - :slant italic - :height 1.0))) - (org-level-3 ((t :inherit fixed-pitch - :weight bold - :height 1.0))) - (org-level-4 ((t :inherit org-level-3))) - (org-level-5 ((t :inherit org-level-4))) - (org-level-6 ((t :inherit org-level-5))) - (org-level-7 ((t :inherit org-level-6))) - (org-level-8 ((t :inherit org-level-7))) - (org-drawer ((t :inherit fixed-pitch))) - (org-property-value ((t :inherit fixed-pitch))) - (org-special-keyword ((t :inherit fixed-pitch))) - (org-indent ((t :inherit fixed-pitch))) - (org-table ((t :inherit fixed-pitch))) - :config - ;; Options - (setopt org-adapt-indentation nil - org-auto-align-tags t - org-archive-mark-done t - org-fold-catch-invisible-edits 'show-and-error - org-clock-clocked-in-display 'mode-line - org-clock-string-limit 0 - org-clock-persist nil - org-confirm-babel-evaluate nil - org-cycle-separator-lines 0 - org-deadline-warning-days 0 - org-directory (sync/ "org/" t) - org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…") - org-emphasis-alist - '(("*" org-bold) - ("/" org-italic) - ("_" org-underline) - ("=" org-verbatim) - ("~" org-code) - ("+" org-strikethrough)) - org-fontify-done-headline t - org-fontify-quote-and-verse-blocks t - org-fontify-whole-heading-line t - org-hide-emphasis-markers t - org-html-coding-system 'utf-8-unix - org-image-actual-width (list (* (window-font-width) - (- fill-column 8))) - org-imenu-depth 3 - org-indent-indentation-per-level 0 - org-indent-mode-turns-on-hiding-stars nil - org-insert-heading-respect-content t - org-list-demote-modify-bullet '(("-" . "+") - ("+" . "-")) - org-log-done 'time - org-log-into-drawer t - org-num-skip-commented t - org-num-skip-unnumbered t - org-num-skip-footnotes t - org-outline-path-complete-in-steps nil - org-pretty-entities t - org-pretty-entities-include-sub-superscripts nil - org-refile-targets '((nil . (:maxlevel . 2)) - (org-agenda-files . (:maxlevel . 1))) - org-refile-use-outline-path 'file - org-special-ctrl-a/e t - org-special-ctrl-k t - org-src-fontify-natively t - org-src-tab-acts-natively t - org-src-window-setup 'current-window - org-startup-truncated nil - org-startup-with-inline-images t - org-tags-column 0 ;(- 0 fill-column -3) - org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" - "|" "DONE(d!)" "ASSIGNED(a@/!)") - (sequence "|" "CANCELED(k@)") - (sequence "MEETING(m)")) - org-use-fast-todo-selection 'auto - org-use-speed-commands t - org-element-use-cache nil) - ;; Keys - (keymap-set org-mode-map "C-M-k" #'kill-paragraph) - (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs) - (keymap-set org-mode-map "RET" #'+org-return-dwim) - (keymap-set org-mode-map "S-" #'+org-table-copy-down|+org-return-dwim) - (keymap-unset org-mode-map "C-'" t) - (keymap-unset org-mode-map "C-," t) - (keymap-set org-mode-map "C-c C-n" #'org-next-visible-heading-unfolding) - (keymap-set org-mode-map "C-c C-p" #'org-previous-visible-heading-unfolding) - (keymap-set org-mode-map "C-c C-u" #'org-up-heading-unfolding) - ;; Hooks - (add-hook 'org-mode-hook - (defun org-mode@setup () - (when (require 'visual-fill-column nil t) - (setq-local visual-fill-column-extra-text-width '(2 . 2)) - (visual-fill-column-mode)) - (variable-pitch-mode) - (turn-off-auto-fill) - (org-indent-mode) - (abbrev-mode) - (add-hook 'before-save-hook - (defun before-save@org-mode@before-save () - (org-align-tags 'all) - (+org-hide-drawers-except-point) - ) - nil :local))) - ;; Extra font-lock keywords - (font-lock-add-keywords - 'org-mode - `(;; List markers => org-indent - (,(concat - "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)" - "\\(?:[ ]+\\|$\\)\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]" - "[ ]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)" - "\\(?:[ ]+\\|$\\)\\)?") - 0 'org-indent)))) - -(use-package org-clock - :bind (:map org-mode-map - ("" . org-clock-in-or-out)) - :config - (setopt org-clock-clocked-in-display 'mode-line - ;; global-mode-string - ;; '((t jabber-activity-mode-string) - ;; (:eval (when (org-clocking-p) org-mode-line-string)) - ;; (display-time-mode display-time-string)) - ) - ;; (add-hook 'org-clock-in-hook (defun org-clock@remove-from-global-mode-string () - ;; (setq global-mode-string - ;; (delq 'org-mode-line-string global-mode-string)))) - ) - -(use-package org-agenda - :bind (("C-c a" . org-agenda)) - :config - (setopt org-agenda-skip-deadline-if-done t - org-agenda-skip-scheduled-if-done t - org-agenda-span 10 - org-agenda-block-separator ?─ - org-agenda-time-grid '((daily today require-timed) - (800 1000 1200 1400 1600 1800 2000) - " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") - org-agenda-current-time-string "← now ───────────────" - org-agenda-include-diary nil ; I use the org-diary features - org-agenda-todo-ignore-deadlines 'near - org-agenda-todo-ignore-scheduled 'future - org-agenda-include-deadlines t - org-deadline-warning-days 0 - org-agenda-show-future-repeats 'next - org-agenda-window-setup 'current-window - org-agenda-skip-file-regexp "sync-conflict" - org-agenda-inhibit-startup t - org-agenda-sticky t - org-agenda-follow-indirect t - org-stuck-projects '("TODO=\"WAIT\"" - ("TODO" "NEXT") - nil - "") - org-agenda-custom-commands - `(("c" "Click Here Digital To-do" - ((agenda "" ((org-agenda-overriding-header "Tasks") - (org-agenda-span 'fortnight) - (org-agenda-start-day "+0") - (org-agenda-skip-function - '(org-agenda-skip-subtree-if 'todo - '("WAIT" "MCKENZIE" "RACHEL"))))) - (stuck "" ((org-agenda-overriding-header "Waiting")))) - ((org-agenda-files ',(list (progn (require 'chd) - (chd/ "inbox-chd.org")) - (sync/ "org/diary.org"))))))) - ;; Speedup agenda generation - ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html - ;; https://orgmode.org/worg/agenda-optimization.html - (setopt org-agenda-dim-blocked-tasks nil - org-agenda-inhibit-startup t - org-agenda-use-tag-inheritance nil - org-agenda-ignore-properties '(effort appt stats category)) - ;; Hooks and advice - (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode) - (add-hook 'org-agenda-mode-hook #'hl-line-mode) - (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) - ;; (add-hook 'org-agenda-after-show-hook #'+org-hide-drawers-except-point) - (define-advice org-agenda-files (:filter-return (files) skip-regexp) - "Filter some files from `org-agenda'." - (when org-agenda-skip-file-regexp - (setq files - (cl-remove-if (lambda (file) - (string-match-p org-agenda-skip-file-regexp - file)) - files))) - files) - (define-advice org-agenda (:around (orig &rest r) inhibit-hooks) - (dlet ((org-mode-hook nil)) - (apply orig r))) - (define-advice org-agenda-skip (:around (orig &rest r) fix-looking-at) - (dlet ((comment-start-skip "^\\s-*#\\(?: \\|$\\)")) - (apply orig r))) - ;; (advice-remove 'org-agenda 'org-agenda@inhibit-hooks) - (define-advice org-agenda-switch-to (:after (&rest _) do-hooks) - (run-hooks 'org-mode-hook)) - (progress@around org-agenda-list "Building agenda") - (with-eval-after-load 'org-agenda - (add-to-list 'org-agenda-files (sync/ "org/diary.org")))) - -(use-package org-capture - :bind (("C-c c" . org-capture))) - -(use-package ol ; org-link - :after org - :preface - (defmacro +org-link-define-type (type args &rest body) - "Define an org link TYPE. -A function named `+org-link-TYPE-open' will be created, with ARGS -as its arguments and BODY as its body. BODY can be blank, in -which case the user will be messaged (This is a good do-nothing -effect for exporting link types)." - (declare (indent 2) - (doc-string 3) - (debug (sexp sexp def-body))) - (let ((fn (intern (format "+org-link-%s-open" type))) - (body (or body `((message ,(format "%S: %%S" type) - ,(car args))))) - (type-string (format "%S" type))) - `(prog1 - (defun ,fn ,args ,@body) - (org-link-set-parameters ,type-string :follow #',fn)))) - :config - (+org-link-define-type sms (number _)) - (+org-link-define-type tel (number _))) - -(use-package ox ; org-export - :after org - :config - (require 'ox-md) - (setopt org-export-coding-system 'utf-8-unix - org-export-headline-levels 8 - org-export-with-drawers nil - org-export-with-section-numbers nil - org-export-with-smart-quotes t - org-export-with-sub-superscripts t - org-export-with-toc nil)) - -(use-package org-word-count - :load-path "~/src/org-word-count.el/" - :hook org-mode-hook) - -(use-package org-modern - :ensure t - :custom-face - (org-modern-label ((t :inherit fixed-pitch - :height 1.0))) - :hook (org-mode-hook) - :config - (setopt org-modern-star nil - org-modern-list '((43 . "◦") - (45 . "•") - (42 . "‣")) - org-hide-leading-stars nil - org-modern-hide-stars nil - org-tags-column 0 - org-modern-keyword nil - org-modern-table nil)) - -(use-package org-taskwise - :after org - :load-path "~/src/org-taskwise.el/") - -(provide 'acdw-org) -;;; acdw-org.el ends here diff --git a/lisp/acdw-shell.el b/lisp/acdw-shell.el deleted file mode 100644 index ce63bdc..0000000 --- a/lisp/acdw-shell.el +++ /dev/null @@ -1,141 +0,0 @@ -;;; acdw-shell.el ---Shell config -*- lexical-binding: t; -*- - -;;; Code: - -(defvar eshell-buffer-format "*eshell:%s*" - "Format for eshell buffer names.") - -(defun eshell-rename-pwd () - (rename-buffer (format eshell-buffer-format default-directory) t)) - -(defun eshell-last-dir () - (goto-char (point-max)) - (insert "cd -") - (eshell-send-input)) - -(defun eshellp (buffer-or-name) - (with-current-buffer buffer-or-name - (derived-mode-p 'eshell-mode))) - -(defun +eshell (&optional new) - (interactive "P") - (let ((dir default-directory) - (bname (format eshell-buffer-format default-directory)) - (display-comint-buffer-action 'pop-to-buffer)) - (if-let ((buf (and (not new) - (or (get-buffer bname) - (seq-find #'eshellp - (reverse (buffer-list))))))) - (pop-to-buffer buf) - (eshell new)) - (eshell-rename-pwd) - (unless (equal default-directory dir) - (eshell/cd dir) - (eshell-send-input) - (goto-char (point-max))))) - -(defun +eshell-quit (&optional choose) - (interactive "P") - (if choose - (let* ((bufs (mapcar #'buffer-name - (seq-filter #'eshellp - (buffer-list)))) - (buf (get-buffer - (completing-read "Eshell: " - bufs nil t nil nil (car bufs))))) - (quit-window) - (pop-to-buffer buf)) - (quit-window))) - -(defun acdw/eshell-prompt () - "My custom eshell prompt." - (concat (if (= 0 eshell-last-command-status) - "^_^ " - ";_; ") - (abbreviate-file-name (eshell/pwd)) - (if (= (user-uid) 0) " # " " $ "))) - - -;;; Packages - -(use-package eshell - :init - (add-hook 'eshell-post-command-hook #'eshell-rename-pwd) - (setopt eshell-modules-list - '(eshell-alias - eshell-basic - eshell-cmpl - eshell-dirs - eshell-elecslash - eshell-hist - eshell-ls - eshell-prompt - eshell-smart - eshell-extpipe - eshell-glob - eshell-hist - eshell-ls - eshell-pred - eshell-prompt - eshell-script - eshell-term - eshell-unix)) - :commands eshell - :bind (("C-z" . +eshell) - :map eshell-mode-map - ("C-z" . +eshell-quit) - ("C-o" . eshell-last-dir)) - :config - (require 'esh-module) - (require 'em-smart) - (require 'em-tramp) - (setq eshell-destroy-buffer-when-process-dies t - eshell-error-if-no-glob t - eshell-hist-ignoredups t - eshell-kill-on-exit t - eshell-prefer-lisp-functions t - eshell-prefer-lisp-variables t - eshell-scroll-to-bottom-on-input 'this - eshell-banner-message "" - eshell-hist-ignoredups 'erase - eshell-history-size 512 - eshell-input-filter (lambda (input) - (or (eshell-input-filter-default input) - (eshell-input-filter-initial-space input))) - eshell-prompt-function #'acdw/eshell-prompt) - (add-hook 'eshell-mode-hook - (defun eshell-setup () - (hungry-delete-mode -1) - (setq-local outline-regexp eshell-prompt-regexp - page-delimiter eshell-prompt-regexp - imenu-generic-expression - '(("Prompt" " $ \\(.*\\)" 1)) - truncate-lines t) - (setenv "PAGER" "cat")))) - -(use-package eat - :ensure t - :hook (eshell-load-hook . eat-eshell-mode)) - -(use-package exec-path-from-shell - :when (eq system-type 'gnu/linux) - :ensure t - :config - (add-to-list 'exec-path-from-shell-variables "SSH_AUTH_SOCK") - (add-to-list 'exec-path-from-shell-variables "SSH_AGENT_PID") - (add-to-list 'exec-path-from-shell-variables "GPG_AGENT_INFO") - (add-to-list 'exec-path-from-shell-variables "LANG") - (add-to-list 'exec-path-from-shell-variables "LC_CTYPE") - (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_HOME") - (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_DIRS") - (add-to-list 'exec-path-from-shell-variables "XDG_DATA_HOME") - (add-to-list 'exec-path-from-shell-variables "XDG_DATA_DIRS") - (add-to-list 'exec-path-from-shell-variables "XDG_CACHE_HOME") - (exec-path-from-shell-initialize)) - -(use-package eshell-bookmark - :ensure t - :hook (eshell-mode-hook . eshell-bookmark-setup)) - -(provide 'acdw-shell) -;;; acdw-shell.el ends here diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null @@ -1,374 +0,0 @@ -;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) - -(defcustom +browse-url-other-safe-browser-functions nil - "Other safe browser functions." - :type '(repeat function)) - -(defun +browse-url-browser-function-safe-p (f) - "Return t if F is a safe browser function." - (memq f (append +browse-url-other-safe-browser-functions - (mapcar (lambda (i) - (plist-get (cdr i) :value)) - (seq-filter (lambda (i) - (eq (car i) 'function-item)) - (cdr (get 'browse-url-browser-function - 'custom-type))))))) - -;;; URL matcher generators - -(defun +browse-url-matches (&rest regexps) - "Return a lambda that will determine if a url matches REGEXPS. -Each regexp will be tested in turn. The first one that matches -is returned by the lambda. - -This is a good function to use in key positions in `browse-url-handlers'." - `(lambda (url &optional new-window) - (cl-loop for regexp in ',regexps - if (string-match-p regexp url) - return regexp))) - -;;; External URL handlers - -(cl-defmacro +browse-url-make-external-viewer-handler - (viewer - &key - args - (prompt "URL: ") - (program (executable-find (format "%s" viewer))) - (name (intern (format "+browse-url-with-%s" viewer))) - doc - (var (intern (format "%s-args" name))) - vardoc - (custom-group '+browse-url) - (fallback '(function browse-url-generic))) - "Create a `browse-url' handler function calling PROGRAM on the URL. -This macro also creates a `customize' setting in CUSTOM-GROUP for -PROGRAM's command-line arguments. ARGS specifies the -default arguments for this user option. - -PROGRAM defaults to the result of calling `executable-find' on VIEWER. - -PROMPT is shown to the user in the function's `interactive' spec, as an argument -to `browse-url-interactive-arg'. - -The resulting function is named NAME, which defaults to -`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults -to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of -the function and variable respectively; otherwise a basic default doc-string is -used. - -If FALLBACK is non-nil (the default is `browse-url-generic'), the -generated function will call FALLBACK if unable to start PROGRAM -for some reason." - (declare (indent 1)) - `(progn - (defcustom ,var ,args - ,(or vardoc (format "Arguments to pass to %s in `%s'." - viewer name)) - :type '(repeat :tag "Command-line argument" string) - :group ',custom-group) - (defun ,name (url &optional new-window) - ,(or doc (format "Open URL in %s." viewer)) - (interactive (browse-url-interactive-arg ,prompt)) - (let* ((url (browse-url-encode-url url)) - (process-environment (browse-url-process-environment))) - (message ,(format "Opening %%s in %s..." viewer) url) - (unless (ignore-errors (apply #'start-process - (format "%s %s" ',viewer url) - nil - ,program - (append ,var (list url)))) - ,@(cond - (fallback `((funcall ,fallback url new-window))) - (:else `((message "Can't find viewer: %s" ,viewer) - nil)))))))) - -;; Some default handlers - -(+browse-url-make-external-viewer-handler mpv - :args '("--cache-pause-wait=15" - "--cache-pause-initial=yes") - :prompt "Video URL: ") - -(+browse-url-make-external-viewer-handler miv - :program (executable-find "miv") - :prompt "Image URL: ") - -;;; External domains -;; Some domains just don't open well in `eww'. The following function and user -;; option define an easy way to automatically open those. - -(defcustom +browse-url-external-domains nil - "Domains to open in `browse-url-secondary-browser-function'. -This is just a list of strings. They'll be regexp-escaped and -passed to `+browse-url-external-url-p', which is a good function -to put in `browse-url-handlers'. - -If an item in this list is a list itself, it should contain one string, a valid -regexp that will not be regexp-quoted when matching against a url." - :type '(repeat (choice - (list :tag "Regexp" regexp) - (string :tag "Literal string")))) - -(with-eval-after-load 'custom-allowed - (add-to-list 'custom-allowed-variables '+browse-url-external-domains)) - -(defun +browse-url-external-url-p (url) - "Return t if URL is a member of `+browse-url-external-domains'. -This function only tests URL's domain." - (let ((host (url-host (url-generic-parse-url url)))) - (cl-loop for domain in +browse-url-external-domains - if (string-match-p (if (stringp domain) - (regexp-quote domain) - (car domain)) - host) - return t))) - -(defun +browse-url-external-domain-add (domain &optional regexp?) - "Add DOMAIN to `+browse-url-external-domains'. -If REGEXP? is non-nil, it will note that the domain is a regexp. -This function will also save `custom-file' with the updated value." - (interactive (pcase current-prefix-arg - (`nil - (list (read-from-minibuffer "Domain: ") - nil)) - (`(4) - (list (read-from-minibuffer "Domain regex: ") - t)) - (_ - (list (read-from-minibuffer "Domain: ") - (y-or-n-p "Regex? "))))) - (let ((new (funcall (if regexp? #'list #'identity) - domain))) - (custom-set-variables - `(+browse-url-external-domains - ',(add-to-list '+browse-url-external-domains new))) - (with-current-buffer (find-file-noselect custom-file) - (custom-save-variables)) - (message "%s added to `+browse-url-external-domains'." - domain))) - -;;; Downloading - -(defcustom +browse-url-download-open t - "Whether to open downloaded files after downloading." - :type 'boolean) - -(defun +browse-url-download (url &rest _) - "Download URL to `eww-download-directory'." - (interactive "sDownload URL: ") - (let ((dir eww-download-directory)) - (when (functionp dir) (setq dir (funcall dir))) - (make-directory dir :parents) - (url-retrieve url - (lambda (s u d) - (let ((file (+browse-url-download-callback s u d))) - (when +browse-url-download-open - (browse-url-xdg-open file)))) - (list url dir)))) - -(defun +browse-url-download-callback (status url dir) - ;; A slight change to `eww-download-callback' that returns the downloaded - ;; filename. - (unless (plist-get status :error) - (let* ((obj (url-generic-parse-url url)) - (path (directory-file-name (car (url-path-and-query obj)))) - (file (eww-make-unique-file-name - (eww-decode-url-file-name (file-name-nondirectory path)) - dir))) - (goto-char (point-min)) - (re-search-forward "\r?\n\r?\n") - (let ((coding-system-for-write 'no-conversion)) - (write-region (point) (point-max) file)) - (message "Saved %s" file) - file))) - -;;; Unfucking the internet - -(defun eww-archiveis-url (url) - "Run URL through archive.is and browse the result." - (interactive (list (plist-get eww-data :url))) - (letrec ((nonce (lambda () - (unwind-protect (eww-readable) - (remove-hook 'eww-after-render-hook nonce))))) - (add-hook 'eww-after-render-hook nonce) - (eww (format "https://archive.is/submit/?url=%s" url)))) - - -;;; Packages - -(use-package eww - :preface - (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)) - :commands (eww eww-browse-url) - :config - (setopt eww-use-browse-url ".") - (add-hook 'eww-mode-hook - (defun eww-mode@setup () - (add-hook 'visual-fill-column-mode-hook - (defun visual-fill-column@eww-reload () - (eww-reload :local)))) - nil :local) - (keymap-set eww-mode-map "&" - (defun eww-browse-url-external (&optional url) - (interactive nil eww-mode) - (condition-case e - (funcall - browse-url-secondary-browser-function - (or url (plist-get eww-data :url))) - (:success (when (null url) (quit-window))) ; Interactive use - (t (signal (car e) (cdr e)))))) - (add-hook 'eww-mode-hook #'bookmark-eww--setup) - (define-key eww-mode-map "b" #'bookmark-set) - (define-key eww-mode-map "B" #'bookmark-jump) - (define-key eww-mode-map (kbd "M-n") nil) - (define-key eww-mode-map (kbd "M-p") nil) - (define-key eww-mode-map (kbd "*") #'eww-archiveis-url)) - -(use-package browse-url - :demand t - :config - (put 'browse-url-browser-function 'safe-local-variable - '+browse-url-browser-function-safe-p) - (setopt browse-url-browser-function #'eww-browse-url - browse-url-secondary-browser-function #'browse-url-firefox - browse-url-firefox-program (executable-find "firefox") - browse-url-firefox-arguments '("--new-tab") - ;; Dispatch browser based on URL - browse-url-handlers - `(;; Videos - (,(+browse-url-matches "youtube\\.com" "youtu\\.be" - "invidious" "yewtu\\.be" - "twitch\\.tv" - (rx "." (or "mp4" "gif" "mov" "MOV" "webm") - eos)) - . +browse-url-with-mpv) - ;; Music - (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" - (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) - . +browse-url-with-mpv) - ;; Images - (,(+browse-url-matches "pbs\\.twimg\\.com" - (rx "." (or "jpeg" "jpg" "png" "pn" - "bmp" "webp") - eos)) - . +browse-url-with-miv) - ;; Blobs - (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) - . +browse-url-download) - ;; External URLs --- see `+browse-url-external-domains' - (+browse-url-external-url-p - . ,browse-url-secondary-browser-function)) - ;; External domains - ;; +browse-url-external-domains - ;; '("github.com" "gitlab.com" "codeberg.org" - ;; "tildegit.org" "git.tilde.town" - ;; "google.com" "imgur.com" "twitch.tv" - ;; "pixelfed" "instagram.com" - ;; "bibliogram.art" "reddit.com" - ;; "teddit.net" "libreddit.de" - ;; "streamable.com" "spotify.com" - ;; "hetzner.cloud" "melpa.org" - ;; "twitter.com" ("^t\\.co$") - ;; "nitter.snopyta.org" "nitter.net") - ) - ;; External browsers: firefox > chromium > chrome - (when-let ((firefox (choose-executable "firefox" - "firefox-esr"))) - (setopt browse-url-firefox-program firefox - browse-url-firefox-new-window-is-tab t - browse-url-firefox-arguments '("--new-tab") - browse-url-generic-program firefox - browse-url-generic-args browse-url-firefox-arguments)) - (when-let ((chromium (choose-executable "chromium" - "chromium-browser"))) - (setopt browse-url-chromium-program chromium - browse-url-generic-program chromium)) - (when-let ((chrome (choose-executable "chrome" - "google-chrome-stable"))) - (setopt browse-url-chrome-program chrome - browse-url-generic-program chrome))) - -(use-package browse-url-transform - :after browse-url - :load-path "~/src/browse-url-transform.el/" - :config - (setopt browse-url-transform-alist - `(;; Privacy-respecting alternatives - ("twitter\\.com" . "nitter.snopyta.org") - ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") - ("medium\\.com" . "scribe.rip") - (".*substack\\.com.*" . ,substack-proxy) - ;; Text-mode of non-text-mode sites - ("www\\.npr\\.org" . "text.npr.org") - ;; Ask for raw versions of paste sites - ("^.*dpaste\\.com.*$" . "\\&.txt") - ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") - ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") - ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") - ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) - (browse-url-transform-mode)) - -;;; Link hint - -(use-package link-hint - :ensure t :demand t - :preface (keymap-global-unset "M-l") - :bind - (("M-l M-l" . +link-hint-open-link) - ("M-l l" . +link-hint-open-link) - ("M-l M-o" . +link-hint-open:secondary) - ("M-l o" . +link-hint-open:secondary) - ("M-l M-m" . +link-hint-open-multiple-links) - ("M-l m" . +link-hint-open-multiple-links) - ("M-l M-w" . link-hint-copy-link) - ("M-l w" . link-hint-copy-link) - ("M-l M-c" . +link-hint-open:chrome) - ("M-l c" . +link-hint-open:chrome) - ("M-l M-d" . +link-hint-open:download) - ("M-l d" . +link-hint-open:download)) - :config - (require '+link-hint) - (setopt link-hint-avy-style 'at-full - link-hint-avy-all-windows t) - ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs. - ;; Removing it fixes the problem, so ... that's what I've done. It's quite - ;; possible this problem isn't caused by `link-hint' at all, but rather by - ;; another package's configuration, but I don't care enough to fix it. - (setq link-hint-types - (delq 'link-hint-completion-list-candidate link-hint-types)) - ;; (+link-hint-open-secondary-setup) - ;; (+link-hint-open-chrome-setup) - ) - -(provide 'acdw-web) -;;; acdw-web.el ends here diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null @@ -1,384 +0,0 @@ -;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*- - -;;; Code: - -(require 'cl-lib) -(require 'seq) - -(defmacro defdir (name directory &optional docstring makedir) - "Define a variable and a function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable; its default is DIRECTORY's -path. If MAKEDIR is non-nil, the directory and its parents will -be created." - (declare (indent 2) (doc-string 3)) - `(progn - (defvar ,name (expand-file-name ,directory) - ,(concat (or docstring (format "%s" directory)) "\n" - "Defined by `defdir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, parent directories are created.\n" - "Defined by `defdir'.") - (let ((file-name (expand-file-name - (convert-standard-filename file) ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)) - ,(if makedir - `(make-directory ,directory :parents) - `(unless (file-exists-p ,directory) - (warn "Directory `%s' doesn't exist." ,directory))))) - -(defun choose-executable (&rest programs) - "Return the first of PROGRAMS that exists in the system's $PATH. -Each of PROGRAMS can be a single string, or a list. If it's a list then its car -will be tested with `executable-find', and the entire list returned. This -enables passing arguments to a calling function." - (catch 'found - (dolist (prog programs) - (let ((exec (executable-find (car (ensure-list prog)))) - (args (cdr-safe prog))) - (when exec - (throw 'found (if args (cons exec args) exec))))))) - -(defun file-string (file) - "Return the contents of FILE as a string." - (with-current-buffer (find-file-noselect file) - (buffer-string))) - -(defun unsmartify-region (begin end) - "Replace \"smart\" punctuation with \"dumb\" counterparts." - (interactive "*r") - (save-excursion - (goto-char begin) - (while (re-search-forward "[“”‘’–—]" end t) - (let ((replace (pcase (match-string 0) - ((or "“" "”") "\"") - ((or "‘" "’") "'") - ("–" "--") - ("—" "---")))) - (replace-match replace nil nil))))) - -(defun unsmartify-dwim () - "Unsmartify the current region or the entire buffer." - (interactive) - (if (region-active-p) - (unsmartify-region (region-beginning) (region-end)) - (unsmartify-region (point-min) (point-max)))) - -(defun ++concat (func strings) - "Concat STRINGS processed by FUNC. -Each of STRINGS can be a bare string or a list. Strings are -passed through as-is, but lists are passed to FUNC first as -arguments. Finally, all the resulting strings are `mapconcat'-ed -together. - -As a special case, if `:separator' is the first of STRINGS, the -string following will be used as a separator. Otherwise, a -newline will be used." - (let (separator) - (when (eq (car strings) :separator) - (setq separator (cadr strings) - strings (cddr strings))) - (mapconcat (lambda (s) - (cond - ((listp s) (apply func s)) - ((stringp s) s) - (t (user-error "Bad argument: %S" s)))) - strings - (or separator "\n")))) - -(defun format-concat (&rest strings) - "Concatenate formatted STRINGS. -Each of STRINGS can be a bare string or a list. Bare strings are passed as-is -to `mapconcat' for concatenation and separation. Lists, however, are passed to -`format' first. - -If `:separator' is the first of STRINGS, the next string will be -used as a separator." - (++concat #'format strings)) - -(defun list-append-removing-duplicates (&rest lists) - "Append LISTS, removing duplicates from the result. -Any keyword arguments to `cl-remove-duplicates' should come -before the LISTS." - (let (cl-remove-duplicates-args) - (while (keywordp (car lists)) - (push (pop lists) cl-remove-duplicates-args) - (push (pop lists) cl-remove-duplicates-args)) - (apply #'cl-remove-duplicates (apply #'append lists) - (nreverse cl-remove-duplicates-args)))) - -(defun mapc-buffers (func &optional predicate) - "Map FUNC over buffers matching PREDICATE. -Both FUNC and PREDICATE will be executed with no arguments and in -the context of each buffer. - -If PREDICATE is nil or not given, map FUNC over all buffers." - (cl-loop for buf being the buffers - do (with-current-buffer buf - (when (and predicate - (funcall predicate)) - (funcall func))))) - -(defun mapc-buffers-modes (func &rest modes) - "Map FUNC over buffers derived from MODES. -FUNC will be executed with no arguments and in the context of -each buffer." - (mapc-buffers func - (lambda () - (apply #'derived-mode-p modes)))) - -(defun find-font (&rest fonts) - "Return the first font of FONTS that is installed." - (cl-loop with ffl = (font-family-list) - for font in fonts - if (member font ffl) - return font)) - -(defmacro progress@around (fn message &optional name) - "Define :around advice for functions adding a simple progress reporter." - (let ((orig (gensym)) - (args (gensym)) - (prog (gensym))) - `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress)) - ,(format "Add a simple progress reporter to %s." fn) - (let ((,prog (make-progress-reporter - ,(format "%s..." (string-remove-suffix "..." message))))) - (apply ,orig ,args) - (progress-reporter-done ,prog))))) - - - -;;; Ispell in .dir-locals - -;; Let Emacs know a list of strings is safe -(defun +ispell-safe-local-p (list) - (and (listp list) - (seq-every-p #'stringp list))) - -;; Can I instruct ispell to insert LocalWords in a different file? -;; https://emacs.stackexchange.com/q/31396/2264 - -;; How can I move all my file-local LocalWords to .dir-locals.el? -;; https://emacs.stackexchange.com/q/31419 - -;; Adapted from ispell.el:ispell-buffer-local-words -(defun +ispell-buffer-local-words-list () - (let (words) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (let ((end (point-at-eol)) - (ispell-casechars (ispell-get-casechars)) - string) - (while (re-search-forward " *\\([^ ]+\\)" end t) - (setf string (match-string-no-properties 1)) - (if (and (< 1 (length string)) - (equal 0 (string-match ispell-casechars string))) - (push string words)))))) - words)) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals (&optional arg) - "Move the current buffer-local words to .dir-locals.el. -This function prompts the user to save .dir-locals.el, unless -prefix ARG is non-nil; then it just saves them." - (interactive "P") - (unless (buffer-file-name) - (user-error "Buffer not attached to file")) - (hack-dir-local-variables) - (let ((print-level nil) - (print-length nil) - (before-save-hook nil) - (after-save-hook nil)) - (when-let ((new-words (cl-remove-if - (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA - ; where this came from - (list-append-removing-duplicates - :test #'string= - ispell-buffer-session-localwords - (alist-get 'ispell-buffer-session-localwords - dir-local-variables-alist) - (alist-get 'ispell-buffer-session-localwords - file-local-variables-alist) - (+ispell-buffer-local-words-list))))) - (save-excursion - (add-dir-local-variable - major-mode - 'ispell-buffer-session-localwords - (setf ispell-buffer-session-localwords - new-words)) - (when (or arg - (y-or-n-p "Save .dir-locals.el?")) - (save-buffer)) - (bury-buffer)) - (or ispell-buffer-local-name - (setf ispell-buffer-local-name (buffer-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward ispell-words-keyword nil t) - (delete-region (point-at-bol) (1+ (point-at-eol)))))))) - -;;;###autoload -(defun +ispell-move-buffer-words-to-dir-locals-hook () - "Convenience function for binding to a hook." - (+ispell-move-buffer-words-to-dir-locals t)) - - -;;; Comment-or-uncomment-sexp -;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html - -(defun +lisp-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 +lisp-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 +lisp-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)))) - (+lisp-uncomment-sexp n) - (dotimes (_ (or n 1)) - (+lisp-comment-sexp--raw)))) - - -;;; Random shit - -(defun insert-iso-date (&optional arg) - "Insert current date formatted ISO-8601 style. -When called with \\[universal-argument] \\[insert-iso-date], -include the time. When called with \\[universal-argument] -\\[universal-argument] \\[insert-iso-date], prompt the user for the -`format-time-string' format to use." - (interactive "P") - (insert (format-time-string (pcase arg - ('nil "%F") - ('(4) "%FT%T%z") - (_ (read-string "Time format: ")))))) - -(defun unfill-paragraph () - "Unfill the current paragraph." - (interactive) - (let ((fill-column most-positive-fixnum) - (fill-paragraph-function nil)) - (fill-paragraph))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill paragraph or region, double-spacing sentences." - (interactive) - (let ((sentence-end-double-space t)) - (unless (region-active-p) - (mark-paragraph)) - (repunctuate-sentences :no-query - (region-beginning) - (region-end)) - (fill-region (region-beginning) - (region-end)))) - -(defun fill-with-double-spaced-sentences-dwim (&optional start end) - "Fill from START to END, double-spacing sentences. -If START to END aren't given, or if a region isn't in use, fill -the current paragraph." - (interactive "*r") - (let ((sentence-end-double-space t)) - (save-mark-and-excursion - (save-restriction - (unless (region-active-p) - (setq start (progn (start-of-paragraph-text) - (point)) - end (progn (end-of-paragraph-text) - (point)))) - (narrow-to-region start end) - (goto-char (point-min)) - (repunctuate-sentences :no-query) - (fill-region (point-min) - (point-max)))))) - -(defun acdw-elisp-package-prepare (&optional file) - "Do all the elisp-package-preparing stuff on FILE. -If FILE is nil or not given, do it on the current buffer." - (with-current-buffer (if file (find-file-noselect file) (current-buffer)) - (check-parens) - (checkdoc) - (package-lint-buffer) - ;; TODO: use `lm-commentary' to write to README.org - )) - -(provide 'acdw) -;;; acdw.el ends here diff --git a/lisp/ical2org.el b/lisp/ical2org.el deleted file mode 100644 index 2716787..0000000 --- a/lisp/ical2org.el +++ /dev/null @@ -1,56 +0,0 @@ -;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*- - -;;; Commentary: - -;; based on code from this reddit thread: -;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/ -;; -;; see also: icalendar.org (converts to diary format, might be all I need) -;; -;; XXX: This code currently imports into gnus, which isn't what I want. - -;;; Code: - -(defun ical2org (&optional replace output-buffer) - "Run ical2org on contents of this buffer. -If REPLACE (interactive prefix argument), replace contents of the -buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to -minibuffer." - (interactive "P") - (shell-command-on-region (point-min) (point-max) - "ical2org" - output-buffer - replace - "*ical2org errors*" - 'display-errors)) - -(defun ical2org-capture () - "Run `ical2org' on this buffer, then `org-capture' the result. -Leaves current buffer as-was afterwards." - (interactive) - (let ((buf (current-buffer)) - (ics (buffer-string))) - (ical2org 'replace) - (mark-whole-buffer) - (call-interactively #'org-capture) - (with-current-buffer buf - (delete-region (point-min) (point-max)) - (insert ics)))) - -(defun my-gnus-org-capture-icalendar () - "Capture any text/calendar invites with org." - (interactive) - (with-current-buffer gnus-article-buffer ;;; XXX - (save-excursion - (dolist (part gnus-article-mime-handle-alist) - (when (and (>= (length part) 3) - (listp (caddr part)) - (or (equal "application/ics" (caaddr part)) - (equal "text/calendar" (caaddr part)))) - (save-window-excursion - (gnus-mime-copy-part (cdr part)) - (ical2org-capture))))))) -(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar) - -(provide 'ical2org) -;;; ical2org.el ends here diff --git a/packages.el b/packages.el new file mode 100644 index 0000000..42d8eeb --- /dev/null +++ b/packages.el @@ -0,0 +1,129 @@ +;;; packages.el --- my Emacs packages -*- lexical-binding: t; -*- + +(use-package scule + :load-path "~/src/scule.el/" + :bind-keymap ("M-c" . scule-map) + :init + ;; Use M-u for prefix keys + (keymap-global-set "M-u" #'universal-argument) + (keymap-set universal-argument-map "M-u" #'universal-argument-more)) + +(use-package frowny + :load-path "~/src/frowny.el/" + :hook ((jabber-chat-mode . frowny-mode))) + +(use-package hippie-completing-read + :load-path "~/src/hippie-completing-read.el/" + :bind (("M-/" . hippie-completing-read))) + +(use-package mode-line-bell + :load-path "~/src/mode-line-bell.el/" + :config + (setq mode-line-bell-flash-time 0.25) + (mode-line-bell-mode)) + +(use-package titlecase + :load-path "~/src/titlecase.el/" + :preface + (defun +titlecase-sentence-style-dwim (&optional arg) + "Titlecase a sentence. +With prefix ARG, toggle the value of +`titlecase-downcase-sentences' before sentence-casing." + (interactive "P") + (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) + titlecase-downcase-sentences))) + (titlecase-dwim 'sentence))) + (defun +titlecase-org-headings () + (interactive) + (require 'org) + (save-excursion + (goto-char (point-min)) + ;; See also `org-map-tree'. I'm not using that function because I want to + ;; skip the first headline. A better solution would be to patch + ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). + (let ((level (funcall outline-level)) + (org-special-ctrl-a/e t)) + (while (and (progn (outline-next-heading) + (> (funcall outline-level) level)) + (not (eobp))) + (titlecase-region (progn (org-beginning-of-line) (point)) + (progn (org-end-of-line) (point))))))) + :config + (with-eval-after-load 'scule + (keymap-set scule-map "M-t" #'titlecase-dwim))) + +;;; Jabber + +(use-package jabber + :load-path "~/src/jabber.el" + :defer t + :bind-keymap (("C-c j" . jabber-global-keymap)) + :preface nil + (setq-default jabber-chat-buffer-format "*%n*" + jabber-browse-buffer-format "*%n*" + jabber-groupchat-buffer-format "*%n*" + jabber-muc-private-buffer-format "*%n*") + :custom-face + (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign + :foreground unspecified + :weight normal))) + (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local + :foreground unspecified + :weight bold))) + (jabber-chat-prompt-local ((t :inherit minibuffer-prompt + :foreground unspecified + :weight normal + :slant italic))) + (jabber-chat-prompt-foreign ((t :inherit warning + :foreground unspecified + :weight normal))) + (jabber-chat-prompt-system ((t :inherit font-lock-doc-face + :foreground unspecified))) + (jabber-rare-time-face ((t :inherit font-lock-comment-face + :foreground unspecified + :underline nil))) + :config + (require 'jabber-httpupload nil t) + (setopt jabber-auto-reconnect t + jabber-last-read-marker "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~" + jabber-muc-decorate-presence-patterns + '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) + ("Mode #.*" . jabber-muc-presence-dim) + ("." . jabber-muc-presence-dim)) + jabber-activity-make-strings #'jabber-activity-make-strings-shorten + jabber-rare-time-format + (format " - - - - - %%H:%d %%F" + (let ((min (string-to-number (format-time-string "%M")))) + (* 5 (floor min 5)))) + jabber-muc-header-line-format '(" " jabber-muc-topic)) + + (setopt jabber-groupchat-prompt-format "%n. " + jabber-chat-local-prompt-format "%n. " + jabber-chat-foreign-prompt-format "%n. " + jabber-muc-private-foreign-prompt-format "%g/%n. ") + + (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) + (map-keymap (lambda (key command) + (define-key jabber-global-keymap (vector (+ key #x60)) command)) + jabber-global-keymap) + (keymap-global-set "C-x C-j" #'dired-jump) + + (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) + (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) + (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) + (add-hook 'jabber-chat-mode-hook 'visual-line-mode) + (add-hook 'jabber-chat-mode-hook (defun jabber-no-position () + (setq-local mode-line-position nil))) + + (add-hook 'jabber-alert-muc-hooks + (defun jabber@highlight-acdw (&optional _ _ buf _ _) + (when buf + (with-current-buffer buf + (let ((regexp (rx word-boundary + "acdw" ; maybe get from the config? + word-boundary))) + (hi-lock-unface-buffer regexp) + (highlight-regexp regexp 'jabber-chat-prompt-local)))))) + + (when (fboundp 'jabber-chat-update-focus) + (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) -- cgit 1.4.1-21-gabe81