;;; ycp-prog.el -- My config for programming -*- lexical-binding: t -*-

;; Copyright (C) 2023 Free Software Foundation.

;; Author: Yuchen Pei <id@ypei.org>
;; Package-Requires: ((emacs "28.2"))

;; This file is part of dotfiles.

;; dotfiles is free software: you can redistribute it and/or modify it under
;; the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
;; Public License for more details.

;; You should have received a copy of the GNU Affero General Public
;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; My config for programming. Covers comint, shell, eshell, compile,
;; xref, eglot, prog-mode etc.

;;; Code:



;;; comint, shell, eshell
(my-package comint
  (setq ansi-color-for-comint-mode t)
  (setq-default comint-scroll-to-bottom-on-input t)
  (setq-default comint-scroll-to-bottom-on-output nil)
  (setq-default comint-input-autoexpand 'input)
  (setq comint-prompt-read-only t)
  (setq comint-buffer-maximum-size 9999)
  (setq comint-completion-autolist t)
  (define-key comint-mode-map (kbd "C-<up>") 'windmove-up)
  (define-key comint-mode-map (kbd "C-<down>") 'windmove-down)
  (setq comint-input-ring-size 5000)
  (setq comint-input-ignoredups t)
  (setq comint-terminfo-terminal "dumb")
  (setq comint-password-prompt-regexp
        (concat comint-password-prompt-regexp
                "\\|^BECOME password:\\s *\\'"
	              "\\|^SSH password:\\s *\\'"))
  )

(my-package shell
  (:delay 5)
  (setq shell-command-prompt-show-cwd t)
  (setq shell-input-autoexpand 'input)

  (my-keybind shell-mode-map
    "<up>" #'comint-previous-input
    "<down>" #'comint-next-input
    "C-c C-k" #'comint-clear-buffer
    "C-c C-w" #'comint-write-output)
  (setq shell-command-prompt-show-cwd t)
  (add-hook 'shell-mode-hook
            (lambda ()
              (setq comint-input-ring-file-name "~/.bash_history")))
  (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)
  )

(my-package sh-script
  (:delay 5)
  (setq sh-basic-offset 2)
  (add-to-list 'auto-mode-alist '("PKGBUILD" . sh-mode))
  (require 'executable)
  (add-hook 'after-save-hook
            #'executable-make-buffer-file-executable-if-script-p)
  )

(my-package gud
  (:delay 10)
  (require 'gdb-mi)
  (setq gdb-many-windows t)
  (setq gdb-default-window-configuration-file
        (locate-user-emacs-file "gdb-window-conf"))
  (require 'my-prog)
  (my-keybind global-map
    "C-c d q" 'my-gdb-quit
    "C-c d d" 'my-gdb
    "C-c d r" 'my-gdb-restart)
  (my-keybind gdb-frames-mode-map
    "b" 'my-gdb-frames-add-breakpoint
    "d" 'my-gdb-frames-remove-breakpoint
    "o" 'gdb-select-frame
    "s" 'my-gdb-switch-to-source-buffer
    "n" 'my-gdb-frames-select-next
    "p" 'my-gdb-frames-select-previous)
  (my-keybind gdb-breakpoints-mode-map
    "n" 'forward-line
    "p" (lambda () (interactive) (forward-line -1))
    "d" 'gdb-delete-breakpoint)
  (my-keybind gdb-threads-mode-map
    "n" 'forward-line
    "p" (lambda () (interactive) (forward-line -1)))
  (my-keybind gud-mode-map
    "C-c C-p" 'comint-previous-prompt
    "C-c C-n" 'comint-next-prompt
    "C-c C-u" 'gud-up
    "C-c C-d" 'gud-down
    "C-c C-n" 'comint-next-prompt)
  (add-hook 'gud-mode-hook 'my-gud-comint-set-prompt-regexp)
  (add-hook 'gud-mode-hook 'company-mode)
  )

(my-package my-prog
  (:delay 10)
  ;; tab-width 8 for ls etc.
  (add-hook 'shell-mode-hook 'my-set-tab-width-to-8)
  (my-keybind comint-mode-map "C-<return>"
              #'my-comint-send-input-and-return-prompt)
  (add-to-list 'my-buffer-create-functions
               '(shell-mode . my-shell-with-directory))
  (my-keybind comint-mode-map "<f2>" #'my-comint-restart)
  (add-hook 'shell-mode-hook 'my-shell-disable-company-if-remote)
  (my-keybind global-map "<f7>" #'my-shell-open-or-cycle)
  )

(my-package eshell
  (:delay 60)
  (setq eshell-modules-list
        '(eshell-alias eshell-banner eshell-basic eshell-cmpl eshell-dirs eshell-glob eshell-hist eshell-ls eshell-pred eshell-prompt eshell-script eshell-term eshell-tramp eshell-unix))
  )

(my-package bash-completion
  (:install t)
  (:delay 15)
  ;; FIXME: it is behaving weirdly in shell mode, with completion
  ;; flushed to the buffer
  ;; (bash-completion-setup)
  )

(my-package prog-mode
  (add-hook 'prog-mode-hook #'my-prog-modes-setup))

;; cmake
(my-package cmake-mode
  (:delay 60))

;;; eglot
(my-package eglot
  (:delay 10)
  (add-to-list 'eglot-server-programs
               '((php-mode phps-mode)
                 "phpactor" "language-server" "-vvv"))
  (add-hook 'before-save-hook
            #'my-eglot-format-buffer-when-managed)
  (setq-default eglot-workspace-configuration
                '((:pylsp
                   (plugins
                    (pylint
                     (enabled . t)
                     (executable . "/usr/bin/pylint"))))
                  (:haskell-language-server
                   (haskell
                    (formattingProvider . :json-false)))))
  (add-to-list 'eglot-server-programs
               '(haskell-mode
                 "haskell-language-server-wrapper" "--lsp" "--debug"))

  ;; I'm not sure why this is needed, but it throws an error if I remove it
  (cl-defmethod project-root ((project (head eglot-project)))
    (cdr project))

  (defun my-project-try-tsconfig-json (dir)
    (when-let* ((found (locate-dominating-file dir "tsconfig.json")))
      (cons 'eglot-project found)))

  (add-hook 'project-find-functions
            'my-project-try-tsconfig-json nil nil)

  (add-to-list 'eglot-server-programs
               '((typescript-mode) "typescript-language-server" "--stdio")))

(my-package cc-mode
  (:delay 5)
  (define-key c-mode-map (kbd "C-c C-c") 'compile)
  (define-key c++-mode-map (kbd "C-c C-c") 'project-compile)
  (add-to-list 'auto-mode-alist '("\\.inl\\'" . c++-mode))
  (setq c-default-style
        '((java-mode . "java")
          (awk-mode . "awk")
          (c-mode . "user")
          (c++-mode . "user")
          (other . "gnu")))
  (setq-default c-electric-flag t)
  ;; prevent backspace from untabifying
  (setq c-backspace-function 'delete-backward-char)
  (require 'my-mariadb)
  (add-to-list 'c-style-alist my-c-style-maria-spider)
  )

(my-package my-prog
  (:delay 10)
  (my-keybind global-map "C-c 8" #'my-set-tab-width-to-8)
  (add-hook 'c-mode-hook 'my-c-set-compile-command)
  (define-key c-mode-map (kbd "C-c s") 'my-c-switch-between-header-and-source)
  (define-key c++-mode-map (kbd "C-c s")
    'my-c-switch-between-header-and-source)
  (my-override bookmark-make-record)
  )

;;; emacs-lisp mode
(my-package elisp-mode
  (:delay 10)
  (my-keybind emacs-lisp-mode-map
    "C-c C-c" #'eval-buffer
    "C-c C-z" #'ielm
    "C-," #'my-insert-current-prefix)
  (add-hook 'emacs-lisp-mode-hook (lambda () (auto-fill-mode 1)))
  (my-keybind global-map
    "<f5>" #'my-toggle-debug-on-error-quit
    "C-c e e" (lambda () (interactive)
			          (find-file (locate-user-emacs-file "init.el")))
    "C-c e d" (lambda () (interactive)
			          (find-file (locate-user-emacs-file "init")))
    "C-c e m" (lambda () (interactive)
			          (find-file (locate-user-emacs-file "lisp/my")))
    "C-c e b" (lambda () (interactive)
		            (my-switch-to-buffer-matching-major-mode
                 'emacs-lisp-mode)))
  ;; for deep recursion, e.g. in radix tree
  (setq max-specpdl-size 32000)
  (add-to-list 'auto-mode-alist '("Cask\\'" . emacs-lisp-mode))
  (require 'my-prog)
  (my-keybind emacs-lisp-mode-map
    "C-M-x" #'my-eval-defun-or-region)
  )

;;; debugger
(my-package debug
  (my-override debugger-quit))

(my-package inf-lisp
  (setq inferior-lisp-program "clisp"))

(my-package data-debug
  (:delay 10)
  (my-keybind global-map
    "C-:" 'data-debug-eval-expression))

(setq debugger-stack-frame-as-list t)
(setq display-raw-bytes-as-hex t)
;; No limit in printing
(setq print-length nil
      eval-expression-print-length nil
      eval-expression-print-level nil
      edebug-print-level nil
      edebug-print-length nil)

;;; paredit
(my-package paredit
  (:install t)
  (add-hook 'emacs-lisp-mode-hook       #'enable-paredit-mode)
  (add-hook 'eval-expression-minibuffer-setup-hook #'enable-paredit-mode)
  (add-hook 'ielm-mode-hook             #'enable-paredit-mode)
  (add-hook 'lisp-mode-hook             #'enable-paredit-mode)
  (add-hook 'lisp-data-mode-hook             #'enable-paredit-mode)
  (add-hook 'lisp-interaction-mode-hook #'enable-paredit-mode)
  (add-hook 'scheme-mode-hook           #'enable-paredit-mode)
  (my-keybind paredit-mode-map
    "M-<left>" #'paredit-forward-barf-sexp
    "M-<right>" #'paredit-forward-slurp-sexp
    "C-<left>" nil
    "C-<right>" nil
    "M-?" nil
    ;; we want to reserve M-r to `previous-matching-history-element'
    ;; when in minibuffer and ielm
    "M-r" nil
    "M-i" #'paredit-raise-sexp
    "C-j" nil ;not ideal, we just want to unshadow it in lisp-interaction-mode
    "<RET>" #'paredit-newline
    "M-s" nil
    "M-o" #'paredit-splice-sexp
    "M-h" #'paredit-convolute-sexp)
  )

(my-package compile
  (:delay 15)
  (setq compilation-always-kill t
        compilation-ask-about-save nil
        compilation-context-lines 10
        compilation-scroll-output 'first-error
        compilation-skip-threshold 2)
  )

;;; flymake
(my-package flymake
  (:install t)
  (:delay 15)
  (my-keybind flymake-mode-map
    "M-n" #'flymake-goto-next-error
    "M-p" #'flymake-goto-prev-error)
  )

;;; checkdoc
(my-package checkdoc
  ;; Suppress nonsensical diagnostics like
  ;; "Probably \"%s\" should be imperative \"%s\""
  (setq checkdoc-verb-check-experimental-flag nil))

(my-package xref
  (add-hook 'xref-after-jump-hook #'which-func-update)
  ;; All those have been changed for Emacs 28
  (setq xref-show-definitions-function #'xref-show-definitions-completing-read) ; for M-.
  (setq xref-show-xrefs-function #'xref-show-definitions-buffer)
  )

(my-package js
  (:delay 60)
  (setq js-indent-level 2)
  (add-hook 'js-mode-hook 'subword-mode)
  (my-keybind js-mode-map "M-." #'xref-find-definitions)
  )

(my-package typescript-mode
  (:delay 60)
  (:install t)
  (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode))
  (setq typescript-indent-level 2)
  )

(my-package tide
  (:delay 60)
  (require 'my-tide)
  ;; aligns annotation to the right hand side
  (setq company-tooltip-align-annotations t)

  ;; formats the buffer before saving
  (add-hook 'before-save-hook 'tide-format-before-save)

  (add-hook 'typescript-mode-hook #'setup-tide-mode)
  (add-hook 'typescript-mode-hook 'subword-mode)
  )

(my-package web-mode
  (:delay 60)
  (:install t)
  (add-to-list 'auto-mode-alist '("\\.tsx\\'" . web-mode))
  (add-to-list 'auto-mode-alist '("\\.jsx\\'" . web-mode))
  (setq web-mode-content-types-alist '(("jsx" . "\\.js[x]?\\'")))
  (setq web-mode-markup-indent-offset 2)
  (setq web-mode-code-indent-offset 2)
  (add-hook 'web-mode-hook
            (lambda ()
              (when (string-equal "tsx" (file-name-extension buffer-file-name))
                (my-setup-tide-mode))))
  )

(my-package flycheck
  (:delay 60)
  (flycheck-add-mode 'typescript-tslint 'web-mode)
  )

(my-package css-mode
  (setq css-indent-offset 2))

(my-package haskell-mode
  (:install t)
  (:delay 60)
  ;; do we need to require haskell-command?
  (setq haskell-compile-command
        "ghc -Wall -ferror-spans -fforce-recomp -dynamic -c %s")
  (my-keybind haskell-mode-map "C-c C-c" #'haskell-compile)
  (setq haskell-mode-stylish-haskell-path "brittany")
  (setq haskell-stylish-on-save t)
  (my-setq-from-local haskell-hoogle-url)
  (add-hook 'haskell-mode-hook 'subword-mode)
  (add-hook 'haskell-mode-hook 'interactive-haskell-mode)
  (add-hook 'haskell-mode-hook
            (lambda ()
              (set (make-local-variable 'company-backends)
                   (append '((company-capf company-dabbrev-code))
                           company-backends))))
  (setq haskell-interactive-popup-errors t)
  (setq haskell-process-suggest-hoogle-imports t)
  (setq haskell-process-log t)
  (cl-pushnew '(haskell-process-use-ghci . t)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indent-spaces . 4)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-tags-on-save . t)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-where-post-offset . 2)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-where-pre-offset . 2)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-ifte-offset . 4)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-left-offset . 4)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-starter-offset . 1)
              safe-local-variable-values :test #'equal)
  (cl-pushnew '(haskell-indentation-layout-offset . 4)
              safe-local-variable-values :test #'equal))

(my-package hcel
  ;; fixme: credential
  (:delay 60)
  (:install t)
  ;; The official one is https://haskell-code-explorer.mfix.io
  (my-setq-from-local hcel-host)
  (my-keybind global-map
    "C-c hh" #'hcel
    "C-c hi" #'hcel-global-ids
    "C-c ho" #'hcel-help)
  )

(my-package hcel-haddorg
  (:delay 60)
  ;; fixme: credential
  (my-setq-from-local hcel-haddorg-dir))

(my-package ggtags
  (:install t)
  (:delay 60)
  (my-keybind ggtags-navigation-map
    ggtags-navigation-map "M-<" nil
    ggtags-navigation-map "M->" nil))

(my-package phps-mode
  (:install t)
  (:delay 60)
  (add-to-list 'auto-mode-alist '("\\.\\(?:php[s345]?\\|phtml\\)\\'" . phps-mode))
  (add-to-list 'auto-mode-alist '("\\.\\(?:php\\.inc\\|stub\\)\\'" . phps-mode))
  (add-to-list 'auto-mode-alist '("/\\.php_cs\\(?:\\.dist\\)?\\'" . phps-mode))
  (add-hook 'before-save-hook (lambda () (interactive)
                                (when (eq major-mode 'phps-mode)
                                  (phps-mode-format-buffer)))))

(my-package crystal-mode
  (:delay 60)
  (require 'flycheck-crystal))

;;; proof-general
(my-package proof-general
  (:install t)
  (:delay 60)
  (setq proof-splash-enable nil)
  (setq coq-prog-name "/usr/bin/coqtop")
  (setq coq-compiler "~/.opam/default/bin/coqc")
  (setq coq-prog-env '("PATH=/usr/bin/:$HOME/.opam/default/bin/"))
  (setq coq-diffs 'on)
  (setq proof-three-window-enable nil))

;;; tree-sitter is built-in in emacs 29
(when (string< emacs-version "29")
  (add-to-list 'load-path (locate-user-emacs-file "lisp/elisp-tree-sitter/core"))
  (add-to-list 'load-path (locate-user-emacs-file "lisp/elisp-tree-sitter/lisp"))
  (my-package tree-sitter
    (:delay 30)
    (require 'tree-sitter-hl)
    (require 'tree-sitter-langs)
    (require 'tree-sitter-debug)
    (require 'tree-sitter-query)
    (add-to-list 'tree-sitter-major-mode-language-alist
                 '(haskell-mode . haskell))
    (add-to-list 'tree-sitter-major-mode-language-alist
                 '(phps-mode . php))
    ;; disable tree sitter for c/c++ and use eglot instead
    ;; FIXME: make it so it is only disabled with eglot on
    (add-to-list 'tree-sitter-major-mode-language-alist
                 '(c-mode))
    (add-to-list 'tree-sitter-major-mode-language-alist
                 '(c++-mode))
    (global-tree-sitter-mode)
    (add-hook 'tree-sitter-after-on-hook #'tree-sitter-hl-mode)))

;;; sml
(my-package sml-mode
  (:install t)
  (:delay 60)
  (setq sml-indent-level 2))

;;; mariadb development
(my-package sql
  (:delay 15)
  (setq sql-product 'mariadb)
  (add-to-list 'auto-mode-alist
               '("\\.test\\'" . (lambda ()
                                  (sql-mode)
                                  (setq comment-start "#"))))
  (add-to-list 'auto-mode-alist
               '("\\.inc\\'" . (lambda ()
                                 (sql-mode)
                                 (setq comment-start "#"))))
  (add-to-list 'auto-mode-alist '("\\.cnf\\'" . conf-mode))
  (require 'my-mariadb)
  (define-key sql-mode-map (kbd "C-c C-c") 'my-sql-maybe-mtrr)
  (my-keybind global-map
    "C-c d m" 'my-gdb-maria
    "C-c d s" 'my-gdb-maria-spider
    )
  (define-key gud-mode-map (kbd "C-c C-z") 'my-gdb-mysql-parse-frame)
  (add-to-list 'grep-files-aliases
               '("mtr" . "*.inc *.test *.cnf *.result *.rdiff"))
  (add-to-list 'grep-files-aliases
               '("mtrt" . "*.inc *.test"))
  )

;;; bison
(my-package bison-mode
  (:delay 30)
  (:install t)
  (add-to-list 'auto-mode-alist '("\\.yy\\'" . bison-mode))
  (define-key bison-mode-map (kbd "C-c C-c") 'project-compile)
  (require 'my-prog)
  (add-hook 'bison-mode-hook
            'my-bison-set-imenu-create-index-function)
  )

;;; which-func
(my-package which-func
  (:delay 5)
  (setq which-func-modes
        '(org-mode c-mode c++-mode bison-mode shell-script-mode emacs-lisp-mode
                   sql-mode json-mode))
  (which-function-mode)
  (add-hook 'org-mode-hook 'my-set-header-line-to-which-func)
  (add-hook 'c-mode-hook 'my-set-header-line-to-which-func)
  (add-hook 'emacs-lisp-mode-hook 'my-set-header-line-to-which-func)
  (add-hook 'c++-mode-hook 'my-set-header-line-to-which-func)
  )

;;; nxml
(my-package nxml-mode
  (:delay 60)
  (setq nxml-slash-auto-complete-flag t))

(my-package etags
  (:delay 60)
  (setq tags-file-name "TAGS"))

(my-package nroff-mode
  (add-to-list 'auto-mode-alist '("\\.mdoc\\'" . nroff-mode)))

(provide 'ycp-prog)
;;; ycp-prog.el ends here