From 3d5ca4a6846d291175fc34e9d6e7095788066d73 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 1 Aug 2023 20:32:12 -0500 Subject: Remove emacs.el --- emacs.el | 1913 -------------------------------------------------------------- 1 file changed, 1913 deletions(-) delete mode 100644 emacs.el diff --git a/emacs.el b/emacs.el deleted file mode 100644 index a609f61..0000000 --- a/emacs.el +++ /dev/null @@ -1,1913 +0,0 @@ -;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*- -;; by Case Duckworth -;; License: GPLv3 - -(setopt custom-file (locate-user-emacs-file "custom.el")) -(load custom-file :noerror) - -(add-hook 'after-init-hook - (lambda () (load (locate-user-emacs-file "private") :noerror))) - -(require 'package) -(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) -(package-initialize) - -(defun package-ensure (pkg &optional local require) - "Ensure PKG is installed. -PKG can be a symbol, a string, or a list. A symbol will be -installed using `package-install' from `package-archives'. A -string will use `package-vc-install', which see. If given a -list, it will be interpreted as a full set of arguments to one of -the above functions, depending on the type of its car. - -If LOCAL is t, add ~/src/PKG.el to `load-path' and generate -autoloads. If LOCAL is a string, Add that directory to -`load-path'. - -If REQUIRE is non-nil, require the package after installing it." - (setq pkg (ensure-list pkg)) - - (cond - (local - (unless (stringp local) - (setq local (expand-file-name - (format "~/src/%s.el" (car pkg))))) - (unless (file-directory-p local) - (user-error "Package directory does not exist: %s" local)) - (let ((autoload-file (expand-file-name - (format "%s-autoloads.el" (car pkg)) - local)) - (backup-inhibited t)) - (add-to-list 'load-path local) - (loaddefs-generate local autoload-file) - (load autoload-file nil t)) - (setq pkg (intern (format "%s" (car pkg))))) - - ((symbolp (car pkg)) - (unless (ignore-errors (apply #'package-install pkg)) - (package-refresh-contents) - (apply #'package-install pkg)) - (setq pkg (car pkg))) - - ((stringp (car pkg)) - (let ((pkg-name (intern (file-name-base (car pkg))))) - (unless (package-installed-p pkg-name) - (apply #'package-vc-install pkg)) - (setq pkg pkg-name)))) - - (when require - (require pkg)) - - pkg) - -(defmacro setf/assoc (alist key val &optional keep) - "Set KEY to VAL in ALIST using `assoc'/`equal' semantics. -Written as a convenience to writing out this long `alist-get' -call every time. If VAL is nil, the entry with KEY is removed from ALIST unless -KEEP is also non-nil." - `(setf (alist-get ,key ,alist nil ,(not keep) #'equal) - ,val)) - -(defmacro comment (&rest _) (declare (indent defun)) nil) - -(defun add-local-mode-hook (mode-hook hook func) - "Add FUNC to HOOK locally in buffers with MODE-HOOK." - (add-hook mode-hook - (lambda () (add-hook hook func nil t)))) - -(package-ensure 'crux) -(crux-reopen-as-root-mode) - -(crux-with-region-or-buffer indent-region) -(crux-with-region-or-buffer tabify) -(crux-with-region-or-buffer untabify) - -(keymap-global-set "C-c i" #'crux-find-user-init-file) - -(setopt auth-sources '(default - "secrets:passwords" - "~/.authinfo")) - -(setq disabled-command-function nil) - - -;;; Theme - -(setopt modus-themes-bold-constructs nil) -(setopt modus-themes-italic-constructs t) -(setopt modus-themes-variable-pitch-ui t) -(setopt modus-themes-disable-other-themes t) - -(tool-bar-mode -1) -(menu-bar-mode -1) -(scroll-bar-mode -1) -(tooltip-mode -1) - -(setopt scroll-conservatively 101) - -(setopt read-answer-short t) -(setopt use-dialog-box nil) -(setopt use-file-dialog nil) -(setopt use-short-answers t) - -(setopt inhibit-startup-screen t) -(setopt initial-buffer-choice t) -(setopt initial-scratch-message - ;; ";; Emacs!\n\n" - nil) - -(setopt x-underline-at-descent-line t) -(setopt blink-cursor-delay 0.25) -(setopt blink-cursor-interval 0.25) -(setopt blink-cursor-blinks 4) - -(define-advice startup-echo-area-message (:override ()) - (if (get-buffer "*Warnings*") - ";_;" - "^_^")) - -(defun reset-faces (&rest _) - (dolist (face '(font-lock-regexp-face - font-lock-builtin-face - font-lock-variable-name-face - font-lock-preprocessor-face - font-lock-remove-face - font-lock-delimiter-face - font-lock-label-face - font-lock-operator-face - font-lock-property-face - font-lock-builtin-face - font-lock-number-face - font-lock-keyword-face - font-lock-set-face - font-lock-punctuation-face - font-lock-constant-face - font-lock-type-face - font-lock-function-name-face - font-lock-reference-face - font-lock-misc-punctuation-face - font-lock-bracket-face)) - (face-spec-set face '((t :foreground unspecified - :background unspecified)))) - (when-let ((current (cl-loop for modus in modus-themes-collection - if (memq modus custom-enabled-themes) - return modus - finally return nil))) - (modus-themes-with-colors - (dolist (face '(font-lock-doc-face - font-lock-string-face)) - (face-spec-set face `((t :foreground unspecified - :background unspecified - :slant italic)))) - ;; (face-spec-set 'font-lock-comment-face - ;; :inherit doesn't work for some reason?? - ;; `((t :foreground - ;; ,fg-alt))) - ))) -(advice-add 'load-theme :after #'reset-faces) - -(defvar dark-theme 'modus-vivendi-tinted) -(defvar light-theme 'modus-operandi-tinted) - -(load-theme dark-theme :no-confirm :no-enable) -(load-theme light-theme :no-confirm :no-enable) -(if (and (executable-find "darkman") - (let ((stat (shell-command "darkman get"))) - (and (= stat 0) - (equal (with-current-buffer shell-command-buffer-name - (buffer-substring (point-min) (point-max))) - "dark\n")))) - (load-theme dark-theme :no-confirm) - (load-theme light-theme :no-confirm)) - - -(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))) - (face-spec-set 'variable-pitch - `((t :family "Recursive Sans Casual Static" - :height 1.0))) - ;; Emojis - (cl-loop with ffl = (font-family-list) - for font in '("Noto Emoji" "Noto Color Emoji" - "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)) - ;; XXX: tab-bar does a weird thing, so i set it up here.... - (setopt tab-bar-show t) - (tab-bar-mode)) - -(defun run-after-init-or-first-frame (func) - "Run FUNC after init or after the first frame." - (if (daemonp) - (add-hook 'server-after-make-frame-hook func) - (add-hook 'after-init-hook func))) - -(run-after-init-or-first-frame #'first-frame@set-fonts) - -(setopt frame-resize-pixelwise t) -(setopt window-resize-pixelwise t) - -(defun tab-bar-end-space () - `((end menu-item " " ignore))) - -(add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) -(add-to-list 'tab-bar-format 'tab-bar-format-global :append) -(add-to-list 'tab-bar-format 'tab-bar-end-space :append) - -(add-hook 'dired-mode-hook #'hl-line-mode) -(with-eval-after-load 'org-agenda - (add-hook 'org-agenda-mode-hook #'hl-line-mode)) - -(with-eval-after-load 'tabulated-list - (add-hook 'tabulated-list-mode-hook #'hl-line-mode)) - -(setopt echo-keystrokes 0.01) - -(setopt switch-to-buffer-in-dedicated-window 'pop) -(setopt switch-to-buffer-obey-display-actions t) - -(when (package-ensure 'adaptive-wrap) - (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode)) - -;;; Ediff - -(setopt ediff-split-window-function #'split-window-horizontally) -(setopt ediff-window-setup-function #'ediff-setup-windows-plain) - -;;; Man pages - -(setopt Man-notify-method 'aggressive) - -;;; Mode-line - -(defun hide-minor-mode (mode &optional hook) - "Hide MODE from the mode-line. -HOOK is used to trigger the action, and defaults to MODE-hook." - (setf (alist-get mode minor-mode-alist) (list "")) - (add-hook (intern (or hook (format "%s-hook" mode))) - (lambda () (hide-minor-mode mode)))) - -(setq mode-line-modes - (let ((recursive-edit-help-echo - "Recursive edit, type M-C-c to get out")) - (list (propertize "%[" 'help-echo recursive-edit-help-echo) - `(:propertize ("" mode-name) - help-echo "Major mode\n\ -mouse-1: Display major mode menu\n\ -mouse-2: Show help for major mode\n\ -mouse-3: Toggle minor modes" - face bold - mouse-face mode-line-highlight - local-map ,mode-line-major-mode-keymap) - '("" mode-line-process) - `(:propertize ("" minor-mode-alist) - mouse-face mode-line-highlight - help-echo "Minor mode\n\ -mouse-1: Display minor mode menu\n\ -mouse-2: Show help for minor mode\n\ -mouse-3: Toggle minor modes" - local-map ,mode-line-minor-mode-keymap) - (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer" - 'mouse-face 'mode-line-highlight - 'local-map (make-mode-line-mouse-map - 'mouse-2 #'mode-line-widen)) - (propertize "%]" 'help-echo recursive-edit-help-echo) - " "))) - -(setopt mode-line-format - '(("%e" - mode-line-front-space - (:propertize ("" - mode-line-client - mode-line-modified - mode-line-remote) - display (min-width (3.0))) - " " - mode-line-buffer-identification - (vc-mode - (" (" (:eval (string-trim vc-mode)) ")")) - " " - (mode-line-position - (" ∙ " mode-line-position)) - " ∙ " - mode-line-modes ; the one above - mode-line-misc-info - mode-line-end-spaces))) - - -;;; Completion and minibuffer - -(setopt tab-always-indent 'complete) -(setopt completion-styles '(basic partial-completion substring flex)) - -;; XXX: this is 'too good' when I'm in the process of typing out things. -;; (when (package-ensure "https://git.sr.ht/~pkal/typo") -;; (add-to-list 'completion-styles 'typo :append)) - -(setopt completion-ignore-case t) -(setopt read-buffer-completion-ignore-case t) -(setopt read-file-name-completion-ignore-case t) -(setopt completion-flex-nospace t) - -;; These aren't /that/ useful if you're not using *Completions*. -(setopt completions-detailed t) -(setopt completion-auto-help 'visible) -(setopt completion-auto-select 'second-tab) -(setopt completions-header-format nil) -(setopt completions-format 'one-column) -(setopt completions-max-height 20) - -;; (defun minibuffer-next-completion-or-line (n) -;; "Move to the next N completion in minibuffer, or Nth next line." -;; (interactive "p") -;; (if (and (eq last-command 'minibuffer-next-completion) -;; (not (minibufferp))) -;; (forward-line n) -;; (minibuffer-next-completion n))) - -;; (defun minibuffer-previous-completion-or-line (n) -;; "Move to the previous N completion, or Nth previous line." -;; (interactive "p") -;; (setq last-command 'minibuffer-next-completion-or-line) -;; (minibuffer-next-completion-or-line (- n))) - -(progn - (keymap-set minibuffer-local-map "C-p" - #'minibuffer-previous-completion) - (keymap-set minibuffer-local-map "C-n" - #'minibuffer-next-completion) - ;; (keymap-set completion-in-region-mode-map "C-p" - ;; #'minibuffer-previous-completion) - ;; (keymap-set completion-in-region-mode-map "C-n" - ;; #'minibuffer-next-completion) - ) - -(setf/assoc display-buffer-alist - "\\*Completions\\*" - '((display-buffer-reuse-mode-window))) - -(setopt enable-recursive-minibuffers t) -(minibuffer-depth-indicate-mode) -(minibuffer-electric-default-mode) - -(setopt file-name-shadow-properties '(invisible t intangible t)) -(file-name-shadow-mode) - -(define-minor-mode truncate-lines-local-mode - "Toggle `truncate-lines' in the current buffer." - :lighter "" - (setq-local truncate-lines truncate-lines-local-mode)) - -(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode) -(add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) - -(when (package-ensure 'consult nil t) - (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) - - (setopt xref-show-xrefs-function #'consult-xref) - (setopt xref-show-definitions-function #'xref-show-definitions-completing-read) - - (setopt consult-preview-key "M-.") - - (consult-customize - consult-ripgrep consult-git-grep consult-grep - consult-xref - :preview-key '(:debounce 0.4 any))) - -(when (package-ensure 'marginalia) - (marginalia-mode)) - -(setopt history-length t) -(setopt history-delete-duplicates t) -(setopt savehist-save-minibuffer-history t) -(setopt savehist-autosave-interval 5) -(savehist-mode) - - -;;; Text editing - -(setopt fill-column 80) -(global-so-long-mode) - -(defun cycle-spacing* (&optional n) - "Negate N argument on `cycle-spacing'." - (interactive "*p") - (cycle-spacing (- n))) -(keymap-global-set "M-SPC" #'cycle-spacing*) - -(when (package-ensure 'hungry-delete) - (setopt hungry-delete-chars-to-skip " \t") - (setopt hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip)) - (setopt hungry-delete-join-reluctantly nil) - (with-eval-after-load 'hungry-delete - (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) - (hide-minor-mode 'hungry-delete-mode)) - (global-hungry-delete-mode)) - -(setopt isearch-lazy-count t) -(setopt isearch-regexp-lax-whitespace t) -(setopt isearch-wrap-pause 'no) -(setopt search-default-mode t) -(setopt search-whitespace-regexp ".*?") ; swiper-style -(setopt search-ring-max 256) -(setopt regexp-search-ring-max 256) - -(define-advice isearch-cancel (:before () add-to-history) - "Add search string to history when canceling isearch." - (unless (string-equal "" isearch-string) - (isearch-update-ring isearch-string isearch-regexp))) - -(define-advice perform-replace (:around (fn &rest args) dont-exit-on-anykey) - "Don't exit replace for anykey 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 fn args)))) - -(when (package-ensure 'isearch-mb) - (with-eval-after-load 'isearch-mb - (with-eval-after-load 'consult - (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) - (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history) - (add-to-list 'isearch-mb--after-exit #'consult-line) - (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line)) - (with-eval-after-load 'anzu - (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) - (keymap-set isearch-mb-minibuffer-map "M-%" - #'anzu-isearch-query-replace))) - (isearch-mb-mode)) - -(when (package-ensure 'anzu) - (setopt anzu-mode-lighter "") - (setopt anzu-deactivate-region t) - (keymap-global-set "M-%" #'anzu-query-replace-regexp) - (keymap-global-set "C-M-%" #'anzu-query-replace) - (keymap-set isearch-mode-map "M-%" #'anzu-isearch-query-replace-regexp) - (keymap-set isearch-mode-map "C-M-%" #'anzu-isearch-query-replace) - (global-anzu-mode)) - -(keymap-global-set "M-/" #'hippie-expand) -(keymap-global-set "C-x C-b" #'ibuffer) - -(add-hook 'ibuffer-mode-hook #'hl-line-mode) - -(defun call-with-region-or-buffer (fn &rest _r) - "Call function FN with current region or buffer. -Good to use for :around advice." - ;; This `interactive' form is needed to override the advised function's form, - ;; to avoid errors when the region isn't active. This means that FN must take - ;; 2 arguments, the beginning and the end of the region to act on. - (interactive) - (if (region-active-p) - (funcall fn (region-beginning) (region-end)) - (funcall fn (point-min) (point-max)))) - -(delete-selection-mode) - -(when (package-ensure 'avy) - (setopt avy-background t) - (setopt avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) - (keymap-global-set "M-j" #'avy-goto-char-timer) - (keymap-set isearch-mode-map "M-j" #'avy-isearch)) - -(when (package-ensure 'zzz-to-char) - (keymap-global-set "M-z" - (defun zzz-to-char* (arg) - (interactive "P") - (call-interactively - (if arg #'zzz-to-char #'zzz-to-char-up-to-char))))) - -;;; Prose - -(add-hook 'text-mode-hook #'visual-line-mode) - -(when (package-ensure 'olivetti) - (add-hook 'text-mode-hook #'olivetti-mode)) - -(when (package-ensure 'jinx) - (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))) - -(defun org-fk-region (start end) - "Get the Flesch-Kincaid score of an `org-mode' region." - (interactive "r") - (let ((buf (get-buffer-create " *fk*" t))) - (shell-command-on-region start end - "pandoc -t plain -f org | ~/src/fk/fk.perl" - buf) - (with-current-buffer buf - (buffer-substring-no-properties (point-min) (- (point-max) 1))) - (kill-buffer buf))) - -(crux-with-region-or-buffer org-fk-region) - -(when (package-ensure 'scule t t) - (keymap-global-set "M-c" scule-map)) - -(when (package-ensure 'titlecase t) - (keymap-set scule-map "M-t" #'titlecase-dwim)) - -(setopt dictionary-default-popup-strategy "lev") ; Levenshtein distance 1 -(setopt dictionary-server "dict.org") -(setopt dictionary-use-single-buffer t) -(keymap-global-set "M-#" - (defun dictionary-lookup-dwim () - (interactive) - (unless (ignore-errors (dictionary-lookup-definition)) - (call-interactively #'dictionary-search)))) - -(package-ensure 'markdown-mode) - -;;; Programming - -(setopt electric-pair-skip-whitespace 'chomp) -(electric-pair-mode) - -(setopt show-paren-delay 0.01) -(setopt show-paren-style 'parenthesis) -(setopt show-paren-when-point-in-periphery t) -(setopt show-paren-when-point-inside-paren t) -(show-paren-mode) - -(add-hook 'prog-mode-hook #'auto-fill-mode) -(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode) -(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) - -(when (package-ensure 'dumb-jump) - (add-hook 'xref-backend-functions #'dumb-jump-xref-activate)) - -(add-hook 'prog-mode-hook #'prettify-symbols-mode) - -(keymap-global-set "M-:" #'pp-eval-expression) - -;; Tabs - -(setopt tab-width 8) - -(defvar space-indent-modes '(emacs-lisp-mode - lisp-interaction-mode - lisp-mode - scheme-mode - python-mode - haskell-mode - text-mode) - "Modes to indent with spaces, not tabs.") - -(defun indent-tabs-mode-maybe () - (setq indent-tabs-mode - (if (apply #'derived-mode-p space-indent-modes) nil t))) -(add-hook 'prog-mode-hook #'indent-tabs-mode-maybe) - -(setopt sh-basic-offset tab-width) -(setopt perl-indent-level tab-width) - -;; Scheme - -(when (package-ensure 'geiser) - (when (executable-find "csi") - (when (package-ensure 'geiser-chicken) - (setf/assoc auto-mode-alist "\\.egg\\'" 'scheme-mode))) - (setopt scheme-program-name (or (executable-find "csi") - "scheme")) - (add-hook 'scheme-mode-hook #'geiser-mode)) - -(require 'autoinsert) -(setf/assoc auto-insert-alist - "\\.scm" - '(nil "#!/bin/sh" \n - "#| -*- scheme -*-" \n - "exec csi -ss \"$0\" \"$@\"" \n - _ \n - "|#" \n \n)) - -;; Emacs lisp - -(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun) -(keymap-set emacs-lisp-mode-map "C-c C-b" #'eval-buffer) -(keymap-set emacs-lisp-mode-map "C-c C-z" #'ielm) ; TODO: better-ize -(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun) -(keymap-set lisp-interaction-mode-map "C-c C-b" #'eval-buffer) -(keymap-set lisp-interaction-mode-map "C-c C-z" #'ielm) ; TODO: better-ize - -(add-hook 'after-init-hook - (lambda () - (define-advice eval-buffer (:after (&rest _) message) - (message "Buffer %s evaluated." (current-buffer))))) - - -;;; Files - -(setopt auto-revert-verbose nil) -(setopt global-auto-revert-non-file-buffers t) -(global-auto-revert-mode) - -(setopt create-lockfiles nil) -(setopt mode-require-final-newline t) -(setopt view-read-only t) -(setopt save-silently t) - -(setopt auto-save-default nil) -(setopt auto-save-no-message t) -(setopt auto-save-interval 2) -(setopt auto-save-timeout 2) -(setopt auto-save-visited-interval 2) -(setopt remote-file-name-inhibit-auto-save t) -(setopt 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) -(setopt version-control t) -(setopt kept-new-versions 3) -(setopt kept-old-versions 3) -(setopt delete-old-versions t) -(add-to-list 'backup-directory-alist '("^/dev/shm/" . nil)) -(add-to-list 'backup-directory-alist '("^/tmp/" . nil)) -(when-let ((xrd (getenv "XDG_RUNTIME_DIR"))) - (add-to-list 'backup-directory-alist (cons xrd nil))) -(add-to-list 'backup-directory-alist - (cons "." (locate-user-emacs-file "backup/")) - :append) - -(setopt recentf-max-menu-items 100) -(setopt recentf-max-saved-items nil) -(setopt recentf-case-fold-search t) -(with-eval-after-load 'recentf - (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) - -(setopt save-place-forget-unreadable-files (eq system-type 'gnu/linux)) -(save-place-mode) - -;; Encodings -(set-language-environment "UTF-8") -(setopt buffer-file-coding-system 'utf-8-unix) -(setopt coding-system-for-read 'utf-8-unix) -(setopt coding-system-for-write 'utf-8-unix) -(setopt default-process-coding-system '(utf-8-unix . utf-8-unix)) -(setopt 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))) - -;; Undo -(when (package-ensure 'undohist) - (undohist-initialize)) - -;;; ... - -(setopt bookmark-save-flag 1) - -(defun c-w-dwim (num) - "Delete NUM words backward, or the region if it's active." - (interactive "p") - (if (region-active-p) - (call-interactively #'kill-region) - (call-interactively #'backward-kill-word))) -(keymap-global-set "C-w" #'c-w-dwim) - -(setf/assoc display-buffer-alist - "\\`\\*Warnings\\*" - '((display-buffer-no-window))) - -(winner-mode) - -(setopt set-mark-command-repeat-pop t) - -(when (package-ensure 'embark nil t) - (when (and (package-installed-p 'consult) - (package-ensure 'embark-consult nil t)) - (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)) - (keymap-global-set "C-." #'embark-act) - (keymap-global-set "M-." #'embark-dwim) - (keymap-global-set "C-h B" #'embark-bindings) - (setopt prefix-help-command #'embark-prefix-help-command) - (setf/assoc display-buffer-alist - "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" - '(nil (window-parameters (mode-line-format . none))))) - -(setopt eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) -(setopt eldoc-idle-delay 0.01) - -(setopt recenter-positions '(top middle bottom)) - -(defmacro inhibit-messages (&rest body) - "Inhibit all messages in BODY." - (declare (indent defun)) - `(cl-letf (((symbol-function 'message) #'ignore)) - ,@body)) - -(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))))) - -(setopt vc-follow-symlinks t) -(setopt vc-make-backup-files t) -(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)))) -(with-eval-after-load 'vc-dir - (add-hook 'vc-dir-mode-hook #'hl-line-mode)) - -(setopt whitespace-style '(face trailing tabs tab-mark)) -(global-whitespace-mode) -(hide-minor-mode '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))))) - -(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) - -(package-ensure '0x0) ; TODO: write my own package for rsync - -(when (package-ensure 'electric-cursor t) - (hide-minor-mode 'electric-cursor-mode) - (setopt electric-cursor-alist '((overwrite-mode . (hbar . 8)) - (t . box))) - (electric-cursor-mode)) - -(defun fill-double-space-sentences-region (start end) - "Fill from START to END, double-spacing sentences." - (let ((sentence-end-double-space t)) - (repunctuate-sentences :no-query start end) - (fill-region start end))) - -(defun unfill-region (start end &optional unfill-func) - "Unfill region from START to END." - (let ((fill-column most-positive-fixnum) - (fill-paragraph-function nil)) - (funcall (or unfill-func #'fill-region) start end))) - -(defun fill-or-unfill-region (start end &optional interactive) - "Fill or unfill from START to END." - (interactive "*r\np") - (if (and interactive - (eq last-command 'fill-or-unfill-region)) - ;; If called interactively more than once, toggle filling mode. - (if (with-current-buffer "*Messages*" - (goto-char (point-max)) - (goto-char (beginning-of-line)) - (looking-at "Unfilling")) - (fill-double-space-sentences-region start end) - (unfill-region start end #'fill-double-space-sentences-region)) - ;; Otherwise, detect filled status based on the length of lines in the - ;; region. If just one of them is longer than `fill-column', consider the - ;; region unfilled. - (let ((filled-p (cl-some (lambda (ln) (<= 1 (length ln) fill-column)) - (string-split (buffer-substring start end) - "[\n\r]+")))) - (if filled-p - (progn - (message "Unfilling region") - (unfill-region start end #'fill-double-space-sentences-region)) - (progn - (message "Filling region") - (fill-double-space-sentences-region start end)))))) - -(defun fill-or-unfill-dwim () - (interactive) - (save-mark-and-excursion - (unless (region-active-p) - (mark-paragraph)) - (call-interactively #'fill-or-unfill-region))) - -(keymap-global-set "M-q" #'fill-or-unfill-dwim) - -;; Fix annoying error messages when I type the key -(keymap-global-set "<0x100811d0>" #'ignore) ; Keychron -(keymap-global-set "" #'ignore) ; Laptop - -(keymap-global-set "M-u" #'universal-argument) -(keymap-set universal-argument-map "M-u" #'universal-argument-more) - -(defun kill-buffer-dwim (&optional buffer-or-name) - "Kill BUFFER-OR-NAME or the current buffer." - (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))))) -(keymap-global-set "C-x C-k" #'kill-buffer-dwim) - -(defun other-window-dwim (&optional arg) - "Switch to another window/buffer. -Calls `other-window', which see, unless -- the current window is alone on its frame -- `other-window-dwim' is called with \\[universal-argument] -In these cases, switch to the last-used buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) -(keymap-global-set "M-o" #'other-window-dwim) -(keymap-global-set "C-x o" #'other-window-dwim) - -(defun delete-window-dwim () - "Delete the current window or bury its buffer. -If the current window is alone in its frame, bury the buffer -instead." - (interactive) - (unless (ignore-errors (delete-window) t) - (bury-buffer))) -(keymap-global-set "C-x 0" #'delete-window-dwim) - - -;;; Org mode - -(keymap-global-set "C-c a" #'org-agenda) -(keymap-global-set "C-c c" #'org-capture) -(keymap-global-set "C-c l" #'org-store-link) - -(setopt org-clock-clocked-in-display 'mode-line) -(setopt org-clock-out-remove-zero-time-clocks t) -(setopt org-clock-frame-title-format '("%b" " - " (t org-mode-line-string))) -(setopt org-tags-column (- (- fill-column 3))) -(setopt org-log-into-drawer t) -(setopt org-clock-into-drawer t) -(setopt org-special-ctrl-a/e t) -(setopt org-special-ctrl-k t) -(setopt org-archive-mark-done t) -(setopt org-agenda-window-setup 'current-window) -(setopt org-agenda-restore-windows-after-quit t) -(setopt org-agenda-skip-deadline-if-done t) -(setopt org-agenda-skip-scheduled-if-done t) -(setopt org-agenda-inhibit-startup t) -(setopt org-deadline-warning-days 0) -(setopt org-cycle-separator-lines 0) -(setopt org-agenda-span 10) -(setopt org-blank-before-new-entry '((heading . t) - (plain-list-item . nil))) - -(defvar-local org-agenda/setup-done nil) - -(add-hook 'org-agenda-after-show-hook - (defun org-agenda-after-show/setup () - (org-narrow-to-subtree) - (goto-char (point-min)) - (unless org-agenda/setup-done - (run-hooks 'org-mode-hook)) - (setq org-agenda/setup-done t))) - -;; org-return-dwim -;; https://github.com/alphapapa/unpackaged.el, -;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ -(defun org-return-dwim (&optional arg) - "A helpful replacement for `org-return'. -When called interactively with \\[universal-argument], call `org-return' -itself. Other values of ARG will call `newline' with that ARG." - (interactive "P") - ;; Auto-fill if enabled - (when auto-fill-function - (dolist (func (ensure-list auto-fill-function)) - (funcall func))) - (cl-letf* ((el (org-element-at-point)) - ((symbol-function 'el-child-of) - (lambda (&rest types) - (org-element-lineage el types t)))) - (cond ; Figure out what we're going to do - (arg ; Handle prefix ARG - (pcase arg - ('(4) (org-return t nil t)) - (_ (newline arg t)))) - ((and org-return-follows-link ; Open a link - (el-child-of 'link)) - (org-open-at-point-global)) - ((org-at-heading-p) ; Open a paragraph after a heading - (let ((heading-start (org-entry-beginning-position))) - (goto-char (org-entry-end-position)) - (cond ((and (org-at-heading-p) ; Entry is only a heading - (= heading-start (org-entry-beginning-position))) - (end-of-line) - (newline 2)) - (:else ; Entry is more than a heading - (forward-line -1) - (end-of-line) - (when (org-at-heading-p) - ;; Open a paragraph - (forward-line) - (newline) - (forward-line -1)) - (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil)) - (newline)) - (forward-line -1))))) - ((org-at-item-checkbox-p) ; Insert a new checkbox item - (end-of-line) - (org-insert-todo-heading nil)) - ((org-in-item-p) ; Insert a new list item - (let* ((context (org-element-context el)) - (first-item-p (eq 'plain-list (car context))) - (itemp (eq 'item (car context))) - (emptyp (or - ;; This (regular) list item is empty - (eq (org-element-property :contents-begin context) - (org-element-property :contents-end context)) - ;; This (definition) list item is empty - (looking-at " *::"))) - (item-child-p (el-child-of 'item))) - (cond ((and itemp emptyp) - ;; This test has to be here even though it's the same as the - ;; :else clause, because an item that's empty will also satisfy - ;; the next clause. - (delete-region (line-beginning-position) (line-end-position)) - (newline)) - ((or first-item-p - (and itemp (not emptyp)) - item-child-p) - (org-end-of-item) - (org-insert-item)) - (:else - (delete-region (line-beginning-position) (line-end-position)) - (newline))))) - ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks - (org-inlinetask-in-task-p)) - (org-return)) - ((org-at-table-p) ; Insert a new table row - (cond ((save-excursion ; Empty row: end the table - (beginning-of-line) - (cl-loop with end = (line-end-position) - for cell = (org-element-table-cell-parser) - always (eq (org-element-property :contents-begin cell) - (org-element-property :contents-end cell)) - while (re-search-forward "|" end t))) - (delete-region (line-beginning-position) (line-end-position)) - (org-return)) - (:else ; Non-empty row - (org-return)))) - (:else ; Something else - (org-return))))) - -(defun org-table-copy-down|org-return-dwim (&optional n) - "Call `org-table-copy-down' or `+org-return' depending on context." - (interactive "P") - (if (org-table-check-inside-data-field 'noerror) - (org-table-copy-down (or n 1)) - (org-return-dwim n))) - -(defmacro org-insert-or-surround (character) - (let ((c (gensym))) - `(defun ,(intern (format "org-insert-or-surround-%s" character)) (arg) - ,(format "Insert %s or surround the region with it." character) - (interactive "p") - (let ((,c ,(if (stringp character) - (string-to-char character) - character))) - (if (org-region-active-p) - (let ((begin (region-beginning)) - (end (region-end))) - (save-mark-and-excursion - (deactivate-mark) - (goto-char begin) - (self-insert-command arg ,c) - (goto-char (+ 1 end)) - (self-insert-command arg ,c))) - (self-insert-command arg ,c)))))) - -(with-eval-after-load 'org - (keymap-set org-mode-map "RET" #'org-return-dwim) - (keymap-set org-mode-map "S-" #'org-table-copy-down|org-return-dwim) - (keymap-set org-mode-map "*" (org-insert-or-surround "*")) - (keymap-set org-mode-map "/" (org-insert-or-surround "/")) - (keymap-set org-mode-map "_" (org-insert-or-surround "_")) - (keymap-set org-mode-map "=" (org-insert-or-surround "=")) - (keymap-set org-mode-map "~" (org-insert-or-surround "~")) - (keymap-set org-mode-map "+" (org-insert-or-surround "+"))) - -;; Copy rich text to the keyboard -(defcustom clipboard-html-copy-program - (if (or (equal "wayland" - (getenv "XDG_SESSION_TYPE")) - (getenv "WAYLAND_DISPLAY")) - '("wl-copy" "-t" "text/html") - '("xclip" "-t" "text/html" "-selection" "clipboard")) - "Program to use to copy HTML to the clipboard. -Should be a list of strings---the command line. -Defaults to 'wl-copy' on wayland and 'xclip' on Xorg." - :type '(repeat string)) - -(defun org-export-html-copy (&rest org-export-args) - "Export current org buffer to HTML and copy to clipboard as rich text. -ORG-EXPORT-ARGS are passed to `org-export-to-buffer'." - (let ((buf (generate-new-buffer "*org-html-clipboard*" t))) - (apply #'org-export-to-buffer 'html buf org-export-args) - (with-current-buffer buf - (apply #'call-process-region - (point-min) - (point-max) - (car clipboard-html-copy-program) - nil ; don't delete text - nil ; discard the output - nil ; don't redisplay - (cdr clipboard-html-copy-program)) - (kill-buffer-and-window)) - (message "HTML copied to clipboard."))) - -(defun org-subtree-to-html-to-clipboard () - "Export current subtree to HTML." - (interactive) - (org-export-html-copy nil :subtree)) - -;; (info "(org) Breaking Down Tasks") -(defun org-summary-todo (n-done n-not-done) - "Switch entry to DONE when all subentries are done, to TODO otherwise." - (let (org-log-done org-log-states) ; turn off logging - (org-todo (if (= n-not-done 0) "DONE" "TODO")))) -(add-hook 'org-after-todo-statistics-hook #'org-summary-todo) - -;; Clean up the buffer view -(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)))))))) -(add-local-mode-hook 'org-mode-hook 'before-save-hook - #'org-hide-drawers-except-point) - -;; Fix braindead behavior -(with-eval-after-load 'org-mouse - (defun org--mouse-open-at-point (orig-fun &rest args) - (let ((context (org-context))) - (cond - ;; Don't org-cycle when clicking on headline stars. The biggest problem - ;; is that this function advises `org-open-at-point', so I can't C-c C-o - ;; from a headline star. - ;; ((assq :headline-stars context) (org-cycle)) - ((assq :checkbox context) (org-toggle-checkbox)) - ((assq :item-bullet context) - (let ((org-cycle-include-plain-lists t)) (org-cycle))) - ((org-footnote-at-reference-p) nil) - (t (apply orig-fun args)))))) - -(defun define-org-capture-template (description &rest args) - "Define an template for `org-capture-templates'. -Will not replace an existing template unless `:force' in ARGS is -non-nil. ARGS is a plist, which in addition to the additional -options `org-capture-templates' accepts (which see), also accepts -the following: `:keys', `:description', `:type', `:target', and -`:template'." - (declare (indent 1)) - (let* ((keys (plist-get args :keys)) - (type (plist-get args :type)) - (target (plist-get args :target)) - (template (plist-get args :template)) - (force (plist-get args :force)) - (template-value - (append - (list description) - (when (or type target template) - (list (or type 'entry) target template)) - (cl-loop for i from 0 below (length args) by 2 - unless (member (nth i args) - '( :keys :description :type - :target :template)) - append (list (nth i args) - (plist-get args (nth i args))))))) - (if (seq-find (lambda (el) (equal (car el) keys)) - org-capture-templates) - (and force - (setf (alist-get keys org-capture-templates nil nil #'equal) - template-value)) - (setf org-capture-templates - (append org-capture-templates - (list (cons keys template-value))))) - org-capture-templates)) - -(add-hook 'org-mode-hook - (defun org-mode-line-position () - (setq-local mode-line-position - '((:propertize - ("" mode-line-percent-position) - local-map mode-line-column-line-number-mode-map - display (min-width (5.0))) - (org-word-count-mode org-word-count-string)))) - (setq mode-line-misc-info - (delete '(org-word-count-mode org-word-count-string) - mode-line-misc-info))) - -;;; Org word count -;; also does Flesch-Kincaid reading level. -;; TODO: customization ... stuff. - -(defun fk-region (start end) - (interactive "r") - ;; (let* ((fk-buf (get-buffer-create " *fk*")) - ;; (fk-proc - ;; (start-process "fk" fk-buf "/home/acdw/src/fk/fk.perl"))) - ;; (set-process-sentinel fk-proc #'ignore) - ;; (process-send-region fk-proc start end) - ;; (process-send-eof fk-proc) - ;; (with-current-buffer fk-buf - ;; (goto-char (point-max)) - ;; (forward-line -1) - ;; (string-chop-newline (buffer-substring-no-properties - ;; (line-beginning-position) (point-max))))) - - (let ((shell-command-buffer-name (format " *fk/%s*" (buffer-name)))) - (shell-command-on-region start end "~/src/fk/fk.perl") - (with-current-buffer shell-command-buffer-name - (buffer-substring-no-properties (point-min) (- (point-max) 1)))) - ) - -(defun org-word-count-region (start end &optional interactive) - (interactive "r\np") - (when (derived-mode-p 'org-mode) - (save-window-excursion - (inhibit-messages - (let ((shell-command-buffer-name (format " *wc/%s*" (buffer-name))) - wc fk) - (shell-command-on-region start end - "pandoc -t plain -f org") - (with-current-buffer shell-command-buffer-name - (setq wc (count-words (point-min) (point-max))) - (setq fk (string-to-number (fk-region (point-min) (point-max))))) - (when interactive (message "%s" wc)) - (list wc fk)))))) - -(defvar-local org-word-count-string "" - "Number of words in buffer.") - -(defun update-org-word-count-string () - (when (derived-mode-p 'org-mode) - (setq org-word-count-string - (apply #'format " %dw/%.2ffk" - (org-word-count-region (point-min) (point-max)))))) - -(defvar org-word-count-timer nil - "Timer for `org-word-count'.") - -(define-minor-mode org-word-count-mode - "Count words and update the org-word-count-string." - :lighter " owc" - (cond - ((and (derived-mode-p 'org-mode) - org-word-count-mode) - (unless (timerp org-word-count-timer) - (setq org-word-count-timer - (run-with-idle-timer 1 t #'update-org-word-count-string)))) - (:else - (when (timerp org-word-count-timer) - (cancel-timer org-word-count-timer)) - (setq org-word-count-timer nil) - (setq org-word-count-mode nil)))) -(hide-minor-mode 'org-word-count-mode) - -(add-hook 'org-mode-hook #'org-word-count-mode) - -;;; Org recentering - -(defun org-recenter (&optional arg) - (interactive "P") - (if (or arg - (eq last-command 'org-recenter)) - (recenter-top-bottom arg) - (save-excursion - (unless (org-at-heading-p) - (ignore-errors (org-previous-visible-heading 1))) - (recenter-top-bottom 0)))) -(with-eval-after-load 'org - (keymap-set org-mode-map "C-l" #'org-recenter)) - -;;; Org links -- extra types - -(with-eval-after-load 'ol - (org-link-set-parameters "tel" :follow #'ignore) - (org-link-set-parameters "sms" :follow #'ignore)) - - -;;; Jabber - -;; (when (package-ensure 'jabber t t) -;; (setopt jabber-chat-buffer-format "*%n*") -;; (setopt jabber-browse-buffer-format "*%n*") -;; (setopt jabber-groupchat-buffer-format "*%n*") -;; (setopt jabber-muc-private-buffer-format "*%n*") - -;; (face-spec-set 'jabber-activity-face -;; '((t :inherit jabber-chat-prompt-foreign -;; :foreground unspecified -;; :weight normal))) -;; (face-spec-set 'jabber-activity-personal-face -;; '((t :inherit jabber-chat-prompt-local -;; :foreground unspecified -;; :weight bold))) -;; (face-spec-set 'jabber-chat-prompt-local -;; '((t :inherit minibuffer-prompt -;; :foreground unspecified -;; :weight normal -;; :slant italic))) -;; (face-spec-set 'jabber-chat-prompt-foreign -;; '((t :inherit warning -;; :foreground unspecified -;; :weight normal))) -;; (face-spec-set 'jabber-chat-prompt-system -;; '((t :inherit font-lock-doc-face -;; :foreground unspecified))) -;; (face-spec-set 'jabber-rare-time-face -;; '((t :inherit font-lock-comment-face -;; :foreground unspecified -;; :underline nil))) - -;; (setopt jabber-auto-reconnect t) -;; (setopt jabber-last-read-marker -;; "-------------------------------------------------------------------") -;; (setopt jabber-muc-decorate-presence-patterns -;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil) -;; ("Mode #.*" . jabber-muc-presence-dim) -;; ("." . jabber-muc-presence-dim))) -;; (setopt jabber-activity-make-strings #'jabber-activity-make-strings-shorten) -;; (setopt jabber-rare-time-format -;; (format " - - - - - %%H:%d %%F" -;; (let ((min (string-to-number (format-time-string "%M")))) -;; (* 5 (floor min 5))))) -;; (setopt jabber-muc-header-line-format '(" " jabber-muc-topic)) - -;; (setopt jabber-groupchat-prompt-format "%n. ") -;; (setopt jabber-chat-local-prompt-format "%n. ") -;; (setopt jabber-chat-foreign-prompt-format "%n. ") -;; (setopt jabber-muc-private-foreign-prompt-format "%g/%n. ") - -;; (defun jabber-connect-all* (&optional arg) -;; "Connect to all defined jabber accounts. -;; If called with ARG non-nil, or with \\[universal-argument], -;; disconnect first." -;; (interactive "P") -;; (when arg (jabber-disconnect)) -;; (jabber-connect-all)) - -;; (with-eval-after-load 'jabber -;; (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to) -;; (require 'jabber-httpupload nil t) -;; (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) -;; (keymap-set jabber-global-keymap "c" #'jabber-connect-all*) -;; (keymap-global-set "C-c j" jabber-global-keymap)) - -;; (remove-hook 'jabber-alert-muc-hooks #'jabber-muc-echo) -;; (remove-hook 'jabber-alert-presence-hooks #'jabber-presence-echo) -;; (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) -;; (add-hook 'jabber-chat-mode-hook #'olivetti-mode) -;; (add-hook 'jabber-chat-mode-hook -;; (defun jabber-chat-mode-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)))))) - -;; (add-hook 'jabber-chat-mode-hook -;; (defun electric-pair-local-disable () -;; (electric-pair-local-mode -1))) - -;; (when (fboundp 'jabber-chat-update-focus) -;; (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))) - - -;;; Dired - -(keymap-global-set "C-x C-j" #'dired-jump) -(with-eval-after-load 'dired - (keymap-set dired-mode-map "C-j" #'dired-up-directory)) - -(setopt dired-auto-revert-buffer t) -(setopt dired-dwim-target t) ; dired-dwim-target-next ? - - -;;; Browsing the web - -(setopt browse-url-browser-function #'eww-browse-url) - -(defcustom browse-url-safe-browser-functions nil - "\"Safe\" browser functions." - :type '(repeat-function)) - -(defun browse-url-browser-function-safe-p (fn) - "Return t if FN is a \"safe\" browser function." - (memq fn (append browse-url-safe-browser-functions - (mapcar (lambda (i) - (plist-get (cdr i) :value)) - (seq-filter (lambda (i) - (eq (car i) 'function-item)) - (cdr (get 'browse-url-browser-function - 'custom-type))))))) - -(put 'browse-url-browser-function 'safe-local-variable - 'browse-url-browser-function-safe-p) - -;;; EWW - -(setopt eww-use-browse-url ".") -(setopt eww-auto-rename-buffer 'title) -(setopt eww-default-download-directory - (or (xdg-user-dir "DOWNLOAD") - "~/Downloads")) -(setopt eww-history-limit nil) - -(defun eww-readable/olivetti () - (interactive) - (olivetti-mode +1) - (eww-readable) - (eww-reload t)) - -(with-eval-after-load 'eww - (keymap-set eww-mode-map "R" #'eww-readable/olivetti)) - -;; Use Emacs bookmarks for EWW -(defun bookmark-eww--make () - "Make eww bookmark record." - `((filename . ,(plist-get eww-data :url)) - (title . ,(plist-get eww-data :title)) - (time . ,(current-time-string)) - (handler . ,#'bookmark-eww-handler) - (defaults . (,(concat - ;; url without the https and path - (replace-regexp-in-string - "/.*" "" - (replace-regexp-in-string - "\\`https?://" "" - (plist-get eww-data :url))) - " - " - ;; page title - (replace-regexp-in-string - "\\` +\\| +\\'" "" - (replace-regexp-in-string - "[\n\t\r ]+" " " - (plist-get eww-data :title)))))))) - -(defun bookmark-eww-handler (bm) - "Handler for eww bookmarks." - (eww-browse-url (alist-get 'filename bm))) - -(defun bookmark-eww--setup () - "Setup eww bookmark integration." - (setq-local bookmark-make-record-function #'bookmark-eww--make)) -(add-hook 'eww-mode-hook #'bookmark-eww--setup) - -(with-eval-after-load 'eww - (define-key eww-mode-map "b" #'bookmark-set) - (define-key eww-mode-map "B" #'bookmark-jump)) - -;; Transforming URLs -;; `eww-transform-url' exists, but I like my package better. - -(when (package-ensure 'browse-url-transform t) - (setopt browse-url-transform-alist - `(;; Privacy-respecting alternatives - ("twitter\\.com" . "nitter.snopyta.org") - ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") - ("medium\\.com" . "scribe.rip") - ;; 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) - (hide-minor-mode 'browse-url-transform-mode)) - -(with-eval-after-load 'browse-url-transform - (setq eww-url-transformers ; `setopt' causes a warning about custom-type - '(eww-remove-tracking - browse-url-transform-url))) - -;; External browsers: firefox > chromium > chrome -(setq browse-url-firefox-program - (or (executable-find "firefox") - (executable-find "firefox-esr")) - browse-url-firefox-new-window-is-tab t - browse-url-firefox-arguments '("--new-tab") - - browse-url-chromium-program - (or (executable-find "chromium") - (executable-find "chromium-browser")) - - browse-url-chrome-program - (or (executable-find "chrome") - (executable-find "google-chrome-stable")) - - browse-url-secondary-browser-function - (cond (browse-url-firefox-program #'browse-url-firefox) - (browse-url-chromium-program #'browse-url-chromium) - (browse-url-chrome-program #'browse-url-chrome) - (t #'browse-url-default-browser))) - -(defmacro open-url-with (commandline &optional buffer error-buffer) - (let ((buffer (or buffer " *open-url-with*")) - (error-buffer (or error-buffer " *open-url-with/errors*"))) - `(lambda (url &rest _) - (cl-letf (((alist-get ,buffer - display-buffer-alist - nil nil #'equal) - '(display-buffer-no-window))) - (async-shell-command (format ,commandline url) - ,buffer - ,error-buffer))))) - -(defun add-browse-url-handler (regexp opener) - "Add OPENER to open REGEXP urls." - (setf/assoc browse-url-handlers - regexp - opener)) - -(add-browse-url-handler (rx (or (: ".pdf" eos) - (: ".PDF" eos))) - (open-url-with "zathura %s")) -(add-browse-url-handler (rx (or (: ".mp4" eos) - "youtube.com" - "piped.kavin.rocks")) - (open-url-with "mpv %s")) - -(when (package-ensure 'elpher) - (add-browse-url-handler (rx bos "gemini:") - #'elpher-browse-url-elpher)) - -;; Hinting at links -(when (package-ensure 'link-hint) - (setopt link-hint-avy-style 'at-full) - (setopt link-hint-avy-all-windows t) - (defvar link-hint-map - (define-keymap - :name "Open a link" - :prefix 'link-hint-map - "M-l" #'link-hint-open-link - "M-w" #'link-hint-copy-link)) - (keymap-global-set "M-l" 'link-hint-map)) - - -;;; Eshell - -(setopt eshell-modules-list - '(eshell-alias - eshell-banner - eshell-basic - eshell-cmpl - eshell-dirs - eshell-elecslash - eshell-extpipe - eshell-glob - eshell-hist - eshell-ls - eshell-pred - eshell-prompt - eshell-script - eshell-smart - eshell-unix)) - -(setopt eshell-banner-message "") -(setopt eshell-destroy-buffer-when-process-dies t) -(setopt eshell-error-if-no-glob t) -(setopt eshell-hist-ignoredups 'erase) -(setopt eshell-kill-on-exit t) -(setopt eshell-prefer-lisp-functions t) -(setopt eshell-prefer-lisp-variables t) -(setopt eshell-scroll-to-bottom-on-input 'this) -(setopt eshell-history-size 1024) -(setopt eshell-input-filter (lambda (input) - (or (eshell-input-filter-default input) - (eshell-input-filter-initial-space input)))) -(setopt eshell-prompt-function - (lambda () - (concat (if (= 0 eshell-last-command-status) - "^_^" - ";_;") - " " - (abbreviate-file-name (eshell/pwd)) - (if (= (user-uid) 0) - " # " - " $ ")))) -(setopt eshell-scroll-to-bottom-on-input 'this) - -(add-hook 'eshell-mode-hook - (defun eshell-setup () - (setq-local outline-regexp eshell-prompt-regexp) - (setq-local page-delimiter eshell-prompt-regexp) - (setq-local imenu-generic-expression - '(("Prompt" " \\($\\|#\\) \\(.*\\)" 2))) - (setq-local truncate-lines t))) - -(setenv "PAGER" (executable-find "cat")) - -(setopt eshell-where-to-jump 'begin) -(setopt eshell-review-quick-commands nil) -(setopt eshell-smart-space-goes-to-end t) - -(when (package-ensure 'eat) - (add-hook 'eshell-first-time-mode-hook #'eat-eshell-mode) - (with-eval-after-load 'eat - (keymap-unset eat-eshell-semi-char-mode-map "M-o" t))) - -(if (package-ensure 'eshell-toggle) - (keymap-global-set "C-z" #'eshell-toggle) - ;; If the package doesn't load for some reason, do the dumb thing instead - (defun eshellp (buffer-or-name) - (with-current-buffer buffer-or-name - (derived-mode-p 'eshell-mode))) - - (defun eshell-pop-up (&optional arg) - "Pop up an eshell in the `default-directory'. -NEW is passed to `eshell'." - (interactive "P") - (require 'eshell) - (let ((dir default-directory) - (display-comint-buffer-action 'pop-to-buffer)) - (if-let ((buf (and (not arg) - (or (get-buffer eshell-buffer-name) - (seq-find #'eshellp (reverse (buffer-list))))))) - (pop-to-buffer buf) - (eshell arg)) - ;; In the eshell buffer - (unless (file-equal-p default-directory dir) - (eshell/cd dir) - (eshell-send-input) - (goto-char (point-max))))) - - (keymap-global-set "C-z" #'eshell-pop-up) - (with-eval-after-load 'esh-mode - (keymap-set eshell-mode-map "C-z" #'quit-window))) - -(when (package-ensure 'wiki-abbrev t) - (wiki-abbrev-insinuate) - (add-hook 'text-mode-hook #'abbrev-mode)) - -;;; Dinghie - -(add-to-list 'mode-line-misc-info - '(buffer-ding-cookie (:propertize buffer-ding-cookie - face error)) - :append) - -(defvar buffer-ding-timer nil - "Timer for `buffer-ding'.") -(defvar buffer-ding-cookie nil - "Variable to hold the `face-remap-add-relative' cookie.") -(defcustom buffer-ding-timeout 0.25 - "How long to ding the buffer for.") - -(defun buffer-unding () - "Unflash the buffer after done `ding'ing." - ;; (face-remap-remove-relative buffer-ding-cookie) - (setq buffer-ding-cookie nil) - (force-mode-line-update t)) - -(defun buffer-ding () - "Flash the buffer for `ding'." - (cond - ((timerp buffer-ding-timer) - (cancel-timer buffer-ding-timer) - (setq buffer-ding-timer nil) - (buffer-ding)) - ((and (null buffer-ding-timer) - buffer-ding-cookie) - (setq buffer-ding-cookie nil) - (buffer-unding)) - (t - ;; (setq buffer-ding-cookie (face-remap-add-relative 'default 'error)) - (setq buffer-ding-cookie " Ding!") - (force-mode-line-update) - (run-with-timer buffer-ding-timeout nil #'buffer-unding)))) - -;; (setopt ring-bell-function (lambda () (pulse-momentary-highlight-region -;; (window-start) (window-end)))) - -(setopt ring-bell-function #'buffer-ding) -(add-hook 'isearch-mode-end-hook #'buffer-unding) - -(defun mapc-buffers (fn &rest modes) - (cl-loop for buf being the buffers - do (with-current-buffer buf - (when (or (null modes) - (apply #'derived-mode-p modes)) - (funcall fn))))) - -(defun mapc-buffers/progress (msg fn &rest modes) - (dolist-with-progress-reporter (buf (buffer-list)) msg - (with-current-buffer buf - (when (or (null modes) - (apply #'derived-mode-p modes)) - (funcall fn))))) - -;;; Flash! - -(defun flash-region@ (orig start end &rest args) - (apply orig start end args) - (pulse-momentary-highlight-region start end)) - -(advice-add 'eval-region :around #'flash-region@) -(with-eval-after-load 'geiser - (advice-add 'geiser-eval-region :around #'flash-region@)) - -;;; KeepassXC Integration - -(when (package-ensure 'keepassxc-shim t) - (keepassxc-shim-activate)) - -;;; RCIRC - -(when (require 'rcirc) - (setopt rcirc-default-full-name user-full-name) - (setopt rcirc-default-user-name user-login-name) - (setopt rcirc-authenticate-before-join t) - (setopt rcirc-display-server-buffer nil) - (setopt rcirc-buffer-maximum-lines 1000) - (setopt rcirc-kill-channel-buffers t) - (setopt rcirc-track-ignore-server-buffer-flag t) - - ;; Theming - (setopt rcirc-prompt "%t> ") - (setopt rcirc-default-part-reason "See You Space Cowboy . . .") - (setopt rcirc-default-quit-reason "(TLS connection improperly terminated)") - (setopt rcirc-url-max-length 24) - (setopt rcirc-response-formats - '(("PRIVMSG" . "<%N> %m") - ("NOTICE" . "-%N- %m") - ("ACTION" . "* %N %m") - ("COMMAND" . "%fs%m%f-") - ("ERROR" . "%fw!!! %m") - ("FAIL" . "(%fwFAIL%f-) %m") - ("WARN" . "(%fwWARN%f-) %m") - ("NOTE" . "(%fwNOTE%f-) %m") - (t . "%fp*** %fs%n %r %m"))) - - (face-spec-set 'rcirc-nick-in-message-full-line - '((t :foreground unspecified - :background unspecified - :weight unspecified - :inherit nil))) - - (add-to-list 'rcirc-omit-responses "NAMES") - - (defun chat/setup () - (whitespace-mode -1) - (electric-pair-local-mode -1) - ;; IDK what's the deal with this - (olivetti-mode +1) - (visual-line-mode -1) - (word-wrap-whitespace-mode +1)) - - (setq rcirc-debug-flag t) - - (advice-add 'rcirc :after - (defun enable-rcirc-track-minor-mode (&rest _) - (rcirc-track-minor-mode 1))) - - (defun rcirc-kill () - "Kill all rcirc buffers and turn off `rcirc-track-minor-mode'." - (interactive) - (mapc-buffers/progress "Killing rcirc buffers..." - (lambda () - (let ((kill-buffer-hook)) - (kill-buffer))) - 'rcirc-mode) - (rcirc-track-minor-mode -1)) - - (add-hook 'rcirc-mode-hook #'chat/setup) - (add-hook 'rcirc-mode-hook #'rcirc-omit-mode) - (add-hook 'rcirc-track-minor-mode-hook - (defun rcirc-track@buffer-list-change () - (add-hook 'buffer-list-update-hook - #'rcirc-window-configuration-change))) - - ;; "Fix" some things - (setf rcirc-implemented-capabilities - ;; I don't use these, and they mess up display in a few of my chats - (delete "message-tags" rcirc-implemented-capabilities)) - - ;; Adding servers more better-er - (defun rcirc-add-server (name &rest spec) - "Add a server to `rcirc-server-alist' and `rcirc-authinfo' at once. -TODO: fully document" - (let ((name* (if (plist-get spec :host) - (plist-get spec :host) - name)) - (nick (or (plist-get spec :nick) - (bound-and-true-p rcirc-default-nick) - (bound-and-true-p user-login-name))) - (user-name (or (plist-get spec :user-name) - (plist-get spec :user) - (plist-get spec :nick) - (bound-and-true-p rcirc-default-user-name) - (bound-and-true-p rcirc-default-nick) - (bound-and-true-p user-login-name))) - (password (let ((password (or (plist-get spec :password) - (plist-get spec :pass)))) - ;; (cond - ;; ((functionp password) (funcall password)) - ;; ((stringp password) password)) - password - ))) - ;; Add the server to `rcirc-server-alist' - (setf (alist-get name* rcirc-server-alist nil nil #'equal) - (append - (list :nick nick - :user-name user-name) - (when password (list :password password)) - (when-let ((full-name (plist-get spec :full-name))) - (list :full-name full-name)) - (when-let ((channels (plist-get spec :channels))) - (list :channels channels)) - (when-let ((port (plist-get spec :port))) - (list :port port)) - (when-let ((encryption (plist-get spec :encryption))) - (list :encryption encryption)) - (when-let ((server-alias (or (plist-get spec :server-alias) - (and (plist-get spec :host) - name)))) - (list :server-alias server-alias)))) - ;; Add it to `rcirc-authinfo' - (when-let ((auth (plist-get spec :auth))) - (unless password (user-error "Trying to auth without a password")) - (setf (alist-get name* rcirc-authinfo nil nil #'equal) - (cl-case auth - (nickserv (list 'nickserv nick password)) - (bitlbee (list 'bitlbee nick password)) - (quakenet (list 'quakenet user-name password)) - (sasl (list 'sasl user-name password)) - ;; (chanserv) ; These two aren't supported. - ;; (certfp) - (t (user-error "Unsupported :auth type `%s'" - (plist-get plist :auth)))))) - ;; Return the server's name so that we don't leak authinfo - name)) - - (defun rcirc-resolve-passwords (&rest _) - (dolist-with-progress-reporter (s rcirc-server-alist) - "Resolving lambda passwords in `rcirc-server-alist...'" - (let ((pw (plist-get (cdr s) :password))) - (setf (plist-get (cdr s) :password) - (if (functionp pw) (funcall pw) pw)))) - (dolist-with-progress-reporter (i rcirc-authinfo) - "Resolving lambda passwords in `rcirc-authinfo...'" - (let ((pw (cadddr i))) - (setf (cadddr i) - (if-let ((s (assoc (car i) rcirc-server-alist))) - (plist-get (cdr s) :password) - (if (functionp pw) (funcall pw) pw)))))) - - (advice-add 'rcirc :before #'rcirc-resolve-passwords) - - (defun rcirc/password (&rest spec) - (lambda () - (auth-info-password - (car - (apply #'auth-source-search spec))))) - - (setq rcirc-server-alist nil) - - (rcirc-add-server "tilde.town" - :host "localhost" :port 6969 - :channels '("#tildetown" "#newbirc") - :auth 'sasl - :password - (rcirc/password :host "localhost:6969" :user "acdw")) - ;; (rcirc-add-server "43beans.casa" - ;; :host "localhost" :port 6970 - ;; :channels '("#beans") - ;; :auth nil - ;; :password nil) - (rcirc-add-server "tilde.chat" - :host "irc.tilde.chat" :port 6697 :encryption 'tls - ;; :channels left blank. There's some kind of race - ;; condition in SASL and identd that means I authenticate - ;; before being fully authenticated? Or something. - ;; Tilde.chat's NickServ does autojoin, though, so that - ;; works out without an afternoon of debugging. - :auth 'sasl - :password (rcirc/password :host "tilde.chat" :user "acdw")) - (rcirc-add-server "m455.casa" - :port 6697 :encryption 'tls - :channels '("#basement" "#43beans") - :auth 'sasl - :password (rcirc/password :host "m455.casa" :user "acdw")) - (rcirc-add-server "libera.chat" - :host "irc.libera.chat" :port 6697 :encryption 'tls - :channels '("#emacs" "#rcirc") - :auth 'sasl - :password (rcirc/password :host "libera.chat" :user "acdw")) - ;; End of rcirc configuration. - ) - -(when (package-ensure 'web-mode) - (add-to-list 'auto-mode-alist '("\\.html?\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.phtml\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.tpl\\.php\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\. [agj]sp\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.as[cp]x\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.erb\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.mustache\\'" . web-mode)) - (add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode))) -- cgit 1.4.1-21-gabe81