path: root/users/aspen/emacs/config.org

# Local variables:
# lexical-binding: t
# eval: (paxedit-mode 1)
# eval: (display-line-numbers-mode 1)
# eval: (flyspell-mode -1)
# eval: (org-config-mode 1)
# End:

#+title: Emacs Config
#+PROPERTY: header-args:emacs-lisp :results silent
#+PROPERTY: header-args:elisp :results silent

#+begin_src emacs-lisp :tangle yes
;; -*- lexical-binding: t; -*-
#+end_src

* Utils
#+begin_src elisp :tangle yes
(use-package! dash)
#+end_src

** Elisp extras

#+begin_src elisp :tangle yes
(defmacro comment (&rest _body)
  "Comment out one or more s-expressions"
  nil)

(defun inc (x) "Returns x + 1" (+ 1 x))
(defun dec (x) "Returns x - 1" (- x 1))

(defun average (ns)
  "Arithmetic mean of xs"
  (if (null ns) nil
    (/ (apply #'+ ns)
       (length ns))))

(defun alist-set (alist-symbol key value)
  "Set VALUE of a KEY in ALIST-SYMBOL."
  (set alist-symbol (cons (list key value) (assq-delete-all key (eval alist-symbol)))))

(defun rx-words (&rest words)
  (rx-to-string
   `(and symbol-start (group (or ,@words)) symbol-end)))
#+end_src

#+begin_src elisp :tangle no :results example
(average (list 1 2 3 4))
#+end_src

** Text editing utils
*** Reading strings
#+begin_src elisp :tangle yes
(defun get-char (&optional point)
  "Get the character at the given `point' (defaulting to the current point),
without properties"
  (let ((point (or point (point))))
    (buffer-substring-no-properties point (+ 1 point))))

(defun get-line (&optional lineno)
  "Read the line number `lineno', or the current line if `lineno' is nil, and
return it as a string stripped of all text properties"
  (let ((current-line (line-number-at-pos)))
    (if (or (not lineno)
            (= current-line lineno))
        (thing-at-point 'line t)
      (save-mark-and-excursion
       (line-move (- lineno (line-number-at-pos)))
       (thing-at-point 'line t)))))

(defun get-line-point ()
  "Get the position in the current line of the point"
  (- (point) (line-beginning-position)))

;; Moving in the file

(defun goto-line-char (pt)
  "Moves the point to the given position expressed as an offset from the start
of the line"
  (goto-char (+ (line-beginning-position) pt)))

(defun goto-eol ()
  "Moves to the end of the current line"
  (goto-char (line-end-position)))

(defun goto-regex-on-line (regex)
  "Moves the point to the first occurrence of `regex' on the current line.
Returns nil if the regex did not match, non-nil otherwise"
  (when-let ((current-line (get-line))
             (line-char (string-match regex current-line)))
    (goto-line-char line-char)))

(defun goto-regex-on-line-r (regex)
  "Moves the point to the *last* occurrence of `regex' on the current line.
Returns nil if the regex did not match, non-nil otherwise"
  (when-let ((current-line (get-line))
             (modified-regex (concat ".*\\(" regex "\\)"))
             (_ (string-match modified-regex current-line))
             (match-start (match-beginning 1)))
    (goto-line-char match-start)))
#+end_src

#+begin_src elisp :tangle no
(progn
  (string-match (rx (and (zero-or-more anything)
                         (group "foo" "foo")))
                "foofoofoo")
  (match-beginning 1))
#+end_src

*** Changing file contents
#+begin_src elisp :tangle yes
(defmacro saving-excursion (&rest body)
  `(λ! () (save-excursion ,@body)))

(defun delete-line ()
  "Remove the line at the current point"
  (delete-region (line-beginning-position)
                 (inc (line-end-position))))

(defmacro modify-then-indent (&rest body)
  "Modify text in the buffer according to body, then re-indent from where the
  cursor started to where the cursor ended up, then return the cursor to where
  it started."
  `(let ((beg (line-beginning-position))
         (orig-line-char (- (point) (line-beginning-position))))
     (atomic-change-group
       (save-mark-and-excursion
        ,@body
        (evil-indent beg (+ (line-end-position) 1))))
     (goto-line-char orig-line-char)))

(pcase-defmacro s-starts-with (prefix)
  `(pred (s-starts-with-p ,prefix)))

(pcase-defmacro s-contains (needle &optional ignore-case)
  `(pred (s-contains-p ,needle
                       ,@(when ignore-case (list ignore-case)))))
#+end_src

#+begin_src elisp :tangle no
(pcase "foo"
  ((s-contains "bar") 1)
  ((s-contains "o") 2))
#+end_src

** Evil utils
#+begin_src elisp :tangle yes
(defmacro define-move-and-insert
    (name &rest body)
  `(defun ,name (count &optional vcount skip-empty-lines)
     ;; Following interactive form taken from the source for `evil-insert'
     (interactive
      (list (prefix-numeric-value current-prefix-arg)
            (and (evil-visual-state-p)
                 (memq (evil-visual-type) '(line block))
                 (save-excursion
                   (let ((m (mark)))
                     ;; go to upper-left corner temporarily so
                     ;; `count-lines' yields accurate results
                     (evil-visual-rotate 'upper-left)
                     (prog1 (count-lines evil-visual-beginning evil-visual-end)
                       (set-mark m)))))
            (evil-visual-state-p)))
     (atomic-change-group
       ,@body
       (evil-insert count vcount skip-empty-lines))))
#+end_src

* Name and email
#+begin_src emacs-lisp
(setq user-full-name "Aspen Smith"
      user-mail-address "root@gws.fyi")
#+end_src

* Visual style
#+begin_src elisp :tangle yes
(let ((font-family (pcase system-type
                     ('darwin "MesloLGSDZ NF")
                     ('gnu/linux "Meslo LGSDZ Nerd Font"))))
  (setq doom-font (font-spec :family font-family :height 113)
        doom-big-font (font-spec :family font-family :size 24)
        doom-big-font-increment 5
        doom-variable-pitch-font (font-spec :family font-family)
        doom-theme 'doom-solarized-light))

(setq display-line-numbers-type t)

(setq doom-modeline-buffer-file-name-style 'relative-to-project
      doom-modeline-modal-icon nil
      doom-modeline-github t
      doom-modeline-height 12)
#+end_src

#+begin_src elisp :tangle yes
(setq whitespace-style '(face lines-tail))
(global-whitespace-mode t)
(add-hook 'org-mode-hook (lambda () (whitespace-mode -1)) t)
#+end_src

** Theme
[[https://davidjohnstone.net/lch-lab-colour-gradient-picker][LAB colour gradient picker]] is a good tool for trying to find "halfway points" between two colours

*** Variables
#+begin_src elisp :tangle no
(rainbow-mode)
#+end_src

#+name: solarized-vars
#+begin_src elisp :tangle yes
(setq +solarized-s-base03    "#002b36"
      +solarized-s-base02    "#073642"
      ;; emphasized content
      +solarized-s-base01    "#586e75"
      ;; primary content
      +solarized-s-base00    "#657b83"
      +solarized-s-base0     "#839496"
      ;; comments
      +solarized-s-base1     "#93a1a1"
      ;; background highlight light
      +solarized-s-base2     "#eee8d5"
      ;; background light
      +solarized-s-base3     "#fdf6e3"

      +solarized-halfway-highlight "#f5efdc"

      ;; Solarized accented colors
      +solarized-yellow    "#b58900"
      +solarized-orange    "#cb4b16"
      +solarized-red       "#dc322f"
      +solarized-magenta   "#d33682"
      +solarized-violet    "#6c71c4"
      +solarized-blue      "#268bd2"
      +solarized-cyan      "#2aa198"
      +solarized-green     "#859900"

      ;; Darker and lighter accented colors
      ;; Only use these in exceptional circumstances!
      +solarized-yellow-d  "#7B6000"
      +solarized-yellow-l  "#DEB542"
      +solarized-orange-d  "#8B2C02"
      +solarized-orange-l  "#F2804F"
      +solarized-red-d     "#990A1B"
      +solarized-red-l     "#FF6E64"
      +solarized-magenta-d "#93115C"
      +solarized-magenta-l "#F771AC"
      +solarized-violet-d  "#3F4D91"
      +solarized-violet-l  "#9EA0E5"
      +solarized-blue-d    "#00629D"
      +solarized-blue-l    "#69B7F0"
      +solarized-cyan-d    "#00736F"
      +solarized-cyan-l    "#69CABF"
      +solarized-green-d   "#546E00"
      +solarized-green-l   "#B4C342")
#+end_src

*** Overrides

#+name: overrides-for-solarized-light
#+begin_src elisp :tangle yes
(custom-set-faces!
  `(cursor :background ,+solarized-s-base00)
  `(font-lock-doc-face :foreground ,+solarized-s-base1)
  `(font-lock-preprocessor-face :foreground ,+solarized-red :bold nil)
  `(font-lock-keyword-face :foreground ,+solarized-green :bold nil)
  `(font-lock-builtin-face :foreground ,+solarized-s-base01 :bold t)
  `(font-lock-function-name-face :foreground ,+solarized-blue)
  `(font-lock-constant-face :foreground ,+solarized-blue)
  `(font-lock-type-face :italic nil)
  `(highlight-numbers-number :bold nil)
  `(highlight :background ,+solarized-s-base2)
  `(solaire-hl-line-face :background ,+solarized-halfway-highlight)
  `(hl-line :background ,+solarized-s-base2)

  `(linum :background ,+solarized-s-base2 :foreground ,+solarized-s-base1)
  `(line-number :background ,+solarized-s-base2 :foreground ,+solarized-s-base1)
  `(line-number-current-line :background ,+solarized-s-base2 :foreground ,+solarized-s-base1)
  `(fringe :background ,+solarized-s-base2)

  `(whitespace-line :foreground ,+solarized-red :underline t)

  `(haskell-operator-face :foreground ,+solarized-green)
  `(haskell-keyword-face :foreground ,+solarized-cyan)

  `(magit-branch-local :foreground ,+solarized-blue :bold t)
  `(magit-branch-remote :foreground ,+solarized-green :bold t)
  `(magit-branch-remote-head :foreground ,+solarized-green :bold t :box t)
  `(magit-branch-current :box t :bold t)
  `(magit-header-line :background nil :foreground ,+solarized-yellow :bold t :box nil)
  `(diff-refine-added :foreground "#dbdb9c" :background "#5b6e35" :bold nil)
  `(magit-diff-added-highlight :foreground "#657827" :background "#efeac7" :bold nil)
  `(diff-refine-removed :background "#8e433d" :foreground "#ffb9a1" :bold nil)
  `(magit-diff-removed-highlight :foreground "#a33c35" :background "#ffdec8" :bold nil)
  `(magit-diff-hunk-heading :background "#f8e8c6" :foreground "#876d26" :bold nil)
  `(magit-diff-hunk-heading-highlight :background "#f1d49b" :foreground "#766634" :bold nil)
  `(magit-section-heading :foreground "#b58900")
  `(magit-filename :foreground ,+solarized-s-base00)
  `(magit-diff-context-highlight :background ,+solarized-halfway-highlight)

  `(transient-delimiter :foreground ,+solarized-s-base1)
  `(transient-inapt-suffix :foreground ,+solarized-s-base1)
  `(transient-inactive-value :foreground ,+solarized-s-base1)
  `(transient-inactive-argument :foreground ,+solarized-s-base1)
  `(transient-key-exit :foreground ,+solarized-green :bold t)
  `(transient-key-stay :foreground ,+solarized-blue :bold t)
  )
  #+end_src

* Keybindings and navigation
Get the hell out of here, snipe!
#+begin_src elisp :tangle yes
(remove-hook 'doom-first-input-hook #'evil-snipe-mode)
#+end_src

#+begin_src emacs-lisp :tangle yes
(map!
 (:leader
  "b" #'consult-buffer
  "r" #'consult-recent-file))
#+end_src

** Flycheck
#+begin_src elisp :tangle yes
(evil-set-command-property 'flycheck-next-error :repeat nil)
(evil-set-command-property 'flycheck-prev-error :repeat nil)
(evil-set-command-property 'flycheck-previous-error :repeat nil)

(map!
 (:map flycheck-mode-map
  :m  "]e" #'flycheck-next-error
  :m  "[e" #'flycheck-previous-error))
#+end_src

** Smerge
#+begin_src elisp :tangle yes
(evil-set-command-property 'smerge-next :repeat nil)
(evil-set-command-property 'smerge-prev :repeat nil)

(map!
 :n "] n" #'smerge-next
 :n "[ n" #'smerge-prev
 (:leader
  (:desc "smerge" :prefix "g m"
   :desc "Keep Current" :n "SPC" #'smerge-keep-current
   :desc "Keep All"     :n "a" #'smerge-keep-all
   :desc "Keep Upper"   :n "u" #'smerge-keep-upper
   :desc "Keep Lower"   :n "l" #'smerge-keep-lower)))
t
 #+end_src

** Vinegar-style dired
#+begin_src elisp :tangle yes
(defun dired-mode-p () (eq 'dired-mode major-mode))

(defun aspen/dired-minus ()
  (interactive)
  (if (dired-mode-p)
      (dired-up-directory)
    (when buffer-file-name
      (-> (buffer-file-name)
          (f-dirname)
          (dired)))))

(map!
 :n "-" #'aspen/dired-minus
 (:map dired-mode-map
       "-" #'aspen/dired-minus))
#+end_src

** Lisp mappings
*** Use paxedit
#+begin_src elisp :tangle yes
(use-package! paxedit
  :hook ((emacs-lisp-mode . paxedit-mode)
         (clojure-mode . paxedit-mode)
         (common-lisp-mode . paxedit-mode)))
#+end_src

*** Paxedit functions

#+begin_src elisp :tangle yes
(define-move-and-insert aspen/insert-at-sexp-end
  (when (not (equal (get-char) "("))
    (backward-up-list))
  (forward-sexp)
  (backward-char))

(define-move-and-insert aspen/insert-at-sexp-start
  (backward-up-list)
  (forward-char))

(define-move-and-insert aspen/insert-at-form-start
  (backward-sexp)
  (backward-char)
  (insert " "))

(define-move-and-insert aspen/insert-at-form-end
  (forward-sexp)
  (insert " "))

(defun aspen/paxedit-kill (&optional n)
  (interactive "p")
  (or (paxedit-comment-kill)
      (when (paxedit-symbol-cursor-within?)
        (paxedit-symbol-kill))
      (paxedit-implicit-sexp-kill n)
      (paxedit-sexp-kill n)
      (message paxedit-message-kill)))
#+end_src

*** Paxedit mappings
#+begin_src elisp :tangle yes
(map!
 (:after paxedit
         (:map paxedit-mode-map
          :i ";"                          #'paxedit-insert-semicolon
          :i "("                          #'paxedit-open-round
          :i "["                          #'paxedit-open-bracket
          :i "{"                          #'paxedit-open-curly
          :n [remap evil-yank-line]       #'paxedit-copy
          :n [remap evil-delete-line]     #'aspen/paxedit-kill
          :n "g o"                        #'paxedit-sexp-raise
          :n [remap evil-join-whitespace] #'paxedit-compress
          :n "g S"                        #'paxedit-format-1
          :n "g k"                        #'paxedit-backward-up
          :n "g j"                        #'paxedit-backward-end)))

(require 'general)
(general-evil-setup t)

(nmap
  ">" (general-key-dispatch 'evil-shift-right
        "e" 'paxedit-transpose-forward
        ")" 'sp-forward-slurp-sexp
        "(" 'sp-backward-barf-sexp
        "I" 'aspen/insert-at-sexp-end
        ;; "a" 'grfn/insert-at-form-end
        ))

(nmap
  "<" (general-key-dispatch 'evil-shift-left
        "e" 'paxedit-transpose-backward
        ")" 'sp-forward-barf-sexp
        "(" 'sp-backward-slurp-sexp
        "I" 'aspen/insert-at-sexp-start
        ;; "a" 'grfn/insert-at-form-start
        ))
#+end_src

*** Eval functions
#+begin_src elisp :tangle yes
(use-package! predd)

(predd-defmulti eval-sexp (lambda (form) major-mode))

(predd-defmethod eval-sexp 'clojure-mode (form)
  (cider-interactive-eval form))

(predd-defmethod eval-sexp 'emacs-lisp-mode (form)
  (pp-eval-expression form))

(predd-defmulti eval-sexp-region (lambda (_beg _end) major-mode))

(predd-defmethod eval-sexp-region 'clojure-mode (beg end)
  (cider-interactive-eval nil nil (list beg end)))

(predd-defmethod eval-sexp-region 'emacs-lisp-mode (beg end)
  (pp-eval-expression (read (buffer-substring beg end))))

(predd-defmulti eval-sexp-region-context (lambda (_beg _end _context) major-mode))

(predd-defmethod eval-sexp-region-context 'clojure-mode (beg end context)
  (cider--eval-in-context (buffer-substring beg end)))

(defun pp-eval-context-region (beg end context)
  (interactive "r\nxContext: ")
  (let* ((inner-expr (read (buffer-substring beg end)))
         (full-expr (list 'let* context inner-expr)))
    (pp-eval-expression full-expr)))

(predd-defmethod eval-sexp-region-context 'emacs-lisp-mode (beg end context)
  (pp-eval-context-region beg end context))

(predd-defmulti preceding-sexp (lambda () major-mode))

(predd-defmethod preceding-sexp 'clojure-mode ()
  (cider-last-sexp))

(predd-defmethod preceding-sexp 'emacs-lisp-mode ()
  (elisp--preceding-sexp))

(defun eval-sexp-at-point ()
  (interactive)
  (let ((bounds (bounds-of-thing-at-point 'sexp)))
    (eval-sexp-region (car bounds)
                      (cdr bounds))))

(defun eval-last-sexp (_)
  (interactive)
  (eval-sexp (preceding-sexp)))

;;;

(defun cider-insert-current-sexp-in-repl (&optional arg)
  "Insert the expression at point in the REPL buffer.
If invoked with a prefix ARG eval the expression after inserting it"
  (interactive "P")
  (cider-insert-in-repl (cider-sexp-at-point) arg))

(evil-define-operator fireplace-send (beg end)
  (cider-insert-current-sexp-in-repl nil nil (list beg end)))

(defun +clojure-pprint-expr (form)
  (format "(with-out-str (clojure.pprint/pprint %s))"
          form))

(defun cider-eval-read-and-print-handler (&optional buffer)
  "Make a handler for evaluating and reading then printing result in BUFFER."
  (nrepl-make-response-handler
   (or buffer (current-buffer))
   (lambda (buffer value)
     (let ((value* (read value)))
       (with-current-buffer buffer
         (insert
          (if (derived-mode-p 'cider-clojure-interaction-mode)
              (format "\n%s\n" value*)
            value*)))))
   (lambda (_buffer out) (cider-emit-interactive-eval-output out))
   (lambda (_buffer err) (cider-emit-interactive-eval-err-output err))
   '()))

(defun cider-eval-and-replace (beg end)
  "Evaluate the expression in region and replace it with its result"
  (interactive "r")
  (let ((form (buffer-substring beg end)))
    (cider-nrepl-sync-request:eval form)
    (kill-region beg end)
    (cider-interactive-eval
     (+clojure-pprint-expr form)
     (cider-eval-read-and-print-handler))))

(defun cider-eval-current-sexp-and-replace ()
  "Evaluate the expression at point and replace it with its result"
  (interactive)
  (apply #'cider-eval-and-replace (cider-sexp-at-point 'bounds)))

;;;
#+end_src

*** Eval bindings
fireplace-esque eval binding

#+begin_src elisp :tangle yes
(evil-define-operator fireplace-eval (beg end)
  (eval-sexp-region beg end))

(evil-define-operator fireplace-replace (beg end)
  (cider-eval-and-replace beg end))

(evil-define-operator fireplace-eval-context (beg end)
  (eval-sexp-region-context beg end))

(nmap :keymaps 'cider-mode-map
  "c" (general-key-dispatch 'evil-change
        "p" (general-key-dispatch 'fireplace-eval
              "p" 'cider-eval-sexp-at-point
              "c" 'cider-eval-last-sexp
              "d" 'cider-eval-defun-at-point
              "r" 'cider-test-run-test)
        "q" (general-key-dispatch 'fireplace-send
              "q" 'cider-insert-current-sexp-in-repl
              "c" 'cider-insert-last-sexp-in-repl)
        "x" (general-key-dispatch 'fireplace-eval-context
              "x" 'cider-eval-sexp-at-point-in-context
              "c" 'cider-eval-last-sexp-in-context)
        "!" (general-key-dispatch 'fireplace-replace
              "!" 'cider-eval-current-sexp-and-replace
              "c" 'cider-eval-last-sexp-and-replace)
        "y" 'cider-copy-last-result))

;;;

(nmap :keymaps 'emacs-lisp-mode-map
  "c" (general-key-dispatch 'evil-change
        "p" (general-key-dispatch 'fireplace-eval
              "p" 'eval-sexp-at-point
              "c" 'eval-last-sexp
              "d" 'eval-defun
              "r" 'cider-test-run-test)
        "x" (general-key-dispatch 'fireplace-eval-context
              "x" 'cider-eval-sexp-at-point-in-context
              "c" 'cider-eval-last-sexp-in-context)
        "!" (general-key-dispatch 'fireplace-replace
              "!" 'cider-eval-current-sexp-and-replace
              "c" 'cider-eval-last-sexp-and-replace)
        "y" 'cider-copy-last-result))

(nmap :keymaps 'sly-mode-map
  "c" (general-key-dispatch 'evil-change
        "p" (general-key-dispatch 'sly-eval
              ;; "p" 'eval-sexp-at-point
              "c" 'sly-eval-last-expression
              "d" 'sly-eval-defun
              ;; "r" 'cider-test-run-test
              )
        ;; "x" (general-key-dispatch 'fireplace-eval-context
        ;;       "x" 'cider-eval-sexp-at-point-in-context
        ;;       "c" 'cider-eval-last-sexp-in-context
        ;;       )
        ;; "!" (general-key-dispatch 'fireplace-replace
        ;;       "!" 'cider-eval-current-sexp-and-replace
        ;;       "c" 'cider-eval-last-sexp-and-replace)
        ;; "y" 'cider-copy-last-result
        ))

#+end_src

** Coerce

#+begin_src elisp :tangle yes
(use-package! string-inflection
  :config
  (nmap "c" (general-key-dispatch 'evil-change
              "r c" (saving-excursion (string-inflection-lower-camelcase))
              "r C" (saving-excursion (string-inflection-camelcase))
              "r m" (saving-excursion (string-inflection-camelcase))
              "r s" (saving-excursion (string-inflection-underscore))
              "r u" (saving-excursion (string-inflection-upcase))
              "r -" (saving-excursion (string-inflection-kebab-case))
              "r k" (saving-excursion (string-inflection-kebab-case))
              ;; "r ." (saving-excursion (string-inflection-dot-case))
              ;; "r ." (saving-excursion (string-inflection-space-case))
              ;; "r ." (saving-excursion (string-inflection-title-case))
              )))
#+end_src

* Mode-specific config
** org-mode
#+begin_src elisp :tangle yes
(after! org
  (load! "org-config")
  (load! "org-query"))
#+end_src

*** Theme overrides

#+begin_src elisp :tangle yes
(custom-set-faces!
  `(org-drawer :foreground ,+solarized-s-base1 :bold t)
  `(org-block :foreground ,+solarized-s-base00)
  `(org-meta-line :foreground ,+solarized-s-base1 :italic t)
  `(org-document-title :foreground ,+solarized-s-base01 :height 1.3)
  `(org-done :foreground ,+solarized-green)
  `(org-headline-done :foreground ,+solarized-green)
  `(org-special-keyword :foreground ,+solarized-s-base1 :bold t)
  `(org-date :foreground ,+solarized-blue :underline t)
  `(org-table
    :foreground ,+solarized-s-base0  ; used to be green, I think I like this better?
    :italic t)
  `(org-link :foreground ,+solarized-yellow)
  `(org-todo :foreground ,+solarized-cyan)
  `(org-code :foreground ,+solarized-s-base1)
  `(org-block-begin-line :foreground ,+solarized-s-base1 :italic t)
  `(org-block-end-line :foreground ,+solarized-s-base1 :italic t)
  `(org-document-info-keyword :foreground ,+solarized-s-base1 :italic t)

  `(org-level-1 :foreground ,+solarized-red)
  `(org-level-2 :foreground ,+solarized-green)
  `(org-level-3 :foreground ,+solarized-blue)
  `(org-level-4 :foreground ,+solarized-yellow)
  `(org-level-5 :foreground ,+solarized-cyan)
  `(org-level-6 :foreground ,+solarized-violet)
  `(org-level-7 :foreground ,+solarized-magenta)
  `(org-level-8 :foreground ,+solarized-blue))
#+end_src

*** Commands
#+begin_src elisp :tangle yes
(defun grfn/insert-new-src-block ()
  (interactive)
  (let* ((current-src-block (org-element-at-point))
         (src-block-head (save-excursion
                           (goto-char (org-element-property
                                       :begin current-src-block))
                           (let ((line (thing-at-point 'line t)))
                             (if (not (s-starts-with? "#+NAME:" (s-trim line)))
                                 line
                               (forward-line)
                               (thing-at-point 'line t)))))
         (point-to-insert
          (if-let (results-loc (org-babel-where-is-src-block-result))
              (save-excursion
                (goto-char results-loc)
                (org-element-property
                 :end
                 (org-element-at-point)))
            (org-element-property :end (org-element-at-point)))))
    (goto-char point-to-insert)
    (insert "\n")
    (insert src-block-head)
    (let ((contents (point-marker)))
      (insert "\n#+END_SRC\n")
      (goto-char contents))))

(defun grfn/+org-insert-item (orig direction)
  (interactive)
  (if (and (org-in-src-block-p)
           (equal direction 'below))
      (grfn/insert-new-src-block)
    (funcall orig direction)))

(advice-add #'+org--insert-item :around #'grfn/+org-insert-item)
#+end_src
*** Bindings
#+begin_src elisp :tangle yes
(map!
 (:after org
  :n "C-c C-x C-o" #'org-clock-out
  (:leader
   "n k" #'org-archive-subtree-default)

  (:map org-capture-mode-map
   :n "g RET" #'org-capture-finalize
   :n "g \\"  #'org-captue-refile)))
#+end_src

** magit
#+begin_src elisp :tangle yes
(after! magit
  (map! :map magit-mode-map
        ;; :n "] ]" #'magit-section-forward
        ;; :n "[ [" #'magit-section-backward
        )

  (transient-define-suffix magit-commit-wip ()
    (interactive)
    (magit-commit-create '("-m" "wip")))

  (transient-append-suffix
    #'magit-commit
    ["c"]
    (list "W" "Commit WIP" #'magit-commit-wip))

  (transient-define-suffix magit-reset-head-back ()
    (interactive)
    (magit-reset-mixed "HEAD~"))

  (transient-define-suffix magit-reset-head-previous ()
    (interactive)
    (magit-reset-mixed "HEAD@{1}"))

  (transient-append-suffix
    #'magit-reset
    ["f"]
    (list "b" "Reset HEAD~"    #'magit-reset-head-back))
  (transient-append-suffix
    #'magit-reset
    ["f"]
    (list "o" "Reset HEAD@{1}" #'magit-reset-head-previous)))
#+end_src

** elisp
*** Org config mode
The minor-mode for *this file*!

#+begin_src elisp :tangle yes
(after! smartparens
  (sp-local-pair 'org-config-mode "'" "'" :actions nil)
  (sp-local-pair 'org-config-mode "`" "`" :actions nil))

(define-minor-mode org-config-mode
  "Minor-mode for tangled org .el config"
  :group 'org
  :lighter "Org-config"
  :keymap '()
  (sp-update-local-pairs 'org-config-mode))
#+end_src

*** Bindings
#+begin_src elisp :tangle yes
(map!
 (:map emacs-lisp-mode-map
  :n "g SPC" #'eval-buffer
  :n "g RET" (λ! () (ert t)) ))
#+end_src

** tuareg
*** Config

#+begin_src elisp :tangle yes

(defun aspen/tuareg-setup ()
  (setq-local sp-max-pair-length (->> '("begin" "sig" "struct")
                                      (--map (length it))
                                      (-max))
              whitespace-line-column 80))

(add-hook 'tuareg-mode-hook #'aspen/tuareg-setup)

(defun sp-tuareg-post-handler (id action context)
  (when (equal action 'insert)
    (save-excursion
      (insert "x")
      (newline)
      (indent-according-to-mode))
    (delete-char 1)))

(after! smartparens-ml
  (sp-local-pair 'tuareg-mode "module" "end" :actions nil)

  (dolist (pair-start '("begin" "sig" "struct"))
    (sp-local-pair 'tuareg-mode
                   pair-start "end"
                   :when '(("SPC" "RET" "<evil-ret>"))
                   :unless '(sp-in-string-p)
                   :actions '(insert navigate)
                   :post-handlers '(sp-tuareg-post-handler))))
nil
    #+end_src

#+begin_src elisp :tangle yes
(after! dune-mode
  (add-hook 'dune-mode-hook 'paxedit-mode))
#+end_src

*** Bindings
#+begin_src elisp :tangle yes
(map!
 (:map tuareg-mode-map
  :n "g RET" (λ! () (compile "dune build @@runtest"))
  :n "g SPC" #'dune-promote
  :n "g \\" #'utop
  :n "g y" #'merlin-locate-type
  "C-c C-f" (λ! () (compile "dune fmt"))))
#+end_src

*** Theme overrides
#+begin_src elisp :tangle yes
(custom-set-faces!
  `(tuareg-font-lock-governing-face :foreground ,+solarized-s-base01 :bold t)
  `(tuareg-font-lock-label-face :foreground ,+solarized-blue)
  `(tuareg-font-lock-constructor-face :foreground ,+solarized-yellow)
  `(tuareg-font-lock-operator-face :foreground ,+solarized-red)
  `(tuareg-font-lock-attribute-face :foreground ,+solarized-red :bold nil)
  `(tuareg-font-lock-extension-node-face :background nil :inherit 'font-lock-preprocessor-face)
  `(merlin-eldoc-occurrences-face :background ,+solarized-s-base2)
  `(merlin-type-face :background ,+solarized-s-base2)
  `(utop-prompt :foreground ,+solarized-blue)
  `(utop-frozen :foreground ,+solarized-s-base1 :italic t)
  `(vertico-group-title :foreground ,+solarized-s-base1)
  `(vertico-group-header :foreground ,+solarized-s-base1))
#+end_src

** clojure

*** Setup

#+begin_src elisp :tangle yes
(defun clojure-thing-at-point-setup ()
  (interactive)
  ;; Used by cider-find-dwim to parse the symbol at point
  (setq-local
   thing-at-point-file-name-chars
   (concat thing-at-point-file-name-chars
           "><!?")))

(defun +grfn/clojure-setup ()
  ;; (flycheck-select-checker 'clj-kondo)
  (require 'flycheck)
  (push 'clojure-cider-kibit flycheck-disabled-checkers)
  (push 'clojure-cider-eastwood flycheck-disabled-checkers)
  (push 'clojure-cider-typed flycheck-disabled-checkers)
  )

(after! clojure-mode
  (define-clojure-indent
    (PUT 2)
    (POST 2)
    (GET 2)
    (PATCH 2)
    (DELETE 2)
    (context 2)
    (checking 3)
    (match 1)
    (domonad 0)
    (describe 1)
    (before 1)
    (it 2))

  (add-hook 'clojure-mode-hook #'clojure-thing-at-point-setup)
  (add-hook 'clojure-mode-hook #'+grfn/clojure-setup))

(use-package! flycheck-clojure
  ;; :disabled t
  :after (flycheck cider)
  :config
  (flycheck-clojure-setup))

(after! clj-refactor
  (setq cljr-magic-requires :prompt
        cljr-clojure-test-declaration "[clojure.test :refer :all]"
        cljr-cljc-clojure-test-declaration"#?(:clj [clojure.test :refer :all]
:cljs [cljs.test :refer-macros [deftest is testing]])"
        )
  (add-to-list
   'cljr-magic-require-namespaces
   '("s" . "clojure.spec.alpha")))

(set-popup-rule! "^\\*cider-test-report" :size 0.4)
nil
#+end_src

*** Commands

#+begin_src elisp :tangle yes
(defun grfn/run-clj-or-cljs-test ()
  (interactive)
  (message "Running tests...")
  (cl-case (cider-repl-type-for-buffer)
    (cljs
     (cider-interactive-eval
      "(with-out-str (cljs.test/run-tests))"
      (nrepl-make-response-handler
       (current-buffer)
       (lambda (_ value)
         (with-output-to-temp-buffer "*cljs-test-results*"
           (print
            (->> value
                 (s-replace "\"" "")
                 (s-replace "\\n" "\n")))))
       nil nil nil)))
    (('clj 'multi)
     (funcall-interactively
      #'cider-test-run-ns-tests
      nil))))

(defun cider-copy-last-result ()
  (interactive)
  (cider-interactive-eval
   "*1"
   (nrepl-make-response-handler
    (current-buffer)
    (lambda (_ value)
      (kill-new value)
      (message "Copied last result (%s) to clipboard"
               (if (= (length value) 1) "1 char"
                 (format "%d chars" (length value)))))
    nil nil nil)))

#+end_src

*** Bindings


#+begin_src elisp :tangle yes
(map!
 (:after
  clojure-mode
  (:map clojure-mode-map
   :n "] f" 'forward-sexp
   :n "[ f" 'backward-sexp))

 (:after
  cider-mode
  (:map cider-mode-map
   :n "g SPC" 'cider-eval-buffer
   :n "g \\"  'cider-switch-to-repl-buffer
   :n "K"     'cider-doc
   :n "g K"   'cider-apropos
   :n "g d"   'cider-find-dwim
   :n "C-w ]" 'cider-find-dwim-other-window
   ;; :n "g RET" 'cider-test-run-ns-tests
   :n "g RET" 'grfn/run-clj-or-cljs-test
   :n "g r" #'cljr-rename-symbol

   "C-c C-r r" 'cljr-add-require-to-ns
   "C-c C-r i" 'cljr-add-import-to-ns

   (:localleader
    ;; :desc "Inspect last result" :n "i" 'cider-inspect-last-result
    ;; :desc "Search for documentation" :n "h s" 'cider-apropos-doc
    :desc "Add require to ns" :n "n r" 'cljr-add-require-to-ns
    :desc "Add import to ns" :n "n i" 'cljr-add-import-to-ns))
  (:map cider-repl-mode-map
   :n "g \\" 'cider-switch-to-last-clojure-buffer)))
 #+end_src

** rust
#+begin_src elisp :tangle yes
(defun aspen/rust-setup ()
  (interactive)
  (+evil-embrace-angle-bracket-modes-hook-h)
  (setq-local whitespace-line-column 100
              fill-column 100))

(add-hook 'rust-mode-hook #'aspen/rust-setup)
#+end_src

*** Bindings

#+begin_src elisp :tangle yes
(map!
 (:map rust-mode-map
  :n "g RET" #'lsp-rust-analyzer-run
  :n "g R" #'lsp-find-references
  :n "g d" #'lsp-find-definition
  :n "g Y" #'lsp-goto-type-definition
  (:localleader
   "m" #'lsp-rust-analyzer-expand-macro)))
#+end_src

*** Theme overrides
#+begin_src elisp :tangle yes
(custom-set-faces!
  `(rust-unsafe :foreground ,+solarized-red))
#+end_src

** common-lisp
*** Commands
#+begin_src emacs-lisp :tangle yes
(defun aspen/sly-panettone ()
  (interactive)
  (sly
   (concat
    (s-trim
     (shell-command-to-string
      "nix-build -o sbcl -E 'with import ~/code/depot {}; nix.buildLisp.sbclWith [web.panettone]'"))
    "/bin/sbcl")))

(defun aspen/setup-lisp ()
  (interactive)
  (rainbow-delimiters-mode)
  (paxedit-mode 1)
  (flycheck-mode -1))

(add-hook 'common-lisp-mode-hook #'aspen/setup-lisp)

(defun sly-run-tests ()
  (interactive)
  ;; TODO: handle other test frameworks
  (let ((orig-window (get-buffer-window)))
    (sly-eval '(fiveam:run!))
    (funcall-interactively #'sly-mrepl-sync)
    (select-window orig-window)))
#+end_src

*** Bindings

#+begin_src emacs-lisp :tangle yes
(map!
 (:map sly-mode-map
  :n "g \\" #'sly-mrepl-sync
  :n "g d" #'sly-edit-definition
  :n "K" #'sly-documentation
  :n "g SPC" #'sly-compile-and-load-file
  :n "g RET" #'sly-run-tests)

 (:map sly-mrepl-mode-map
  "C-k" #'sly-mrepl-previous-prompt
  "C-r" #'isearch-backward))
#+end_src

* Completion
** Corfu
#+begin_src emacs-lisp :tangle yes
(setopt +corfu-want-ret-to-confirm nil)

(use-package! corfu
  :demand t
  :bind (:map corfu-map
              ("TAB" . corfu-next)
              ([tab] . corfu-next)
              ("S-TAB" . corfu-previous)
              ([backtab] . corfu-previous))
  :init (setopt corfu-on-exact-match 'insert
                corfu-preselect 'prompt
                completion-cycle-threshold 1
                corfu-quit-no-match t
                corfu-quit-at-boundary t)
  :config
  (map! :map corfu-map
        :i "TAB" #'corfu-next
        :i [tab] #'corfu-next
        :i "S-TAB" #'corfu-previous
        :i [backtab] #'corfu-previous))
#+end_src

** Fuzzy search
#+begin_src emacs-lisp :tangle yes
(use-package! hotfuzz
  :after (orderless corfu)
  :config
  (setopt completion-styles '(hotfuzz basic)
          completion-ignore-case t))
#+end_src

* Email
#+begin_src elisp :tangle yes
(after! notmuch
  (setq notmuch-saved-searches
        '((:name "inbox" :query "tag:inbox tag:important not tag:trash" :key "i")
          (:name "flagged" :query "tag:flagged" :key "f")
          (:name "sent" :query "tag:sent" :key "s")
          (:name "drafts" :query "tag:draft" :key "d")

          (:name "work" :query "tag:inbox and tag:important and path:work/**"
                 :key "w")
          (:name "personal" :query "tag:inbox and tag:important and path:personal/**"
                 :key "p"))
        message-send-mail-function 'message-send-mail-with-sendmail
        message-sendmail-f-is-evil 't
        message-sendmail-envelope-from 'header
        message-sendmail-extra-arguments '("--read-envelope-from")))

(defun aspen/notmuch-sync ()
  (interactive)
  (let* ((search-buffer (current-buffer))
         (proc (start-process-shell-command
                "notmuch-sync"
                "*notmuch-sync*"
                "cd ~/mail/personal/ && gmi sync"))
         (buf (process-buffer proc)))

    (set-process-sentinel
     proc
     (lambda (proc msg)
       (internal-default-process-sentinel proc msg)
       (when (and (string= msg "finished\n"))
         (kill-buffer buf)
         (with-current-buffer search-buffer
           (when (eq major-mode 'notmuch-search-mode)
             (notmuch-refresh-this-buffer))))))

    (with-current-buffer buf
      (+popup-buffer-mode))
    (display-buffer buf '(display-buffer-at-bottom . ()))))

(set-popup-rule!
  "^\\*notmuch-sync\\*$"
  :select nil
  :quit 'other)

(map! :map notmuch-search-mode-map
      :n "g SPC" #'aspen/notmuch-sync)
#+end_src

** Bindings
#+begin_src emacs-lisp :tangle yes
(map!
 (:leader
  :desc "Email" :n "o m" #'notmuch-jump-search
  :desc "Search email" "s M" #'consult-notmuch))
#+end_src

** Theme

#+begin_src emacs-lisp :tangle yes
(custom-set-faces!
  `(notmuch-message-summary-face
    :background ,+solarized-halfway-highlight))
#+end_src

* Misc
** TVL
#+begin_src emacs-lisp :tangle yes
(require 'tvl)
#+end_src

** Matchit
#+begin_src elisp :tangle yes
(use-package! evil-matchit)
#+end_src
** Direnv
#+begin_src elisp :tangle yes
(use-package! direnv
  :config (direnv-mode))
#+end_src
** IRC
*** Connecting to IRC

#+begin_src elisp :tangle yes
(defvar irc-servers
  '("hackint"
    "libera"))

(defun irc-connect (server)
  (interactive
   (list (completing-read "Server: " irc-servers)))
  (let ((pw (-> (shell-command-to-string
                 (format "pass irccloud/%s" server))
                (s-trim)
                (s-lines)
                (-last-item)))
        (gnutls-verify-error nil))
    (erc-tls :server "bnc.irccloud.com"
             :port 6697
             :nick "aspen"
             :password (concat "bnc@"
                               (s-trim (shell-command-to-string "hostname"))
                               ":"
                               pw))))

(defun aspen/switch-to-erc-buffer-or-connect ()
  (interactive)
  (if (functionp 'erc-switch-to-buffer)
      (call-interactively #'erc-switch-to-buffer)
    (call-interactively #'irc-connect)))
#+end_src

#+begin_src elisp :tangle yes
(map! :leader "o I" #'irc-connect
      :leader "o i" #'aspen/switch-to-erc-buffer-or-connect)
#+end_src

*** IRC alerts
#+begin_src elisp :tangle yes
(use-package! alert)

(defgroup erc-alert nil
  "Alert me using alert.el for important ERC messages"
  :group 'erc)

(defcustom erc-noise-regexp
  "\\(Logging in:\\|Signing off\\|You're now away\\|Welcome back\\)"
  "This regexp matches unwanted noise."
  :type 'regexp
  :group 'erc)

(setq tvl-enabled? t)

(defun disable-tvl-notifications ()
  (interactive)
  (setq tvl-enabled? nil))

(defun enable-tvl-notifications ()
  (interactive)
  (setq tvl-enabled? t))

(defun erc-alert-important-p (info)
  (let ((message (plist-get info :message))
        (erc-message (-> info (plist-get :data) (plist-get :message)))
        (erc-channel (-> info (plist-get :data) (plist-get :channel))))
    (and erc-message
         (not (or (string-match "^\\** *Users on #" message)
                  (string-match erc-noise-regexp
                                message)))
         (or (and tvl-enabled?
                  (string-equal erc-channel "#tvl"))
             (string-match "grfn" message)))))

(comment
 last-info
 erc-noise-regexp
 (setq tvl-enabled? nil)
 )

(defun my-erc-hook (&optional match-type nick message)
  "Shows a notification, when user's nick was mentioned.
If the buffer is currently not visible, makes it sticky."
  (setq last-message message)
  (if (or (null match-type) (not (eq match-type 'fool)))
      (let (alert-log-messages)
        (alert (or message (buffer-string))
               :severity (if (string-match "grfn" (or message ""))
                             'high 'low)
               :title (or nick (buffer-name))
               :data `(:message ,(or message (buffer-string))
                                :channel ,(or nick (buffer-name)))))))

(add-hook 'erc-text-matched-hook 'my-erc-hook)
(add-hook 'erc-insert-modify-hook 'my-erc-hook)

(defun my-erc-define-alerts (&rest ignore)
  ;; Unless the user has recently typed in the ERC buffer, highlight the fringe
  (alert-add-rule
   :status   '(buried visible idle)
   :severity '(moderate high urgent)
   :mode     'erc-mode
   :predicate
   #'(lambda (info)
       (and (not (eq (current-buffer) (plist-get info :buffer)))
            (string-match "grfn:" (plist-get info :message))))
   :persistent
   #'(lambda (info)
       ;; If the buffer is buried, or the user has been idle for
       ;; `alert-reveal-idle-time' seconds, make this alert
       ;; persistent.  Normally, alerts become persistent after
       ;; `alert-persist-idle-time' seconds.
       (memq (plist-get info :status) '(buried idle)))
   :style 'message
   :continue t)

  (alert-add-rule
   :status 'buried
   :mode   'erc-mode
   :predicate #'erc-alert-important-p
   :style 'libnotify
   :append t)

  (alert-add-rule
   :status 'buried
   :mode   'erc-mode
   :predicate #'erc-alert-important-p
   :style 'message
   :append t)

  (alert-add-rule
   :mode 'erc-mode
   :predicate #'erc-alert-important-p
   :style 'log
   :append t)

  (alert-add-rule :mode 'erc-mode :style 'ignore :append t))

(add-hook 'erc-connect-pre-hook 'my-erc-define-alerts)
#+end_src

*** Don't send ~:q~, etc, to the server
#+begin_src elisp :tangle yes
(defun fix-irc-message (msg)
  (let ((msg (s-trim msg)))
    (if (string-equal msg ":q") "" msg)))
(advice-add #'erc-user-input :filter-return #'fix-irc-message)
#+end_src

*** Theme overrides
#+begin_src elisp :tangle yes
(custom-set-faces!
  `(erc-button :foreground ,+solarized-blue))
#+end_src

*** TODO Nick rainbow colors
Stole this from https://github.com/jtdaugherty/emacs-config/blob/master/common/erc-nick-colors.el.

IT doesn't work though :(

#+begin_src elisp :tangle yes
(setq nick-face-list '())

;; Define the list of colors to use when coloring IRC nicks.
(setq-default erc-colors-list (list +solarized-yellow
                                    +solarized-orange
                                    +solarized-red
                                    +solarized-magenta
                                    +solarized-violet
                                    +solarized-blue
                                    +solarized-cyan
                                    +solarized-green))

(defun build-nick-face-list ()
  "build-nick-face-list builds a list of new faces using the
foreground colors specified in erc-colors-list.  The nick faces
created here will be used to format IRC nicks."
  (let ((i -1))
    (setq nick-face-list
          (mapcar
           (lambda (COLOR)
             (setq i (1+ i))
             (list (custom-declare-face
                    (make-symbol (format "erc-nick-face-%d" i))
                    (list (list t (list :foreground COLOR)))
                    (format "Nick face %d" i))))
           erc-colors-list))))

(defun erc-insert-nick-colors ()
  "This insert-modify hook looks for nicks in new messages and
computes md5(nick) and uses substring(md5_value, 0, 4) mod (length
nick-face-list) to index the face list and produce the same face for a
given nick each time it is seen.  We get a lot of collisions this way,
unfortunately, but it's better than some other methods I tried.
Additionally, if you change the order or size of the erc-colors-list,
you'll change the colors used for nicks."
  (if (null nick-face-list) (build-nick-face-list))
  (save-excursion
    (goto-char (point-min))
    (if (looking-at "<\\([^>]*\\)>")
        (let ((nick (match-string 1)))
          (put-text-property (match-beginning 1) (match-end 1)
                             'face (nth
                                    (mod (string-to-number
                                          (substring (md5 nick) 0 4) 16)
                                         (length nick-face-list))
                                    nick-face-list))))))

;; This adds the ERC message insert hook.
(add-hook 'erc-insert-modify-hook 'erc-insert-nick-colors)
#+end_src

* Hacks
Not having this breaks elisp documentation :(
#+begin_src elisp :tangle yes
(defvar elisp-demos-user-files nil)
#+end_src