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

;;; Tools
;;;; eldoc
(use-package eldoc
  :init (setq eldoc-minor-mode-string nil
              eldoc-idle-delay 0.1
              eldoc-echo-area-display-truncation-message nil
              eldoc-echo-area-use-multiline-p 5
              eldoc-echo-area-prefer-doc-buffer 'maybe
              eldoc-display-functions '(eldoc-display-in-echo-area))
  :config (global-eldoc-mode 1))

(defun jao-eldoc-toggle ()
  "Toggle eldoc's documentation buffer."
  (interactive)
  (let ((buffer (eldoc-doc-buffer)))
    (if-let* ((w (and buffer (get-buffer-window buffer))))
        (delete-window w)
      (eldoc-doc-buffer t))))

(add-to-list 'display-buffer-alist
             '("\\*eldoc\\( .*\\)?\\*"
               (display-buffer-reuse-window)
               (dedicated . t)))

;;;; automatic modes
(add-to-list 'auto-mode-alist '("\\.mix\\'" . hexl-mode))
(add-to-list 'auto-mode-alist '("\\.m4\\'" . m4-mode))
(add-to-list 'auto-mode-alist '("\\.am\\'" . makefile-mode))
(add-to-list 'auto-mode-alist '("\\.pl\\'\\|\\.pm\\'" . cperl-mode))

;;;; symbol overlay
(use-package symbol-overlay
  :ensure t
  :config
  (defun jao-symbol-reveal (&rest _)
    (when outline-minor-mode (outline-show-entry)))
  (advice-add 'symbol-overlay-basic-jump :after 'jao-symbol-reveal)

  (defun jao-symbol-put-and-next ()
    (interactive)
    (symbol-overlay-put)
    (symbol-overlay-jump-next))

  (defun jao-symbol-put-and-prev ()
    (interactive)
    (symbol-overlay-put)
    (symbol-overlay-jump-prev))

  :bind (:map prog-mode-map (("M-i" . symbol-overlay-put)
                             ("M-n" . jao-symbol-put-and-next)
                             ("M-p" . jao-symbol-put-and-prev)))
  :hook (prog-mode . symbol-overlay-mode)
  :diminish " ^")

