path: root/custom/jao-custom-programming.el

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

;;; Programming
;;;; 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
  :bind (:map eglot-mode-map (("C-h ." . jao-eldoc-toggle))))

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

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

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

;;;; flymake
(use-package flymake
  :ensure t
  :custom ((flymake-mode-line-format '(" " flymake-mode-line-counters)))
  :config
  (jao-define-attached-buffer "^\\*Flymake diagnostics .*\\*\\'")

  (transient-define-prefix jao-transient-flymake ()
    ["Flymake"
     ("d" "show diagnostics" flymake-show-buffer-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)])

  :bind (:map flymake-mode-map (("M-m" . jao-transient-flymake))))

;;;; workarounds
(setq c-type-finder-time-slot nil)

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

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

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

(defun jao-cider-test-ns (ns)
  (let ((parts (string-split ns "\\.")))
    (if (string= "test" (cadr parts))
        ns
      (mapconcat #'identity (cons (car parts) (cons "test" (cdr parts))) "."))))

(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 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-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-test-infer-test-ns #'jao-cider-test-ns
              cider-use-fringe-indicators nil
              cider-use-overlays nil
              clojure-docstring-fill-column 72
              nrepl-prompt-to-kill-server-buffer-on-quit nil)
  :bind (("<f3>" . cider-selector)))

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

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

;;;; Javascript

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

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