my-langs-elisp.el

;; -*- mode: emacs-lisp; lexical-binding: t -*-
(require 's)
(require 'use-package)
(require 'my-langs-common)
(require 'outline)
(require 'leaf)
(require 'leaf-keywords)

(require 'xr)
(require 'view)
(require 'ppp)
(require 'elint)

(defconst my-ppp-popup-buffer "*Pretty-Printer*")

(defvar my-ppp-expand-expander 'macroexpand
  "The expander to use when expanding macros with `my-ppp-expand-*' commands.

Can be one of: `macroexpand-1', `macroexpand', `macroexpand-all'.")

(defvar my-ppp-expand-display-action
  '(display-buffer-pop-up-window . ((window-width . 90))))
;; '(display-buffer-pop-up-frame
;;   (pop-up-frame-parameters . ((top . (+ 130))
;;                               (left . (+ 130))
;;                               (height . 20)
;;                               (width . 129))))

(cl-defun my-ppp-expand--expand-form (form)
  "Read the sexp at point, recursively expand all macros, pretty-print results"
  (ignore-errors
    (kill-buffer my-ppp-popup-buffer))
  (with-current-buffer (get-buffer-create my-ppp-popup-buffer)
    (emacs-lisp-mode)
    (insert (with-output-to-string (ppp-sexp (funcall my-ppp-expand-expander form))))
    (read-only-mode 1)
    (make-local-variable 'view-mode-map)
    (define-key view-mode-map (kbd "q") #'View-quit-and-kill-buffer))
  (display-buffer my-ppp-popup-buffer my-ppp-expand-display-action))


(cl-defun my-ppp-expand-at-pt (form)
  "Read the sexp at point, recursively expand all macros, pretty-print results"
  (interactive (list (read (thing-at-point 'sexp))))
  (my-ppp-expand--expand-form form))

(cl-defun my-ppp-expand-all-at-pt (form)
  "Read the sexp at point, recursively expand all macros, pretty-print results"
  (interactive (list (read (thing-at-point 'sexp))))
  (let ((my-ppp-expand-expander 'macroexpand-all))
    (my-ppp-expand--expand-form form)))

(cl-defun my-ppp-expand-1-at-pt (form)
  "Read the sexp at point, expand one level of macros, pretty-print results"
  (interactive (list (read (thing-at-point 'sexp))))
  (let ((my-ppp-expand-expander 'macroexpand-1))
    (my-ppp-expand--expand-form form)))


(cl-defun View-quit-and-kill-buffer ()
  (interactive)
  (View-quit)
  (ignore-errors
    (kill-buffer my-ppp-popup-buffer)))


;; (my-ppp-list-insert '(a b c))
(defun my-ppp-list-insert (form)
  (save-excursion
    (goto-char (line-end-position))
    (forward-line 1)
    (cl-loop for l in (s-split "\n" (ppp-list-to-string form))
             do (progn (insert ";; " l)
                       (newline)))))


(defun pp-to-cmd (obj)
  (let ((s (->> (pp-to-string obj) (s-replace "\n" ""))))
    (replace-regexp-in-string (rx (1+ " ")) " " s t t)))


;; e.g. (my-ppp-list-other-window extended-command-history)
;; e.g. (my-ppp-list-other-window (-iota 10))
(defun my-ppp-list-other-window (obj)
  (interactive
   (list (eval-last-sexp nil)))
  (if (not (cl-typep obj 'list))
      (message "Error: value `%s` is not a list!" obj)
    (let ((buf (get-buffer-create "*Pretty-Printer*")))
      (with-current-buffer buf
        (erase-buffer)
        (emacs-lisp-mode)
        (my-ppp-list-insert obj)
        (uncomment-region (point-min) (point-max)))
      (display-buffer buf))))


(defun my-list-commands (&optional re)
  (interactive "MRegexp: ")
  (let ((commands (cl-loop for x being the symbols
                           if (commandp x)
                           if (s-matches-p re (symbol-name x))
                           collect x)))
    (if (called-interactively-p 'any)
        (my-ppp-list-other-window commands)
      commands)))



(cl-defun my-xr-at-point ()
  (interactive)
  (let ((form (read (thing-at-point 'sexp t))))
    (if (stringp form)
        (message "Rx: %s" (xr form))
      (message "Not a string: %s" form))))


(cl-defun my-xr-last-sexp ()
  (interactive)
  (let ((form (eval-last-sexp nil)))
    (if (stringp form)
        (message "String: %s" (xr form))
      (message "Not a string: %s" form))))

;; (ignore-errors
;;   (require 'ipretty)
;;   (add-hook 'emacs-lisp-mode-hook (lambda () (ipretty-mode))))

(pixel-scroll-mode)

(use-package pp+
  :after pp
  :commands
  pp-eval-expression pp-display-expression ; pp+
  pp pp-buffer pp-eval-expression pp-eval-last-sexp
  pp-macroexpand-expression pp-macroexpand-last-sexp
  pp-to-string)

(use-package ppp)

(defun cl-libify (beg end)
  "Replace cl symbol names between BEG and END with their cl-lib equivalents."
  (interactive "r")
  (load "/home/cji/.emacs.d/plugins-forked/cl-libify/cl-libify.el")
  (cl-libify beg end))

(use-package elisp-def
  :diminish elisp-def-mode
  :commands elisp-def-mode
  :config
  (message "This shouldn't run"))

(use-package easy-escape
  :diminish easy-escape-minor-mode
  :hook (emacs-lisp-mode . easy-escape-minor-mode))



(leaf eros
  :diminish t
  :commands eros-mode
  :config
  (eros-mode 1))


(cl-defun my-eros-format-list (value)
  (with-temp-buffer
    (insert (with-output-to-string (ppp-list value)))
    (goto-char (point-min))
    (forward-line)
    (indent-rigidly (point) (point-max) 4)
    (buffer-string)))

(cl-defun my-eros-format-value (value)
  ;; ppp-sexp-to-string tends to add extra newlines at the end of the string
  (s-trim
   (if (and (listp value) (< (length value) 10))
       (my-eros-format-list value)
     (ppp-sexp-to-string value))))

;; (-take 11 load-path)
;; (-take 9 load-path)
;; (cl-loop for it below 9 collect it)
(cl-defun my-eros-overlay-format (value point)
  (let ((ppp-tail-newline nil)
        (formatted (my-eros-format-value value)))
    (eros--make-result-overlay formatted :where point :duration 'command)
    value))

(define-minor-mode global-multiline-eros-mode
  "Override eros overlay format to display multiline results."
  :lighter nil
  :global t
  (if global-multiline-eros-mode
      (advice-add 'eros--eval-overlay :override #'my-eros-overlay-format)
    (advice-remove 'eros--eval-overlay #'my-eros-overlay-format)))



;; (defun unkillable-scratch-buffer ()
;; 	(if (equal (buffer-name (current-buffer)) "*scratch*")
;; 	    (progn
;; 	      (delete-region (point-min) (point-max))
;; 	      nil)
;; 	  t))
;; (add-hook 'kill-buffer-query-functions 'unkillable-scratch-buffer)

(eval-when-compile
  (defvar eshell-mode-map)
  (defvar paredit-mode-map)
  (declare-function delete-active-region 'delsel)
  (declare-function flycheck-mode 'flycheck))

(put 'pcase 'function-documentation '())

(leaf lisp-extra-font-lock
  :require t
  :diminish t
  :config
  (lisp-extra-font-lock-global-mode 1))


(defun my-paredit-space-for-paren-p (endp delim)
  (if (and (eq endp nil) (eq delim ?\() (looking-back "#f" nil))
      nil
    t))

;; (use-package flycheck)

;; (require 'short-lambda)
;; (-each load-path #f(message "%s" %))

(use-package debug
  :bind (:map debugger-mode-map
         ("C-g" . debugger-quit)))

(use-package eieio
  :commands eieio-browse)


(use-package data-debug
  :commands data-debug-edebug-expr data-debug-eval-expression
  :config
  (define-key data-debug-mode-map (kbd "q") 'bury-buffer)
  (define-key data-debug-mode-map (kbd "<tab>") 'data-debug-expand-or-contract)
  (define-key data-debug-mode-map (kbd "<backtab>") 'my-ddebug-expand-all)
  (define-key data-debug-mode-map (kbd "C-<up>") 'data-debug-prev-expando)
  (define-key data-debug-mode-map (kbd "C-<down>") 'data-debug-next-expando)

  (define-key mode-specific-map (kbd "C-M-e") 'my-data-debug-at-pt)
  (define-key ctl-x-map (kbd "C-M-e") 'my-data-debug-at-pt))


(declare-function data-debug-expand-or-contract 'data-debug)
(defun my-ddebug-expand-all ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (ignore-errors
      (while (search-forward-regexp "^ >")
        (data-debug-expand-or-contract)))))

(defun my-data-debug-at-pt ()
  (interactive)
  (data-debug-eval-expression (sexp-at-point)))


;; Make byte-compilation load-path equal the runtime load-path; save the old
;; value. By default the only entry on the path is "./" (current directory)
(defconst my-elisp-flymake-byte-compile-original-path
  elisp-flymake-byte-compile-load-path)
(setq elisp-flymake-byte-compile-load-path load-path)
(setq emacs-lisp-compilation-search-path elisp-flymake-byte-compile-load-path)

(require 'my-mod-ielm)
(add-hook 'emacs-lisp-mode-hook          'my-elisp-mode-setup)

(with-eval-after-load "elisp-mode"
  (define-key lisp-interaction-mode-map (kbd "C-<up>") 'my-paredit-backward-up)
  (define-key lisp-interaction-mode-map (kbd "C-<down>") 'my-paredit-forward-down))

;; (use-package highlight-defined
;;   :hook ((emacs-lisp-mode . highlight-defined-mode)))

(use-package highlight-function-calls
  :disabled t
  :hook ((emacs-lisp-mode . highlight-function-calls-mode)))

(require 'lv)

(defun my-eldoc-eval-show-fun (doc-or-1)
  (when (not (eq doc-or-1 1))
    (lv-message "%s" doc-or-1)))

(use-package eldoc-eval
  :commands eldoc-in-minibuffer-mode
  :disabled t)

(use-package nameless
  :custom ((nameless-prefix ":")
           (nameless-private-prefix t)))

(use-package page-break-lines-mode
  :commands page-break-lines-mode
  :diminish t)

(cl-defun my-macroexpand-full (&optional arg)
  "Expand the macro at point and display the resulting code.

If called with a prefix argument, insert the expanded code at point.
Otherwise, display the expanded code in the minibuffer. The expanded code is
pretty-printed using `pp-to-string` and then either inserted or displayed."
  (interactive "P")
  (cl-letf* ((sexp (thing-at-point 'sexp))
             (pretty (pp-to-string (macroexpand (read sexp)))))
    (if arg (insert "\n" pretty) (message "%s" pretty))))

(declare-function leaf-convert-region-replace "leaf-convert")

(cl-defun my-use-package->leaf ()
  "Place point at the end of use-package sexp - it will be replaced with
equivalent leaf version."
  (interactive)
  (save-excursion
    (push-mark)
    (backward-sexp)
    (leaf-convert-region-replace
     (region-beginning) (region-end))))

(setq completion-cycle-threshold nil)

(declare-function auto-complete-mode "auto-complete")
(declare-function corfu-history-mode "corfu-history")
(declare-function corfu-mode "corfu")

(declare-function corfu-popupinfo-mode "corfu-popupinfo")
(defvar my-eval-last-sexp-last-sexp nil)

(cl-defun my-eval-defun-sexp-collector (&rest _)
  (setq my-eval-last-sexp-last-sexp
        (s-trim (substring-no-properties (thing-at-point 'defun)))))

(cl-defun my-eval-last-sexp-sexp-collector (&rest _)
  (setq my-eval-last-sexp-last-sexp (elisp--preceding-sexp)))

(advice-add 'elisp--eval-last-sexp :before #'my-eval-last-sexp-sexp-collector)
(advice-add 'eval-defun :before #'my-eval-defun-sexp-collector)

(defun my-elisp-mode-setup ()
  (require 'flymake)
  (require 'flycheck)
  (require 'eros)
  (require 'paredit)
  (require 'xr)
  (require 'tablist)
  (require 'named-timer)
  (require 'ppp)
  (require 'data-debug)
  (require 'inspector)
  (require 'copilot nil t)
  (require 'my-elisp-hydra)
  (elide-head-mode 1)
  (page-break-lines-mode 1)
  (push 'my-locate-library-xref-backend xref-backend-functions)
  ;; (eldoc-in-minibuffer-mode 1)
  (eros-mode 1)
  ;; (elisp-def-mode)
  (prettify-symbols-mode 1)
  (flycheck-mode -1)
  (flymake-mode -1)
  (delete 'elisp-flymake-checkdoc flymake-diagnostic-functions)

  (auto-complete-mode -1)

  (require 'cape)
  (require 'corfu)
  (require 'corfu-history)
  (require 'consult)
  (setq-local completion-at-point-functions
              (list 'cape-file
                    'elisp-completion-at-point
                    'cape-dabbrev
                    'cape-keyword
                    t))
  (corfu-mode)
  (setq-local corfu-popupinfo-delay 0.2)
  (corfu-popupinfo-mode 1)
  (corfu-history-mode 1)
  (setq-local corfu-auto t)

  (savehist-mode 1)
  (define-key global-map [remap eval-last-sexp] 'my-eval-last-sexp)

  (define-key emacs-lisp-mode-map (kbd "C-c <left>") 'hs-cycle)

  (define-key mode-specific-map (kbd "C-d") 'helpful-function)
  (define-key mode-specific-map (kbd "d")   'helpful-symbol)
  (define-key mode-specific-map (kbd "C-b") 'my-interactive-byte-compile)
  (define-key mode-specific-map (kbd "C-j") 'eval-print-last-sexp)
  (define-key mode-specific-map (kbd "C-f") 'find-function)
  (define-key emacs-lisp-mode-map (kbd "C-<up>") 'my-paredit-backward-up)
  (define-key emacs-lisp-mode-map (kbd "C-<down>") 'my-paredit-forward-down)

  (add-to-list
   (make-local-variable 'paredit-space-for-delimiter-predicates)
   'my-paredit-space-for-paren-p)

  (paredit-mode 1)
  (bind-keys
   :map paredit-mode-map
   (";" . my-elisp-semicolon)
   ("M-S-<left>" . backward-word)
   ("M-?" . paredit-convolute-sexp)
   ("M-S-<right>" . forward-word)
   ("C-c C-j" . eval-print-last-sexp))
  (erefactor-highlight-mode +1)
  (define-key erefactor-highlight-map (kbd "M-<right>") nil t)
  (define-key erefactor-highlight-map (kbd "M-<left>") nil t)
  (define-key erefactor-highlight-map (kbd "C-c <right>") 'erefactor-highlight-next-symbol))


(cl-defun my-eval-expression-setup ()
  (keymap-set minibuffer-mode-map (kbd ";") 'my-elisp-semicolon))
(add-hook 'eval-expression-minibuffer-setup-hook #'my-eval-expression-setup)

(cl-defun my-paredit-forward-down ()
  (interactive)
  (condition-case _err
      (progn
        (when (or (looking-at ")") (looking-at "\""))
          (forward-char 1))
        (paredit-backward-up)
        (forward-sexp)
        (backward-char))
    (error (forward-paragraph))))

(cl-defun my-paredit-backward-up ()
  (interactive)
  (condition-case _err
      (progn
        (when (or (looking-back "(" 1) (looking-back "\"" 1))
          (forward-char -1))
        (paredit-backward-up)
        (forward-char))
    (error (backward-paragraph))))



(cl-defun my-elisp-semicolon ()
  (interactive)
  (if (looking-back "(require " (line-beginning-position))
      (insert "'")
    (call-interactively #'paredit-semicolon)))


(defun my-interactive-byte-compile ()
  (interactive)
  (byte-compile-file (buffer-file-name)))

(defun my-eval-last-sexp (arg)
  "Like `eval-last-sexp', but pretty-prints with prefix ARG."
  (interactive "P")
  (cond
   ((not arg) (call-interactively 'eros-eval-last-sexp))
   (t (call-interactively 'pp-eval-last-sexp))))

(defun my-ppp-eval-and-insert-last-sexp ()
  (interactive)
  (cl-letf* ((pretty (ppp-sexp-to-string (eval (sexp-at-point)))))
    (insert "\n")
    (insert pretty)))


;; =============================================================================

(indent/tag-for-modes
    '(lisp-indent-function)
  '((font-lock-add-keywords  . 1)
    (run-at-time             . 2)
    (-as->                   . 2)
    (promise-then            . 1)
    (define-frame-preference . 1)
    (run-with-timer          . 2)
    (indent/tag-for-modes    . 1)
    (propertize              . 1)
    (font-lock-for-modes     . 1)
    (add-hook                . 1)))


(font-lock-add-keywords 'emacs-lisp-mode
  `(("\\bwith-eval-after-load\\b" . font-lock-keyword-face)
    ("eval-after-load"      . font-lock-keyword-face)
    ("\\<autoload "          . font-lock-keyword-face)
    ("my-report-loading"    . font-lock-keyword-face)
    ("cl-defstruct"         . font-lock-keyword-face)
    ("\bfunctionp?"         . font-lock-keyword-face)
    ("promise-then"         . font-lock-keyword-face)
    ("#f"                   . font-lock-constant-face)
    ("%[0-9]?"              . font-lock-constant-face)
    ("bl-signal-not-found"  . font-lock-warning-face)
    ))

(font-lock-add-keywords 'emacs-lisp-mode
  `((,(rx "(" (group "load") " ")
     (1 font-lock-constant-face))
    ("(\\(leaf\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
     (1 font-lock-keyword-face)
     (2 font-lock-constant-face nil t))
    )

  )

;; (font-lock-fontify-buffer)
;; (load "asdasd")
;; (eval-after-load 'helm 'fuck)
;; (with-eval-after-load 'helm 'fuck)
;; (req! fuck asd)
;; (setq font-lock-keywords nil)
;; (ppp-sexp font-lock-defaults)

;; (font-lock-remove-keywords 'emacs-lisp-mode
;;   '(("it" . font-lock-builtin-face) ("\bit[\b)]" . font-lock-keyword-face)))


;; =============================================================================
(declare-function helm 'helm)
(declare-function helm-def-source--emacs-functions 'helm-elisp)

(defun helm-apropos-functions (default)
  "Preconfigured helm to describe functions."
  (interactive (list (thing-at-point 'symbol)))
  (helm :sources (list (helm-def-source--emacs-functions))
        :history 'helm-apropos-history
        :buffer "*helm apropos*"
        :input default
        :preselect default))

(define-key help-map (kbd "C-f") 'helm-apropos-functions)


(provide 'my-langs-elisp)