Lisp/SLY/Helm: Override helm-ff-switch-to-shell to support SLY.

2020-11-07 11:31:24 +01:00 · 2020-11-07 11:31:24 +01:00 · 73e980dc90
parent 876511407d
commit 73e980dc90
1 changed files with 113 additions and 0 deletions
--- a/.emacs.d/lisp/init-lisp.el
+++ b/.emacs.d/lisp/init-lisp.el
@ -77,6 +77,119 @@
      (when (file-exists-p sbcl-core)
        sbcl-core))))

+(defun ambrevar/helm-ff--shell-interactive-buffer-p (buffer &optional mode)
+  (with-current-buffer buffer
+    (when (derived-mode-p (or mode 'eshell-mode))
+      (let ((next-prompt-fn (cl-case major-mode
+                              (sly-mrepl-mode #'comint-next-prompt)
+                              (shell-mode #'comint-next-prompt)
+                              (eshell-mode #'eshell-next-prompt)
+                              (term-mode #'term-next-prompt))))
+        (save-excursion
+          (goto-char (point-min))
+          (funcall next-prompt-fn 1)
+          (null (eql (point) (point-min))))))))
+
+(defun ambrevar/helm-ff-shell-alive-p (mode)
+  "Returns non nil when a process is running inside `shell-mode' buffer."
+  (cl-ecase mode
+    (sly-mrepl-mode
+     (save-excursion
+       (comint-goto-process-mark)
+       (or (null comint-last-prompt)
+           (not (eql (point)
+                     (marker-position (cdr comint-last-prompt)))))))
+    (shell-mode
+     (save-excursion
+       (comint-goto-process-mark)
+       (or (null comint-last-prompt)
+           (not (eql (point)
+                     (marker-position (cdr comint-last-prompt)))))))
+    (eshell-mode
+     (get-buffer-process (current-buffer)))
+    (term-mode
+     (save-excursion
+       (goto-char (term-process-mark))
+       (not (looking-back "\\$ " (- (point) 2)))))))
+
+(with-eval-after-load 'helm-files
+  (defun ambrevar/helm-ff-switch-to-shell (_candidate)
+    "Like `helm-ff-switch-to-shell' but supports more modes."
+    ;; Reproduce the Emacs-25 behavior to be able to edit and send
+    ;; command in term buffer.
+    (let (term-char-mode-buffer-read-only    ; Emacs-25 behavior.
+          term-char-mode-point-at-process-mark ; Emacs-25 behavior.
+          (cd-eshell (lambda ()
+                       (eshell/cd helm-ff-default-directory)
+                       (eshell-reset)))
+          (cd-sly (lambda ()            ; XXX: New!
+                    ;; Taken from `sly-mrepl-set-directory'.
+                    (let ((directory helm-ff-default-directory))
+                      (sly-mrepl--save-and-copy-for-repl
+                       `(slynk:set-default-directory ,directory)
+                       :before (format "Setting directory to %s" directory))
+                      (cd directory))))
+          (cd-shell
+           (lambda ()
+             (cl-case helm-ff-default-directory)
+             (goto-char (point-max))
+             (when (eq helm-ff-preferred-shell-mode 'shell-mode)
+               (comint-delete-input))
+             (insert (format "cd %s"
+                             (shell-quote-argument
+                              (or (file-remote-p
+                                   helm-ff-default-directory 'localname)
+                                  helm-ff-default-directory))))
+             (cl-case helm-ff-preferred-shell-mode
+               (shell-mode (comint-send-input))
+               (term-mode (progn (term-char-mode) (term-send-input))))))
+          (bufs (cl-loop for b in (mapcar 'buffer-name (buffer-list))
+                         when (or
+                               (ambrevar/helm-ff--shell-interactive-buffer-p
+                                b 'sly-mrepl-mode) ; XXX: New!
+                               (helm-ff--shell-interactive-buffer-p
+                                b helm-ff-preferred-shell-mode))
+                         collect b)))
+      ;; Jump to a shell buffer or open a new session.
+      (helm-aif (and (not helm-current-prefix-arg)
+                     (if (cdr bufs)
+                         (helm-comp-read "Switch to shell buffer: " bufs
+                                         :must-match t)
+                       (car bufs)))
+          ;; Display in same window by default to preserve the
+          ;; historical behaviour
+          (pop-to-buffer it '(display-buffer-same-window))
+        (cl-case helm-ff-preferred-shell-mode
+          (eshell-mode
+           (eshell helm-current-prefix-arg))
+          (shell-mode
+           (shell (helm-aif (and helm-current-prefix-arg
+                                 (prefix-numeric-value
+                                  helm-current-prefix-arg))
+                      (format "*shell<%s>*" it))))
+          (term-mode
+           (progn
+             (ansi-term (getenv "SHELL")
+                        (helm-aif (and helm-current-prefix-arg
+                                       (prefix-numeric-value
+                                        helm-current-prefix-arg))
+                            (format "*ansi-term<%s>*" it)))
+             (term-line-mode)))))
+      ;; Now cd into directory.
+      (helm-aif (and (memq major-mode '(sly-mrepl-mode shell-mode term-mode)) ; XXX: New!
+                     (get-buffer-process (current-buffer)))
+          (accept-process-output it 0.1))
+      (unless (ambrevar/helm-ff-shell-alive-p major-mode) ; XXX: New!
+        (funcall
+         (cond                          ; XXX: New!
+          ((eq major-mode 'eshell-mode)
+           cd-eshell)
+          ((eq major-mode 'sly-mrepl-mode)
+           cd-sly)
+          (t
+           cd-shell))))))
+  (advice-add 'helm-ff-switch-to-shell :override #'ambrevar/helm-ff-switch-to-shell))
+
 (defun ambrevar/sly-prepare-prompt (old-func &rest args)
  (let ((package (nth 0 args))
        (new-prompt (format "%s:%s"