inf-clojure-custom.el

(require 'inf-clojure)
;; need to trim whitespace; see https://www.emacswiki.org/emacs/ElispCookbook#toc6
(require 'subr-x)

;; this was making inf-clojure-set-ns act badly.
;; (with-eval-after-load 'inf-clojure
;;   (defun inf-clojure-set-ns (ns)
;;     "Set the ns of the inferior Clojure process to NS.
;; Defaults to the ns of the current buffer."
;;     (interactive (inf-clojure-symprompt "Set ns to" (clojure-find-ns)))
;;     (comint-send-string (inf-clojure-proc)
;; 			(format inf-clojure-set-ns-command ns))))

;; for my dumb macOS setup
(when (eq system-type 'darwin)
  (setq inf-clojure-generic-cmd "lein2 repl")
  (setq inf-clojure-lein-cmd "lein2 repl"))

(with-eval-after-load 'inf-clojure
  (add-hook 'inf-clojure-mode-hook
	        'paredit-mode)
  (add-hook 'inf-clojure-mode-hook
            'auto-complete-mode))

;; without this inf-clojure sometimes throws weird errors having to do
;; with planck that break the repl
(defcustom inf-clojure--arcadia-repl-form
  "(find-ns 'arcadia.core)"
  "Form to invoke in order to verify that we launched an Arcadia REPL."
  :type 'string
  :safe #'stringp
  :package-version '(inf-clojure . "2.0.0"))

;; inf-clojure--set-repl-type doesn't work for us
(with-eval-after-load 'inf-clojure
  (defun inf-clojure--detect-repl-type (proc)
    "Identifies the current REPL type for PROC."
    (when (not inf-clojure--repl-type-lock)
      (let ((inf-clojure--repl-type-lock t))
        (cond
         ;; this first clause is new
         ((inf-clojure--some-response-p proc inf-clojure--arcadia-repl-form) 'clojure)
         ((inf-clojure--some-response-p proc inf-clojure--lumo-repl-form) 'lumo)
         ((inf-clojure--some-response-p proc inf-clojure--planck-repl-form) 'planck)
         ((inf-clojure--some-response-p proc inf-clojure--joker-repl-form) 'joker)
         (t 'clojure))))))

;; ============================================================
;; jump to def

(defun timsg-inf-clojure--inferred-ns ()
  (let* ((ns (clojure-find-ns)))
    (when (and ns (not (equal ns "")))
      ns)))

(defun timsg-inf-clojure--inferred-ns-strict ()
  (let* ((ns (clojure-find-ns)))
    (when (or (not ns) (equal ns ""))
      (user-error "Namespace could not be inferred"))
    ns))

(defun timsg-inf-clojure--ns-form ()
  (if-let ((ns (timsg-inf-clojure--inferred-ns)))
      (format "(quote %s)" ns)
    "(ns-name *ns*)"))

(defun timsg-inf-clojure--jump-to-def-data (ns-form fn)
  (when-let ((proc (inf-clojure-proc 'no-error)))
    (let* ((form "(try
  (let [{:keys [line column file]} (clojure.core/meta
                                     (clojure.core/ns-resolve %s
                                       (clojure.core/read-string \"%s\")))]
    (when (and line column file)
      (clojure.core/list line column file)))
  (catch Exception e nil))")
           (command (format form ns-form fn)))
      (message (concat "command: " command))
      (thread-first
          command
        (inf-clojure--process-response proc)
        read-from-string ;; is this dangerous?
        car))))

;; see https://www.gnu.org/software/emacs/manual/html_node/elisp/Screen-Lines.html#Screen-Lines
  ;; eh can't get it to work consistently
(defun timsg--coordinates-of-position (col line)
  (message "looking up position of col %d, line %d" col line)
  (message "selected window: %s" (selected-window))

  (car (compute-motion (window-start)   ; (point-min) 
                       '(0 . 0)
                       (point-max)
                       (cons col line)
                       (window-width)
                       (cons (window-hscroll) 0)
                       (selected-window)))
  )

(defun timsg-inf-clojure--jump-to-def (prompt-for-symbol)
  (interactive "P")
  (let* ((ns (timsg-inf-clojure--ns-form))
         (fn (if prompt-for-symbol
                 (car (inf-clojure-symprompt "Jump to" (inf-clojure-symbol-at-point)))
               (inf-clojure-symbol-at-point))))
    (pcase (timsg-inf-clojure--jump-to-def-data ns fn)
      (`nil (message "could not find source"))
      (`(,line ,column ,file)
       (push-mark) ;; for back-button
       (progn
         (find-file file)
         (goto-line line)
         ;; can't get it to work consistently         
         ;; (let* ((pos (timsg--coordinates-of-position column line)))
         ;;   (message "file: %s\npos: %d" file pos)
         ;;   (goto-char pos))
         )))))

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

;; redefining inf-clojure--process-response because it uses the wrong
;; line endings for us, at least on windows
(defun inf-clojure--process-response (command process &optional beg-regexp end-regexp)
  "Send COMMAND to PROCESS and return the response.
Return the result of COMMAND, filtering it from BEG-REGEXP to the
end of the matching END-REGEXP if non-nil.
If BEG-REGEXP is nil, the result string will start from (point)
in the results buffer.  If END-REGEXP is nil, the result string
will end at (point-max) in the results buffer.  It cuts out the
output from and including the `inf-clojure-prompt`."
  (let ((redirect-buffer-name inf-clojure--redirect-buffer-name)
        ;; editing this to get rid of tailing newline; will be added by comint
        (sanitized-command (thread-first
                               (inf-clojure--sanitize-command command)
                             (string-trim-right))))
    (when (not (string-empty-p sanitized-command))
      (inf-clojure--log-string command "----CMD->")
      (with-current-buffer (inf-clojure--get-redirect-buffer)
        (erase-buffer)
        (comint-redirect-send-command-to-process sanitized-command redirect-buffer-name process nil t))
      ;; Wait for the process to complete
      (with-current-buffer (process-buffer process)
        (while (and (null comint-redirect-completed)
                    (accept-process-output process 1 0 t))
          (sleep-for 0.01)))
      ;; Collect the output
      (with-current-buffer redirect-buffer-name
        (goto-char (point-min))
        (let* ((buffer-string (buffer-substring-no-properties (point-min) (point-max)))
               (boundaries (inf-clojure--string-boundaries buffer-string inf-clojure-prompt beg-regexp end-regexp))
               (beg-pos (car boundaries))
               (end-pos (car (cdr boundaries)))
               (prompt-pos (car (cdr (cdr boundaries))))
               (response-string (substring buffer-string beg-pos (min end-pos prompt-pos))))
          (inf-clojure--log-string buffer-string "<-RES----")
          response-string)))))

;; ============================================================
;; arglists command

(setq inf-clojure-arglists-form
      "(try
  (:arglists
   (clojure.core/meta
     (clojure.core/ns-resolve %s
       (clojure.core/read-string \"%s\"))))
  (catch #?(:clj Throwable :cljr Exception) e nil))")

;; redefining inf-clojure-arglists to actually work
;; want to feed in the ns
(defun inf-clojure-arglists (fn)
  "Send a query to the inferior Clojure for the arglists for function FN.
See variable `inf-clojure-arglists-form'."
  (when-let ((proc (inf-clojure-proc 'no-error)))
    (let* ((ns (timsg-inf-clojure--ns-form))
           (cmd (format (inf-clojure-arglists-form proc) ns fn)))
      ;; (message "sending:%s" cmd)
      (thread-first
          cmd
        ;; this regexp will screw up if there are () in the argslist, I bet
        (inf-clojure--process-response proc "(" ")")
        (inf-clojure--some)))))

;; ============================================================
;; eldoc

;; for arcadia specifically
;; throttle it

;; if true, eldoc should not run
(setq timsg-inf-clojure--eldoc-throttled nil)
(setq timsg-inf-clojure--eldoc-delay 1)

(defun timsg-inf-clojure--check-eldoc-throttle ()
  "If eldoc-throttled, returns t. Otherwise returns nil and sets
 eldoc-throttled to t with a timer to set it to nil after delay."
  (or timsg-inf-clojure--eldoc-throttled
      (progn
        (setq timsg-inf-clojure--eldoc-throttled t)
        (run-at-time timsg-inf-clojure--eldoc-delay
                     nil
                     (lambda ()
                       (setq timsg-inf-clojure--eldoc-throttled nil)))
        nil)))

;; actually if the bottleneck is the repl itself i don't think there's a great way to automate this
(setq timsg-inf-clojure--eldoc-reg
       "^\\(\\(\\.\\)\\|\\(\\:\\)\\|[A-Z]\\).*"

       )

(defmacro timsg-eqs (x &rest stuff)
  (let ((stuff2 (seq-map (lambda (y) `(eq ,x ,y)) stuff)))
    `(and ,@stuff2)))

(defmacro timsg-any-eqs (x &rest stuff)
  (let ((stuff2 (seq-map (lambda (y) `(eq ,x ,y)) stuff)))
    `(or ,@stuff2)))

(defun timsg-inf-clojure--valid-eldoc-symbolp (thing)
  (let ((case-fold-search nil))
    (not (or (string-match-p timsg-inf-clojure--eldoc-reg
                             thing)
             (timsg-any-eqs thing
                            "throw"
                            "try"
                            "catch"
                            "recur"
                            "loop")))))

(defun inf-clojure-eldoc ()
  "Backend function for eldoc to show argument list in the echo area."
  ;; eh actually it kind of doesn't work
  (when nil
    (when (and (not (timsg-inf-clojure--check-eldoc-throttle))
               (inf-clojure-connected-p)
               ;; don't clobber an error message in the minibuffer
               (not (member last-command '(next-error previous-error))))
      ;; think this should be when-let, right?
      (when-let* ((info (inf-clojure-eldoc-info-in-current-sexp))
                  (thing (car info)))
        ;; try to rule out invalid items
        (when (timsg-inf-clojure--valid-eldoc-symbolp thing)
          (let* ((value (inf-clojure-eldoc-arglists thing)))
            (when value
              (format "%s: %s"
                      (inf-clojure-eldoc-format-thing thing)
                      value))))))))

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

;; not sure what this was

  ;;     "(try
  ;; (clojure.core/some-> (clojure.core/ns-resolve
  ;;                        %s
  ;;                        (quote %s))
  ;;                      clojure.core/meta
  ;;                      :doc)
  ;; (catch Exception e nil))"

(setq inf-clojure-var-doc-form
      "(try
  (let [v (clojure.core/ns-resolve %s (quote %s))]
    (when (and v (var? v))
      (let [{:keys [arglists doc name ns]} (clojure.core/meta v)]
        (list (pr-str arglists) doc (str (ns-name ns) \"/\" name)))))
  (catch Exception e nil))")

(defun blank-nil (s)
  (when (not (eq s ""))
    s))

;; ============================================================
;; qwikpop mode!

;; just a read-only mode that restores previous buffer and kills current buffer on q

(defun timsg-quit-and-kill-window ()
  (interactive)
  (quit-window t))

(defvar timsg-inf-clojure--qwikpop-mode-map ;; magic var that define-derived-mode picks up
  (let ((map (make-sparse-keymap)))
    (define-key map "q" #'timsg-quit-and-kill-window)
    map))

(define-derived-mode timsg-inf-clojure--qwikpop-mode special-mode "Qwikpop"
  "qwikpop!")

(defun timsg--qwikpop-it (msg &optional buffer-name)
  (let ((maybe-win (display-message-or-buffer msg
                                              (or buffer-name "*Qwikpop*")
                                              '((display-buffer-same-window)))))
    (when (not (stringp maybe-win))
      (with-current-buffer (window-buffer maybe-win)
        (timsg-inf-clojure--qwikpop-mode)))))

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

;; another clobber
(defun inf-clojure-show-var-documentation (prompt-for-symbol)
  "Send a form to the inferior Clojure to give documentation for VAR.
See function `inf-clojure-var-doc-form'.  When invoked with a
prefix argument PROMPT-FOR-SYMBOL, it prompts for a symbol name."
  (interactive "P")
  (when-let* ((proc (inf-clojure-proc))
              (var (blank-nil
                    (if prompt-for-symbol
                        (car (inf-clojure-symprompt "Var doc" (inf-clojure-symbol-at-point)))
                      (inf-clojure-symbol-at-point))))
              (cmd (format inf-clojure-var-doc-form (timsg-inf-clojure--ns-form) var)))
    (when-let* ((response (blank-nil (inf-clojure--process-response cmd proc)))
                (data (car (read-from-string response))))
      (pcase-let ((`(,args ,doc ,name) data))
        (timsg--qwikpop-it (format "%s\n%s\n%s" name args doc)
                           "*Var Docs*")))))

;; ============================================================
;; winner mode is annoying me. move this to winner-custom or something

Then for the keybindings:

(defun timsg--inf-clojure-keybinding-setup ()
  (define-key inf-clojure-mode-map (kbd "M-.") #'timsg-inf-clojure--jump-to-def)
  (define-key inf-clojure-minor-mode-map (kbd "M-.") #'timsg-inf-clojure--jump-to-def))

(defun set-inf-clojure-keybindings ()
  (add-hook 'inf-clojure-mode-hook #'timsg--inf-clojure-keybinding-setup)
  (add-hook 'inf-clojure-minor-mode-hook #'timsg--inf-clojure-keybinding-setup))

(set-inf-clojure-keybindings)