path: root/emacs

;;; ~/.emacs -*- lexical-binding: t; -*-
;; Author Case Duckworth <acdw@acdw.net>
;; Bankruptcy: 12

;;; Initialization -- see also ~/.emacs.d/early-init.el

(setopt custom-file (locate-user-emacs-file "custom.el"))
(load custom-file :no-error)

(defvar private-file (locate-user-emacs-file "private.el")
  "Private customizations")
(load private-file :no-error)           ; might as well do this now

;; (load-theme 'modus-operandi :no-confirm)

(define-advice startup-echo-area-message (:override ())
  (if (get-buffer "*Warnings*")
      ";_;"
    "^_^"))

(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 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 run-after-frame-init (func)
  "Run FUNC after the first frame is initialized.
If already so, run FUNC immediately."
  (cond
   ((daemonp)
    (add-hook 'server-after-make-frame-hook func)
    (advice-add func :after (lambda ()
                              (remove-hook 'server-after-make-frame-hook
                                           func)
                              (advice-remove func
                                             'after-frame-init-removing-advice))


                '((name . after-frame-init-removing-advice))))
   ((not after-init-time)
    (add-hook 'after-init-hook func))
   (:else (funcall func))))

(defun first-found-font (&rest cands)
  "Return the first font of CANDS that is installed, or nil."
  (cl-loop with ffl = (font-family-list)
           for font in cands
           if (member font ffl)
           return font))

(defun setup-faces ()
  "Setup Emacs faces."
  (set-face-attribute 'variable-pitch nil
                      :family (first-found-font "Public Sans")
                      :height 1.0)
  (set-face-attribute 'fixed-pitch-serif nil
                      :inherit 'default)

  ;; 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 cancel-colors ()
  (mapatoms
   (lambda (atom)
     (when (facep atom)
       (set-face-attribute atom nil
                           :foreground 'unspecified
                           :background 'unspecified
                           :weight 'unspecified
                           :slant 'unspecified
                           :underline 'unspecified
                           :overline 'unspecified
                           :strike-through 'unspecified
                           :box 'unspecified
                           :inverse-video nil
                           :stipple nil
                           :extend nil)))))

(defun set-faces (faces)
  (dolist (face faces)
    (apply #'set-face-attribute (car face) nil (cdr face))))

(font-lock-mode -1)
(cancel-colors)
(run-after-frame-init
 (defun uncancel-colors ()
   (set-faces `((font-lock-comment-face :italic t)
                (font-lock-comment-delimiter-face :italic t)
                (font-lock-doc-face :italic t)
                (font-lock-keyword-face :bold t)
                (bold :bold t) (italic :italic t) (underline :underline t)
                (mode-line-active :box t :background "light goldenrod")
                (mode-line-inactive :box "pale goldenrod"
                                    :background "pale goldenrod")
                (link :foreground "navy" :underline t)
                (completions-annotations :inherit 'italic)
                (highlight :background "wheat")
                (match :background "wheat")
                (isearch :background "sea green" :foreground "white")
                (isearch-fail :background "tomato")
                (lazy-highlight :background "dark sea green")
                (region :background "papaya whip")
                (query-replace :background "wheat")
                (shadow :foreground "orchid")
                (show-paren-match :background "goldenrod")
                (success :foreground "sea green" :italic t)
                (warning :foreground "brown" :italic t)
                (error :foreground "red" :italic t)
                (trailing-whitespace :background "tomato")
                (vertical-border :foreground "gray")
                (completions-highlight :background "wheat")))))

(defun recancel-colors ()
  (interactive)
  (cancel-colors)
  (uncancel-colors))

(defmacro inhibit-messages (&rest body)
  "Inhibit all messages in BODY."
  (declare (indent defun))
  `(cl-letf (((symbol-function 'message) #'ignore))
     ,@body))

(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)))))

(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)))

(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)))

(defun cycle-spacing* (&optional n)
  "Negate N argument on `cycle-spacing'."
  (interactive "*p")
  (cycle-spacing (- n)))

(defun find-user-init-file (&optional arg)
  "Edit `user-init-file' in current window.
With ARG, edit in other window."
  (interactive "P")
  (funcall (if arg #'find-file-other-window #'find-file)
           user-init-file))

(defun find-user-private-file (&optional arg)
  "Edit `private-file'.
With ARG, edit in other window."
  (interactive "P")
  (funcall (if arg #'find-file-other-window #'find-file)
           private-file))

(defun package-ensure (pkg)
  "Install PKG if it's not already installed."
  (unless (package-installed-p pkg)
    (package-install pkg)))

;;; Basic settings

(tooltip-mode -1)

;; Dialogs
(setopt use-dialog-box nil)
(setopt use-file-dialog nil)
(setopt read-answer-short t)
(setopt use-short-answers t)
(setopt echo-keystrokes 0.01)

;; Cursor
(blink-cursor-mode -1)

;; Fonts
(setopt x-underline-at-descent-line t)
(run-after-frame-init #'setup-faces)

;;; Look and feel

;; Whitespace
(setopt whitespace-style '(face trailing tabs tab-mark))
(global-whitespace-mode)
(add-hook 'before-save-hook #'delete-trailing-whitespace-except-current-line)
(set-face-attribute 'whitespace-tab nil :background nil :foreground "#888")
(setf (alist-get 'tab-mark whitespace-display-mappings)
      '(9 [?· 9] [?» 9] [?\\ 9]))

;;; Completions

(setopt tab-always-indent 'complete)
(setopt completion-styles '(basic partial-completion substring flex))

(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)

(setopt completion-show-help nil)
(setopt completions-detailed t)
(setopt completions-group 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 10)

(keymap-set minibuffer-local-map "C-p" #'minibuffer-previous-completion)
(keymap-set minibuffer-local-map "C-n" #'minibuffer-next-completion)

(setopt enable-recursive-minibuffers t)
(setopt minibuffer-default-prompt-format " [%s]")
(minibuffer-depth-indicate-mode)
(minibuffer-electric-default-mode)

(setopt file-name-shadow-properties '(invisible t intangible t))
(file-name-shadow-mode)

(setopt history-length t)
(setopt history-delete-duplicates t)
(setopt savehist-save-minibuffer-history t)
(setopt savehist-autosave-interval 5)
(savehist-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)

;; Consult/Marginalia

(package-ensure 'consult)
(require 'consult)
(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 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-.")

(package-ensure 'marginalia)
(marginalia-mode)

;;; 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 delete-by-moving-to-trash 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)

(add-hook 'find-file-not-found-functions #'create-missing-directories)

;;; Buffers

(setopt uniquify-buffer-name-style 'forward)

;; 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)))

;;; Search

(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)))

(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)))
(isearch-mb-mode)

;;; Keybinds

(keymap-global-set "C-x C-c" #'save-buffers-kill-terminal)
(keymap-global-set "C-x C-k" #'kill-buffer-dwim)
(keymap-global-set "M-o" #'other-window-dwim)
(keymap-global-set "C-x o" #'other-window-dwim)
(keymap-global-set "C-x 0" #'delete-window-dwim)
(keymap-global-set "M-SPC" #'cycle-spacing*)
(keymap-global-set "C-x C-b" #'ibuffer)
(keymap-global-set "M-/" #'hippie-expand)
(keymap-global-set "M-u" #'universal-argument)
(keymap-set universal-argument-map "M-u" #'universal-argument-more)
(keymap-global-set "C-c i" #'find-user-init-file)
(keymap-global-set "C-c p" #'find-user-private-file)
(keymap-global-set "C-c s" #'eshell)

(keymap-global-set "C-c t"
                   (defun insert-current-iso8601 ()
                     (interactive)
                     (insert (format-time-string "%FT%TZ" (current-time) t))))

(keymap-global-set "C-M-\\"
                   (defun indent-buffer ()
                     (interactive)
                     (save-mark-and-excursion
                       (indent-region (point-min) (point-max)))))

;; Un-keybinds
(keymap-global-unset "C-<wheel-down>" t)
(keymap-global-unset "C-<wheel-up>" t)
;; I only ever fat-finger this key and never want to change encoding
(keymap-global-unset "C-\\" t)
(keymap-global-unset "C-z" t)

;; Key settings
(setopt set-mark-command-repeat-pop t)

;;; Writing

(add-hook 'text-mode-hook #'visual-line-mode)

;;; Hungry delete
;; I was using the hungry-delete package, but it turns out I can get *most* of
;; the features with just these functions.

(defun %hungry-delete (skip-fn del-key)
  (let ((here (point)))
    (funcall skip-fn " \t")
    (if (or (= (point) here)
            (apply 'derived-mode-p
                   '(eshell-mode          ; add other modes to skip here.
                     nim-mode
                     pyton-mode)))
        (call-interactively (keymap-lookup (list (current-local-map)
                                                 (current-global-map))
                                           del-key))
      (delete-region (point) here))))

(defun hungry-delete-forward ()
  "Delete forward, hungrily."
  (interactive)
  (%hungry-delete #'skip-chars-forward "C-d"))

(defun hungry-delete-backward ()
  "Delete backward, hungrily."
  (interactive)
  (%hungry-delete #'skip-chars-backward "DEL"))

(define-minor-mode hungry-delete-mode
  "Hungrily delete stuff."
  :global t
  :lighter " h"
  :keymap (define-keymap
            "DEL" #'hungry-delete-backward
            "C-d" #'hungry-delete-forward))

(hungry-delete-mode)

;;; Programming

(add-hook 'prog-mode-hook #'electric-pair-local-mode)
(setopt tab-width 8)
(setopt sh-basic-offset tab-width)
(setopt perl-indent-level tab-width)
(setopt c-basic-offset tab-width)

;; Elisp
(defun pulse@eval (start end &rest _)
  (pulse-momentary-highlight-region start end))

(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun)
(keymap-set emacs-lisp-mode-map "C-c C-b"
            (defun eval-buffer@pulse () (interactive)
                   (eval-buffer)
                   (pulse@eval (point-min) (point-max))))
(advice-add 'eval-region :after #'pulse@eval)

(defvar space-indent-modes '(emacs-lisp-mode
                             lisp-interaction-mode
                             lisp-mode
                             scheme-mode
                             python-mode
                             haskell-mode
                             text-mode
                             web-mode
                             css-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)

;; Makefile
(setopt makefile-backslash-align nil)
(setopt makefile-cleanup-continuations t)

(add-hook 'makefile-mode-hook
          (defun makefile-stop-complaining ()
            (remove-hook 'write-file-functions
                         'makefile-warn-suspicious-lines t)
            (remove-hook 'write-file-functions
                         'makefile-warn-continuations t)))

;; Scheme -- CHICKEN
(setopt scheme-program-name (or (executable-find "csi")))
(add-to-list 'auto-mode-alist '("\\.egg\\'" . scheme-mode))

;; Scheme Indentation
(defun scheme-module-indent (state indent-point normal-indent) 0)
(put 'module 'scheme-indent-function 'scheme-module-indent)
(put 'and-let* 'scheme-indent-function 1)
(put 'parameterize 'scheme-indent-function 1)
(put 'handle-exceptions 'scheme-indent-function 1)
(put 'when 'scheme-indent-function 1)
(put 'unless 'scheme-indent-function 1)
(put 'match 'scheme-indent-function 1)

;; Geiser
(package-ensure 'geiser)
(package-ensure 'geiser-chicken)
(setopt geiser-mode-auto-p nil)
(setopt geiser-repl-history-filename "~/.emacs.d/geiser-history")
(setopt geiser-chicken-init-file "~/.csirc")
(add-hook 'scheme-mode-hook #'geiser-mode)
(add-hook 'geiser-repl-mode-hook #'electric-pair-local-mode)
(advice-add 'geiser-eval-region :after #'pulse@eval)

;; VC
(add-hook 'vc-dir-mode-hook #'hl-line-mode)
(defun vc-jump ()
  (interactive)
  (vc-dir default-directory))
(keymap-global-set "C-x v j" #'vc-jump)

;;; Compilation

(setopt compilation-always-kill t)
(setopt compilation-ask-about-save nil)

;;; Miscellaneous settings

(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
(add-hook 'prog-mode-hook #'auto-fill-mode)
(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode)
(add-hook 'prog-mode-hook #'electric-pair-local-mode)
(delete-selection-mode)
(global-so-long-mode)
(setopt display-fill-column-indicator-character ?·)
(setopt disabled-command-function nil)
(setopt electric-pair-skip-whitespace 'chomp)
(setopt fill-column 80)
(setopt recenter-positions '(top middle bottom))
(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)

(with-eval-after-load 'ibuffer
  (add-hook 'ibuffer-mode-hook #'hl-line-mode))

(with-eval-after-load 'proced
  (add-hook 'proced-mode-hook #'hl-line-mode))

;;; RCIRC

(setopt rcirc-kill-channel-buffers t)
(setopt rcirc-display-server-buffer nil)

(defun run-rcirc ()
  (interactive)
  (shell-command "chat up")
  (call-interactively #'rcirc))

(add-hook 'rcirc-mode-hook
          (defun @rcirc-mode ()
            (whitespace-mode -1)))

(add-hook 'rcirc-mode-hook #'rcirc-track-minor-mode)
(add-hook 'rcirc-mode-hook #'rcirc-omit-mode)
(add-hook 'rcirc-mode-hook #'visual-line-mode)
(add-hook 'rcirc-mode-hook
          (lambda () (whitespace-mode -1)))

;;; Eshell

(setopt eshell-prompt-function
        (defun @eshell-prompt ()
          (concat "* " (abbreviate-file-name (eshell/pwd))
                  (if (zerop (user-uid)) " # " " $ "))))

;;; Browsing

;; Dired (files)
(with-eval-after-load 'dired
  (setopt dired-dwim-target t)
  (setopt dired-listing-switches "-alF")
  (setopt dired-ls-F-marks-symlinks t)
  (keymap-set dired-mode-map "C-j" #'dired-up-directory)
  (add-hook 'dired-mode-hook #'hl-line-mode))

;; Elpher (gemini/gopher)
(package-ensure 'elpher)

;; Browse-url (http)
(setopt browse-url-new-window-flag t)
(setopt browse-url-firefox-arguments '("--new-tab"))
(setopt browse-url-firefox-new-window-is-tab t)