;;;; eglot
(use-package eglot
  :init ;; (setq eglot-ignored-server-capabilites '(:inlayHintProvider))
  (defun jao-eglot-managed-mode-hook ()
    (eglot-inlay-hints-mode -1)
    (eglot-semantic-tokens-mode -1)
    (setq-local eldoc-display-functions '(eldoc-display-in-buffer)))
  (setq eglot-events-buffer-config '(:size 1000 :format full)
        eglot-autoshutdown t)
  :config
  ;; :config (add-to-list 'eglot-stay-out-of 'flymake)
  :hook (eglot-managed-mode . jao-eglot-managed-mode-hook)
  :bind (:map eglot-mode-map (("C-h ." . jao-eldoc-toggle)
                              ("C-c a" . eglot-code-actions)
                              ("C-c r" . eglot-rename))))

;;;; paredit and parens
(require 'paren)
(show-paren-mode t)
(setq show-paren-context-when-offscreen t
      show-paren-when-point-inside-paren nil)

(use-package paredit
  :ensure t
  :commands paredit-mode
  :hook ((pie-mode . paredit-mode)
         (scheme-mode . paredit-mode)
         (clojure-mode . paredit-mode)
         (emacs-lisp-mode . paredit-mode)
         ;; (eval-expression-minibuffer-setup . paredit-mode)
         (lisp-interaction-mode . disable-paredit-mode))
  :diminish ((paredit-mode . " þ")))

(use-package smartparens
  :ensure t
  :bind (:map smartparens-mode-map
              ("C-)" . sp-forward-slurp-sexp)))

;;;; diff/ediff
(setq ediff-split-window-function 'split-window-horizontally)
(setq ediff-make-buffers-readonly-at-startup nil)
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
(setq ediff-keep-variants nil)

;;;; flymake
(use-package flymake
  :ensure t
  :custom ((flymake-mode-line-format '(" " flymake-mode-line-counters)))
  :config

  (transient-define-prefix jao-transient-flymake ()
    ["Flymake"
     ("d" "show diagnostics" flymake-show-buffer-diagnostics)
     ("D" "show project diagnostics" flymake-show-project-diagnostics)
     ("i" "show diagnostic" flymake-show-diagnostic)
     ("n" "next error" flymake-goto-next-error)
     ("p" "previous error" flymake-goto-prev-error)
     ("c" "consult flymake" consult-flymake)])

  (add-to-list 'display-buffer-alist
               '("^\\*Flymake diagnostics .*\\*\\'"
                 (display-buffer-reuse-window jao-display-below-eldoc)
                 (height . 0.3)
                 (dedicated . t)))

  :bind (:map flymake-mode-map (("M-m" . jao-transient-flymake)
                                ("M-n" . flymake-goto-next-error)
                                ("M-p" . flymake-goto-prev-error))))

;;;; outline minor mode
(use-package outline
  :init (setq outline-minor-mode-use-buttons nil
              outline-minor-mode-use-margins nil
              outline-minor-mode-cycle t))

(defvar-local jao-outline-folded nil)
(dolist (v '(4 5 outline-show-only-headings))
  (add-to-list 'safe-local-variable-values `(outline-default-state . ,v)))

(defun jao-outline-minor-mode-hide-all (&optional arg)
  (interactive "P")
  (outline-hide-sublevels (if arg 5 4)))

(defun jao-outline-minor-expand-all ()
  (when jao-outline-minor-mode (outline-show-all)))

(defun jao-outline-minor-mode-toogle-fold (&optional arg)
  (interactive "P")
  (if (setq jao-outline-folded (not jao-outline-folded))
      (jao-outline-minor-mode-hide-all arg)
    (jao-outline-minor-expand-all)))

(use-package outline-minor-faces
  :ensure t
  :after outline)

(define-minor-mode jao-outline-minor-mode
  "Minor outline mode for programming languages"
  :lighter ""
  :keymap `((,(kbd "C-c C-n") . outline-next-visible-heading)
            (,(kbd "C-c C-p") . outline-previous-visible-heading)
            (,(kbd "C-c o") . consult-outline)
            (,(kbd "<f3>") . jao-outline-minor-mode-toogle-fold))
  (if jao-outline-minor-mode
      (progn (setq-local outline-level #'outline-level
                         outline-regexp (format "[%s]\\{3,\\} " comment-start))
             (outline-minor-mode 1)
             (outline-minor-faces-mode 1))
    (outline-minor-mode -1)
    (outline-minor-faces-mode -1)))

(add-hook 'find-function-after-hook #'jao-outline-minor-expand-all)



;;; Build tools
;;;; compilation
;;;;; compilation mode options
(require 'compile)
(setq compilation-scroll-output t)
(setq compilation-error-regexp-alist
      (remove 'omake compilation-error-regexp-alist))
;; (add-hook 'compilation-mode-hook #'visual-line-mode)

;;;;; mode line (no "Compiling"!)
(require 'compile)
(diminish 'compilation-minor-mode " ‡")
(when (< emacs-major-version 27)
  (setcdr (assq 'compilation-in-progress minor-mode-alist) '(" ‡")))
(when (> emacs-major-version 26)
  (setcdr (assq 'compilation-in-progress mode-line-modes) '("‡ ")))

;;;;; colorizing compilation buffer
(setq compilation-message-face 'default)
(require 'ansi-color)
(defun endless/colorize-compilation ()
  "Colorize from `compilation-filter-start' to `point'."
  (let ((inhibit-read-only t))
    (ansi-color-apply-on-region
     compilation-filter-start (point))))

(add-hook 'compilation-filter-hook #'endless/colorize-compilation)

;;;;; compilation commands
(use-package jao-compilation
  :commands jao-compilation-setup
  :bind (("C-c C" . compile)
         ("C-c c" . jao-compile)))
(jao-compilation-setup)

;;;;; next error
(setq next-error-find-buffer-function
      #'next-error-buffer-on-selected-frame
      next-error-verbose t)


;;;; cmake
(use-package cmake-mode :ensure t)

(use-package eldoc-cmake
  :ensure t
  :after cmake-mode
  :hook ((cmake-mode . eldoc-cmake-enable)))

(use-package project-cmake :ensure t)



;;;; just
(use-package just-mode
  :ensure t)

(use-package justl
  :after just-mode
  :ensure t
  :bind (:map just-mode-map (("C-c l" . justl))))


;;; Programming languages
;;;; Elisp
(add-hook 'emacs-lisp-mode-hook #'jao-outline-minor-mode)

(use-package edit-list :ensure t)
;; (use-package package-lint :ensure t)
;; (use-package tree-inspector :ensure t)

(defun elisp-disassemble (function)
  (interactive (list (function-called-at-point)))
  (disassemble function))

(defun elisp-pp (sexp)
  (with-output-to-temp-buffer "*Pp Eval Output*"
    (pp sexp)
    (with-current-buffer standard-output
      (emacs-lisp-mode))))

(defun elisp-macroexpand (form)
  (interactive (list (form-at-point 'sexp)))
  (elisp-pp (macroexpand form)))

(defun elisp-macroexpand-all (form)
  (interactive (list (form-at-point 'sexp)))
  (elisp-pp (macroexpand-all form)))

(defun elisp-find-definition (name)
  (interactive (list (thing-at-point 'symbol)))
  (cond (name
         (let ((symbol (intern-soft name))
               (search (lambda (fun sym)
                         (let* ((r (save-excursion (funcall fun sym)))
                                (buffer (car r))
                                (point (cdr r)))
                           (cond ((not point)
                                  (error "Found no definition for %s in %s"
                                         name buffer))
                                 (t
                                  (switch-to-buffer buffer)
                                  (goto-char point)
                                  (recenter 1)))))))
           (cond ((fboundp symbol)
                  (xref-push-marker-stack)
                  (funcall search 'find-function-noselect symbol))
                 ((boundp symbol)
                  (xref-push-marker-stack)
                  (funcall search 'find-variable-noselect symbol))
                 (t
                  (message "Symbol not bound: %S" symbol)))))
        (t (message "No symbol at point"))))


(defun elisp-bytecompile-and-load ()
  (interactive)
  (or buffer-file-name
      (error "The buffer must be saved in a file first"))
  (require 'bytecomp)
  ;; Recompile if file or buffer has changed since last compilation.
  (when  (and (buffer-modified-p)
              (y-or-n-p (format "save buffer %s first? " (buffer-name))))
    (save-buffer))
  (let ((filename (expand-file-name buffer-file-name)))
    (with-temp-buffer
      (byte-compile-file filename))))

(use-package elisp-mode
  :bind (:map emacs-lisp-mode-map
              (("C-c C-M" . emacs-lisp-macroexpand)
               ("C-c C-m" . elisp-macroexpand-all)
               ("C-c C-k" . elisp-bytecompile-and-load)
               ;; ("C-c C-p" . pp-eval-last-sexp)
               ("M-." . elisp-find-definition)
               ("M-," . pop-tag-mark)
               ("C-c <" . lc-show-package-summary))))

;;;; Rust

(use-package jao-rust :demand t)

(use-package rust-mode
  :ensure t
  :hook (rust-mode . jao-rust-mode-hook)
  :config
  (setq rust-mode-treesitter-derive t)
  (use-package smartparens-rust :demand t)

  (defun jao-rust-mode-hook ()
    ;; (smartparens-mode 1)
    ;; (hs-minor-mode)
    (setq-local completion-styles '(basic substring partial-completion emacs22)))

  :bind (:map rust-mode-map
              ("C-c C" . jao-rust-open-cargo)
              ("C-c m" . jao-transient-flymake)
              ("C-c C-e" . consult-eglot-symbols)))

(use-package rustic
  :ensure t
  :after (rust-mode)
  :config
  (setq rustic-format-on-save nil
        rustic-lsp-client 'eglot
        rustic-lsp-check-command "clippy")
  ;; rustic's settings for eglot are not working properly, we can just set our
  ;; server afterwards and leave that alone.
  (with-eval-after-load 'eglot
    (add-to-list 'eglot-server-programs
                 `((rust-mode rustic-mode)
                   . ("rust-analyzer"
                      :initializationOptions
                      (:check
                       (:command "clippy")
                       :procMacro
                       (:enable t :ignored (:async-trait ["async-trait"]))
                       :diagnostics
                       (:disabled ["macro-error"]))))))
  :custom
  (rustic-cargo-use-last-stored-arguments nil)
  (rustic-cargo-test-runner 'nextest)
  (rustic-cargo-nextest-exec-command '("nextest" "run" "--color=never" "--show-progress=none"))
  :bind (:map rustic-mode-map (("C-c d" . jao-rust-build-doc)
                               ("C-c t d" . jao-rust-test-doctests)
                               ("C-c t g" . jao-rust-goto-tests)
                               ("C-c t w" . jao-rust-test-workspace)
                               ("C-c t m" . jao-rust-test-module)
                               ("C-c t r" . jao-rust-retest)
                               ("C-c t t" . jao-rust-test-current))))

(use-package rust-playground
  :ensure t)

(add-to-list 'display-buffer-alist
             '("\\*\\(cargo-.+\\|rustic-compilation\\)\\*"
               (display-buffer-reuse-window jao-display-below-eldoc)
               (height . 0.5)))

;;;; Clojure
(use-package clojure-mode
  :ensure t
  :hook (clojure-mode . jao-clojure--fix-things)
  :config
  (defun jao-clojure--fix-things ()
    (setq-local completion-styles '(basic partial-completion emacs22))
    (eldoc-mode 1)
    (setq mode-name "λ"))

  (defun jao-kaocha-file-name ()
    (let* ((filename (match-string 2))
           (path (replace-regexp-in-string "\\." "/" (match-string 1))))
      (substring-no-properties (concat "test/" path filename))))

  (defconst jao-kaocha-compilation-error
    '(kaocha-error
      "^FAIL in \\(.+\\.\\)[^ ]+ (\\([^:]+\\.clj[cs]?\\):\\([0-9]+\\))"
      jao-kaocha-file-name 3))

  (use-package compile
    :config
    (add-to-list 'compilation-error-regexp-alist-alist
                 jao-kaocha-compilation-error)))

(use-package jao-clojure
  :demand t
  :after cider-test
  :bind (:map clojure-mode-map (("C-c o" . jao-clojure-other-file))))

(use-package cider
  :ensure t
  :commands cider-mode
  :init (setq cider-annotate-completion-candidates t
              cider-auto-select-error-buffer nil
              cider-auto-select-test-report-buffer nil
              cider-clojure-cli-aliases ":test"
              cider-eldoc-display-for-symbol-at-point t
              cider-eldoc-ns-function #'identity ;; #'cider-last-ns-segment
              cider-enrich-classpath nil
              cider-lein-parameters "repl :headless :host localhost"
              cider-mode-line  " ÷"
              cider-prompt-for-symbol nil
              cider-repl-history-file
              (expand-file-name "~/.emacs.d/cache/cider.history")
              cider-repl-pop-to-buffer-on-connect nil
              cider-repl-use-pretty-printing t
              cider-show-error-buffer 'except-in-repl
              cider-test-show-report-on-success nil
              cider-use-fringe-indicators nil
              cider-use-overlays nil
              clojure-docstring-fill-column 72
              nrepl-prompt-to-kill-server-buffer-on-quit nil))

(with-eval-after-load "cider-test"
  (advice-add 'cider-scale-background-color :override
              (lambda () (frame-parameter nil 'background-color)))
  (setq cider-test-items-background-color
        (frame-parameter nil 'background-color)))

(use-package cider-macroexpansion
  :after cider
  :diminish " µ")

;;;; Geiser
(defun jao-org--set-geiser-impl () (setq-local geiser-repl--impl 'guile))
(add-hook 'org-mode-hook #'jao-org--set-geiser-impl)

(jao-load-path "geiser")
;; (package-vc-install-from-checkout ...)
(use-package geiser
  :demand t
  :init
  (setq geiser-repl-history-filename "~/.emacs.d/cache/geiser-history"
        geiser-repl-startup-time 20000
        geiser-debug-auto-display-images t
        geiser-log-verbose t)
  :config
  (dolist (m '(geiser-repl-mode geiser-doc-mode geiser-debug-mode))
    (jao-define-attached-buffer `(major-mode . ,m) 0.4)))

(jao-load-path "geiser-guile")
(use-package geiser-guile)

(jao-load-path "geiser-chez")
(use-package geiser-chez
  :init (setq geiser-chez-binary (jao-d-l "chez" "scheme")))

;; (jao-load-path "geiser/mit")
;; (use-package geiser-mit)

;; (jao-load-path "geiser/chicken")
;; (use-package geiser-chicken)

;; (jao-load-path "geiser/chibi")
;; (use-package geiser-chibi)

;; (jao-load-path "geiser/gambit")
;; (use-package geiser-gambit)

;; (jao-load-path "geiser/gauche")
;; (use-package geiser-gauche)

;;;; Haskell
;;;;; packages
;; (jao-load-path "haskell-mode")

(use-package haskell-mode
  :ensure t
  :custom
  ((inferior-haskell-find-project-root t)
   (haskell-check-remember-last-command-p nil)
   (haskell-completing-read-function 'completing-read)
   (haskell-font-lock-symbols nil)
   (haskell-hoogle-command "hoogle")
   (haskell-interactive-popup-errors t)
   (haskell-process-auto-import-loaded-modules t)
   (haskell-process-log t)
   (haskell-process-suggest-remove-import-lines t)
   (haskell-process-suggest-hoogle-imports t)
   (haskell-process-type 'cabal-repl)
   (haskell-process-use-presentation-mode t)
   (haskell-stylish-on-save nil)
   (haskell-tags-on-save t))

  :init
  ;; For use with M-x align
  (require 'align)
  (add-to-list 'align-rules-list
               '(haskell-types
                 (regexp . "\\(\\s-+\\)\\(::\\|∷\\)\\s-+")
                 (modes quote (haskell-mode haskell-literate-mode))))
  (add-to-list 'align-rules-list
               '(haskell-assignment
                 (regexp . "\\(\\s-+\\)=\\s-+")
                 (modes quote (haskell-mode haskell-literate-mode))))
  (add-to-list 'align-rules-list
               '(haskell-arrows
                 (regexp . "\\(\\s-+\\)\\(->\\|→\\)\\s-+")
                 (modes quote (haskell-mode haskell-literate-mode))))
  (add-to-list 'align-rules-list
               '(haskell-left-arrows
                 (regexp . "\\(\\s-+\\)\\(<-\\|←\\)\\s-+")
                 (modes quote (haskell-mode haskell-literate-mode))))

  :config
  (defun jao-haskell-hoogle (no-info)
    (interactive "P")
    (haskell-hoogle (format "%s" (haskell-ident-at-point)) (not no-info)))

  (put 'haskell-process-args-cabal-repl
       'safe-local-variable
       (apply-partially #'seq-every-p #'stringp))

  (defun jao-haskell-eldoc (cb)
    (let ((msg (or (haskell-doc-current-info--interaction t)
                   (haskell-doc-sym-doc (haskell-ident-at-point))
                   "")))
      (funcall cb (replace-regexp-in-string "[\n ]+" " " msg))))

  (setq tags-revert-without-query t)

  (defun jao-haskell-mode ()
    (require 'haskell-doc)
    (setq-local eldoc-documentation-function 'eldoc-documentation-default
                eldoc-documentation-functions '(jao-haskell-eldoc))
    (eldoc-mode))

  (dolist (h '(jao-haskell-mode
               haskell-decl-scan-mode
               haskell-indentation-mode
               interactive-haskell-mode))
    (add-hook 'haskell-mode-hook h))

  (add-hook 'haskell-presentation-mode-hook (lambda () (whitespace-mode -1)))

  :bind (:map haskell-mode-map
              (("C-c C-d" . jao-haskell-hoogle)
               ("C-c C-s" . haskell-session-change-target)
               ("C-c h" . haskell-hoogle)
               ("C-c t" . haskell-doc-show-type)
               ("C-c C-e" . haskell-command-insert-language-pragma)
               ("C-M-n" . flymake-goto-next-error)
               ("C-M-p" . flymake-goto-prev-error)
               ("<f3>" . haskell-session-kill))))

(jao-when-linux
 (use-package hlint-refactor
   :ensure t
   :after haskell-mode
   :hook ((haskell-mode . hlint-refactor-mode))
   :bind (:map haskell-mode-map (("C-M-h" . 'hlint-refactor-refactor-at-point)
                                 ("C-M-S-h" . 'hlint-refactor-refactor-buffer)))
   :diminish)

 (use-package flymake-hlint
   :ensure t
   :after haskell-mode
   :hook ((haskell-mode . flymake-hlint-load))))

(use-package consult-hoogle
  :ensure t)

(require 'haskell)

(diminish 'interactive-haskell-mode " λ")
(diminish 'haskell-doc-mode)
(diminish 'haskell-decl-scan-mode)

(jao-define-attached-buffer "\\*hoogle\\*.*")
(jao-define-attached-buffer '(major-mode . haskell-interactive-mode) 0.33)
(jao-define-attached-buffer '(major-mode . haskell-presentation-mode) 0.25)

;;;;; transient
(jao-transient-major-mode haskell
  ["Imports"
   ("in" "Navigate imports" haskell-navigate-imports)
   ("if" "Format imports" haskell-mode-format-imports)
   ("is" "Sort imports" haskell-sort-imports)
   ("ia" "Align imports" haskell-align-imports)]
  ["Session"
   ("s" "Change the session's target" haskell-session-change-target)]
  ["Code"
   ("e" "insert language pragma" haskell-command-insert-language-pragma)
   ("v" "visit cabal file" haskell-cabal-visit-file)
   ("h" "hoogle" jao-haskell-hoogle)
   ("t" "show type" haskell-doc-show-type)]
  ["Flymake"
   ("n" "next error" flymake-goto-next-error)
   ("p" "previous error" flymake-goto-prev-error)])

;;;; Pie
;; (jao-load-path "pie")
;; (use-package pie
;;   :commands (pie-mode))

;;;; Prolog
;; (use-package ediprolog :ensure t)

(use-package prolog
  :disabled t
  :ensure t
  :commands (run-prolog prolog-mode mercury-mode)
  :init (progn
          (setq prolog-system 'swi)
          (add-to-list 'auto-mode-alist '("\\.pl$" . prolog-mode))
          (setq prolog-consult-string '((t "[%f].")))
          (setq prolog-program-name
                '(((getenv "EPROLOG") (eval (getenv "EPROLOG")))
                  (eclipse "eclipse")
                  (mercury nil)
                  (sicstus "sicstus")
                  (swi "swipl")
                  (t "prolog")))))

;;;; Python
(use-package virtualenvwrapper
  :ensure t
  :config
  (venv-initialize-eshell)
  (jao-compilation-env "VIRTUAL_ENV"))

(use-package uv-mode
  :ensure t
  :hook (python-mode . uv-mode-auto-activate-hook))

(use-package pyinspect
  :ensure t)

(use-package python
  :ensure t
  :init
  (setq-default eglot-workspace-configuration
                '((:python . (:analysis (:typeCheckingMode "off")))))
  (setq python-shell-interpreter "uv"
        ;; python-shell-interpreter-args "run ipython -i --simple-prompt"
        python-shell-interpreter-args "run python -i")
  (defun jao-python-mode-hook ()
    (setq-local eglot-prefer-plaintext t)
    (eglot-ensure))

  ;; (with-eval-after-load 'eglot
  ;;   (add-to-list 'eglot-server-programs
  ;;                '((python-base-mode :language-id "python") . ("ty" "server"))))

  (defun jao-inferior-python-mode-hook ()
    (setq-local comint-input-ring-file-name "~/.emacs.d/cache/python_history")
    (comint-read-input-ring 'silent)
    (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t))

  :hook ((python-base-mode . jao-python-mode-hook)
         (inferior-python-mode . jao-inferior-python-mode-hook))

  :bind (:map inferior-python-mode-map
              ("M-p" . comint-previous-matching-input-from-input)
              ("M-n" . comint-next-matching-input-from-input)))

;;;; Javascript

(use-package typescript-mode
  :ensure t
  :custom ((typescript-indent-level 2)))
;;;; Applescript

(jao-when-darwin
 (use-package ob-applescript
   :after org
   :ensure t
   :demand t)

 (use-package apples-mode
   :ensure t
   :init
   (add-to-list 'auto-mode-alist
                '("\\.\\(applescri\\|sc\\)pt\\'" . apples-mode))))

;;; -
(provide 'jao-custom-programming)
