;;; -*- lexical-binding: t -*-

;; Time-stamp: <2025-06-25 20h02 BST (anker)>

;; ----------------------------------------------------------------------------
;; Lisp helpers

(defvar lh-pairs '(("(" . ")")
                   ("[" . "]")
                   ("{" . "}")
                   ("<" . ">")
                   ("\"" . "\"")))

(defun lh-forward-delim ()
  (interactive)
  (save-match-data
    (re-search-forward
     (regexp-opt (mapcar #'cdr lh-pairs)))))

(defun lh-backward-delim ()
  (interactive)
  (save-match-data
    (re-search-backward
     (regexp-opt (mapcar #'car lh-pairs)))))

(defun lh-matching-delim ()
  (interactive)
  (cond
   ((looking-at (regexp-opt (mapcar #'car lh-pairs)))
    (forward-sexp))
   ((looking-back (regexp-opt (mapcar #'cdr lh-pairs)) nil)
    (backward-sexp))
   (t (backward-up-list 1 t t))))

(defun lh-slurp-forward ()
  (interactive)
  (corral-shift-forward ?\( ?\)))

(defun lh-slurp-backward ()
  (interactive)
  (corral-shift-backward ?\( ?\)))

(defun lh-open-parentheses-dwim (arg)
  (interactive "P")
  (if (or (= (line-beginning-position) (point))
          (looking-at "\\Sw")) (insert-parentheses arg)
    (backward-sexp)
    (insert-parentheses 1)))

(defun lh-end-of-defun (arg)
  (interactive "P")
  (end-of-defun arg)
  (re-search-backward ")")
  (forward-char))

(defun lh-avy-open-paren ()
  (interactive)
  (avy-goto-char ?\( ))

(defun lh-avy-close-paren ()
  (interactive)
  (avy-goto-char ?\) ))

(use-package corral :ensure t)

(use-package expand-region
  :ensure
  :defer
  :config
  (setq expand-region-fast-keys-enabled t
        expand-region-contract-fast-key "c"
        expand-region-reset-fast-key "e"
        expand-region-autocopy-register "i"))

(defun make-lisp-bindings ()
  (let ((map (eval (read (format "%s-map" major-mode)))))
    (progn
      (require 'corral)
      (define-key map (kbd "M-r") 'er/expand-region)
      (define-key map (kbd "M-e") 'forward-sexp)
      (define-key map (kbd "M-a") 'backward-sexp)
      (define-key map (kbd "M-,") 'lh-backward-delim)
      (define-key map (kbd "M-.") 'lh-forward-delim)
      (define-key map (kbd "M-/") 'lh-matching-delim)
      (define-key map (kbd "C-c (") 'lh-avy-open-paren)
      (define-key map (kbd "C-c )") 'lh-avy-close-paren)
      (define-key map (kbd "(") 'lh-open-parentheses-dwim)
      (define-key map (kbd "C-c r") 'raise-sexp)
      (define-key map (kbd "C-k") 'kill-sexp)
      (define-key map (kbd "M-(") 'corral-parentheses-forward)
      (define-key map (kbd "M-)") 'corral-parentheses-backward)
      (define-key map (kbd "M-{") 'corral-braces-forward)
      (define-key map (kbd "M-}") 'corral-braces-backward)
      (define-key map (kbd "M-[") 'corral-brackets-forward)
      (define-key map (kbd "M-]") 'corral-brackets-backward)
      (define-key map (kbd "C-)") 'lh-slurp-forward)
      (define-key map (kbd "C-(") 'lh-slurp-backward)
      (define-key map (kbd "M-p") 'beginning-of-defun)
      (define-key map (kbd "M-n") 'lh-end-of-defun)
      t)))

;; ----------------------------------------------------------------------------
;; Mode configurations

(add-hook 'emacs-lisp-mode-hook
          (lambda ()
            (eldoc-mode)
            (aggressive-indent-mode)
            (make-lisp-bindings)))

(add-hook 'clojure-mode-hook
          (lambda ()
            (aggressive-indent-mode)
            (make-lisp-bindings)))

(use-package caps-lock-mode
  :load-path "~/.config/emacs/scripts/")

(use-package slime
  :ensure t
  :bind (:map slime-mode-map
              ("M-n" . nil)
              ("M-p" . nil))
  :after caps-lock-mode
  :hook ((lisp-mode . (lambda ()
                        (aggressive-indent-mode)
                        (slime-setup '(slime-fancy
                                       slime-asdf
                                       slime-banner
                                       slime-scratch
                                       slime-autodoc))
                        (slime-mode)
                        (require 'caps-lock-mode)
                        (caps-lock-mode)
                        (make-lisp-bindings)))
         (inferior-lisp-mode-hook . make-lisp-bindings))
  :config
  (setq inferior-lisp-program "sbcl")

  (require 'slime-banner)
  (setq slime-header-line-p nil
        slime-kill-without-query-p t))

(use-package geiser-guile
  :ensure t
  :defer)

(use-package geiser
  :ensure t
  :hook (scheme-mode . (lambda ()
                         (geiser-mode)
                         (aggressive-indent-mode)
                         (make-lisp-bindings))))