;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*-
;; by Case Duckworth <acdw@acdw.net>
;; 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)))

(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
(package-initialize)

(defun package-ensure (pkg &optional local require)
  "Ensure PACKAGE is installed.
If LOCAL is t, add ~/src/PKG.el to `load-path' and generate autoloads.
If REQUIRE is non-nil, require it as well."
  (cond
   ((stringp local)
    (unless (file-directory-p local)
      (user-error "Package directory does not exist: %s" local))
    (let ((autoload-file (expand-file-name (format "%s-autoloads.el" pkg) local))
          (backup-inhibited t))
      (add-to-list 'load-path local)
      (loaddefs-generate local autoload-file)
      (load autoload-file nil t)))
   (local
    (package-ensure pkg (expand-file-name (format "~/src/%s.el" pkg)) require))
   (:else
    (unless (package-installed-p pkg)
      (unless (ignore-errors (package-install pkg))
        (package-refresh-contents)
        (package-install pkg)))))
  (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)

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

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

(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))))
  (dolist (face '(font-lock-doc-face
                  font-lock-string-face))
    (face-spec-set face '((t :foreground unspecified
                             :background unspecified
                             :slant italic))))
  (when-let ((current (cl-loop for modus in '(modus-vivendi modus-operandi)
                               if (memq modus custom-enabled-themes)
                               return modus
                               finally return nil)))
    (face-spec-set 'font-lock-comment-face
                   `((t :foreground ; :inherit doesn't work for some reason??
                        ,(if (eq current 'modus-operandi)
                             "#7c318f"
                           "#caa6df"))))))
(advice-add 'load-theme :after #'reset-faces)

(load-theme 'modus-vivendi :no-confirm :no-enable)
(load-theme 'modus-operandi :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 'modus-vivendi :no-confirm)
  (load-theme 'modus-operandi :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)

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

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

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

(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 'orderless)
  (setopt completion-styles '(substring orderless basic))
  (setopt completion-category-overrides
          '((file (styles basic partial-completion)))))

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

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

;;; 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-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")
    (package-ensure 'geiser-chicken))
  (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))


;;; 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 set-mark-command-repeat-pop t)

(when (package-ensure 'embark nil t)
  (when (package-installed-p 'consult)
    (package-ensure 'embark-consult nil t))
  (keymap-global-set "C-." #'embark-act)
  (keymap-global-set "M-." #'embark-dwim)
  (keymap-global-set "C-h B" #'embark-bindings)
  (setf/assoc display-buffer-alist
              "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
              '(nil (window-parameters (mode-line-format . none))))
  (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))

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

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

(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 fill-or-unfill-region (start end)
  "Fill or unfill from START to END."
  (let ((filled-p (cl-every (lambda (ln) (<= (length ln) fill-column))
                            (string-split (buffer-substring start end)
                                          "[\n\r]+"))))
    (if filled-p
        (let ((fill-column most-positive-fixnum)
              (fill-paragraph-function nil))
          (message "Unfilling region")
          (fill-double-space-sentences-region start end))
      (message "Filling region")
      (fill-double-space-sentences-region start end))))

(defun fill-or-unfill-dwim ()
  (interactive)
  (save-mark-and-excursion
    (if (region-active-p)
        (fill-or-unfill-region (region-beginning)
                               (region-end))
      (fill-or-unfill-region (progn (backward-paragraph)
                                    (point))
                             (progn (forward-paragraph)
                                    (point))))))

(keymap-global-set "M-q" #'fill-or-unfill-dwim)

;; Fix annoying error messages when I type the <FN> key
(keymap-global-set "<0x100811d0>" #'ignore) ; Keychron
(keymap-global-set "<WakeUp>" #'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)

(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-<return>" #'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)

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

  (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to)
  (with-eval-after-load 'jabber
    (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-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

(with-eval-after-load 'dired
  (keymap-set dired-mode-map "C-j" #'dired-up-directory))


;;; Browsing the web

(setopt browse-url-browser-function #'eww-browse-url)

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

;; 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
  (setopt eww-url-transformers
          '(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)))

;; 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-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)
                      " # "
                    " $ "))))

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

(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 (equal 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 'eat)
  (add-hook 'eshell-first-time-mode-hook #'eat-eshell-mode))

(when (package-ensure 'wiki-abbrev t)
  (wiki-abbrev-insinuate)
  (add-hook 'text-mode-hook #'abbrev-mode))
(put 'list-timers 'disabled nil)

;;; Dinghie

(add-to-list 'mode-line-misc-info
             '(buffer-ding-cookie buffer-ding-cookie)
             :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))

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