Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable cider-jack-in on tramp buffers #489

Merged
merged 1 commit into from
Mar 16, 2014
Merged

Enable cider-jack-in on tramp buffers #489

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,8 @@
* Cider command uses `cider-known-endpoints`.
* [#490](https://github.com/clojure-emacs/cider/pull/490) Dedicated
support for `company-mode` in `cider-complete-at-point`.
* [#489](https://github.com/clojure-emacs/cider/issues/489) Enable
cider-jack-in on tramp source buffers.
* [#460](https://github.com/clojure-emacs/cider/issues/460) Support for
cider-nrepl's complete middleware for CLJ/CLJS autocomplete.
* [#465](https://github.com/clojure-emacs/cider/issues/465) Support for
Expand Down
15 changes: 11 additions & 4 deletions cider.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -103,10 +103,17 @@ start the server."
(cmd (if project
(format "cd %s && %s" project cider-server-command)
cider-server-command))
(process (start-process-shell-command
"nrepl-server"
(generate-new-buffer-name (nrepl-server-buffer-name))
cmd)))
(default-directory project-dir)
(nrepl-buffer-name (generate-new-buffer-name
(nrepl-server-buffer-name)))
(process
(progn
;; the buffer has to be created before the proc:
(get-buffer-create nrepl-buffer-name)
(start-file-process-shell-command
"nrepl-server"
nrepl-buffer-name
cmd))))
(set-process-filter process 'nrepl-server-filter)
(set-process-sentinel process 'nrepl-server-sentinel)
(set-process-coding-system process 'utf-8-unix 'utf-8-unix)
Expand Down
125 changes: 116 additions & 9 deletions nrepl-client.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,18 @@ The `nrepl-buffer-name-separator' separates cider-repl from the project name."
:type 'string
:group 'nrepl)

(defcustom nrepl-connection-endpoint
'nrepl-connection-ssh-tunnel
"A function that is called to determine command that will be run
once an nrepl server process is running. Used to set up an ssh tunnel
on remote connections.

The arguments are dir and port. The return value
should be an `plist` of the form
(:proc-buffer-name \"*buf*\" :hostname \"hostname\" :port 1234)"
:type 'function
:group 'nrepl)

(defvar nrepl-repl-requires-sexp "(clojure.core/apply clojure.core/require '[[clojure.repl :refer (source apropos dir pst doc find-doc)] [clojure.java.javadoc :refer (javadoc)] [clojure.pprint :refer (pp pprint)]])"
"Things to require in the tooling session and the REPL buffer.")

Expand All @@ -88,10 +100,12 @@ The `nrepl-buffer-name-separator' separates cider-repl from the project name."
(defvar-local nrepl-repl-buffer nil)
(defvar-local nrepl-endpoint nil)
(defvar-local nrepl-project-dir nil)
(defvar-local nrepl-on-connection-buffer nil)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The on-connection name seems a bit confusing to me. I guess it can't be named tunnel-connection, since the the connection mechanism is configurable, but I'm sure we can think of some more clear name for this.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Any suggestions for a better name? It needs to be configurable, as for example, when the ssh tunnel isn't required for the remote access.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm thinking of the following:

  • nrepl-jack-in-connection
  • nrepl-bridging-connection
  • nrepl-relay-connection

I'm not particularly fond of any of those. Btw, what's your logic for choosing on-connection as the name for this?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I use on-connection, as it is called once the repl has been started, when we need to connect to the repl. I suppose what it is really doing is providing (or modifying) the endpoint to connect to. So maybe:

  • nrepl-endpoint
  • nrepl-connection-endpoint

Note that this is in nrepl-client.el so should not have a jack-in specific name, in my opinion.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like `nrepl-connection-endpoint'. Seems to convey best the meaning.


(defconst nrepl-repl-buffer-name-template "*cider-repl%s*")
(defconst nrepl-connection-buffer-name-template "*nrepl-connection%s*")
(defconst nrepl-server-buffer-name-template "*nrepl-server%s*")
(defconst nrepl-on-connection-buffer-name-template "*nrepl-on-connection%s*")

(defcustom nrepl-hide-special-buffers nil
"Control the display of some special buffers in buffer switching commands.
Expand Down Expand Up @@ -134,6 +148,11 @@ connection port if `nrepl-buffer-name-show-port' is true."
(nrepl-apply-hide-special-buffers
(nrepl-buffer-name nrepl-server-buffer-name-template)))

(defun nrepl-on-connection-buffer-name ()
"Return the name of the on-connection buffer."
(nrepl-apply-hide-special-buffers
(nrepl-buffer-name nrepl-on-connection-buffer-name-template)))

;; buffer local declarations
(defvar-local nrepl-session nil
"Current nREPL session id.")
Expand Down Expand Up @@ -463,6 +482,8 @@ Also closes associated REPL and server buffers."
(when (buffer-live-p buffer)
(dolist (buf-name `(,(buffer-local-value 'nrepl-repl-buffer buffer)
,(buffer-local-value 'nrepl-server-buffer buffer)
,(buffer-local-value
'nrepl-on-connection-buffer buffer)
,buffer))
(when buf-name
(cider--close-buffer buf-name)))))))
Expand Down Expand Up @@ -695,6 +716,26 @@ are processed."
(nrepl-send-request-sync (nrepl-eval-request input ns session)))

;;; server
(defun nrepl--default-endpoint (dir port)
"The endpoint for a repl in project DIR on PORT.
Return a plist with :hostname, :port and :proc keys."
(list :hostname (if (file-remote-p dir)
tramp-current-host
"localhost")
:port port
:proc-buffer-name nil))

(defun nrepl--endpoint-for-connection (dir port)
"Call any `nrepl-connection-endpoint' for DIR and PORT.
Return a plist with :hostname and :port values, specifying where
to connect, and a :proc-buffer-name key, specifying the name of a
process buffer to associate with the connection. When no
`nrepl-connection-endpoint' is specified, returns a plist with
the hostname associated with DIR, and PORT."
(if (functionp nrepl-connection-endpoint)
(funcall nrepl-connection-endpoint dir port)
(nrepl--default-endpoint dir port)))

(defun nrepl-server-filter (process output)
"Process nREPL server output from PROCESS contained in OUTPUT."
(with-current-buffer (process-buffer process)
Expand All @@ -705,15 +746,21 @@ are processed."
(let ((port (string-to-number (match-string 1 output))))
(message (format "nREPL server started on %s" port))
(with-current-buffer (process-buffer process)
(let ((nrepl-process (nrepl-connect "localhost" port)))
(setq nrepl-connection-buffer
(buffer-name (process-buffer nrepl-process)))
(with-current-buffer (process-buffer nrepl-process)
(setq nrepl-server-buffer
(buffer-name (process-buffer process))
nrepl-project-dir
(buffer-local-value
'nrepl-project-dir (process-buffer process)))))))))
(let* ((endpoint (nrepl--endpoint-for-connection
default-directory port))
(hostname (plist-get endpoint :hostname))
(port (plist-get endpoint :port))
(proc-buffer-name (plist-get endpoint :proc-buffer-name)))
(let ((nrepl-process (nrepl-connect hostname port)))
(setq nrepl-connection-buffer
(buffer-name (process-buffer nrepl-process)))
(with-current-buffer (process-buffer nrepl-process)
(setq nrepl-server-buffer
(buffer-name (process-buffer process))
nrepl-project-dir
(buffer-local-value
'nrepl-project-dir (process-buffer process))
nrepl-on-connection-buffer proc-buffer-name))))))))

(defun nrepl-server-sentinel (process event)
"Handle nREPL server PROCESS EVENT."
Expand All @@ -735,6 +782,66 @@ are processed."
(error "Leiningen 2.x is required by CIDER"))
(t (error "Could not start nREPL server: %s" problem)))))

(defun nrepl--ssh-tunnel-command (ssh dir port)
"Command string to open SSH tunnel to the host associated with DIR's PORT."
(with-parsed-tramp-file-name dir nil
(format-spec
"%s -v -N -L %p:localhost:%p %u'%h'"
`((?s . ,ssh)
(?p . ,port)
(?h . ,host)
(?u . ,(if user (format "-l '%s' " user) ""))))))

(defun nrepl--ssh-tunnel-filter (port)
"Return a filter function for waiting on PORT to appear in output."
(let ((port-string (format "LOCALHOST:%s" port)))
(lambda (proc string)
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc))))))
(when (string-match port-string string)
(with-current-buffer (process-buffer proc)
(setq nrepl-wait-for-port nil))))))

(defun nrepl-connection-ssh-tunnel (dir port)
"Return an endpoint for SSH tunnel to project DIR path, and PORT port.
If DIR is remote, then attempt to open an SSH tunnel to port. If
the ssh executable is not found on the path, then fall back to
specifying a direct conneciton."
;; this abuses the -v option for ssh to get output when the port
;; forwarding is set up, which is used to synchronise on, so that
;; the port forwarding is up when we try to connect.
(if (file-remote-p dir)
(let ((ssh (executable-find "ssh")))
(if ssh
;; run cmd in a local shell
(let* ((cmd (nrepl--ssh-tunnel-command ssh dir port))
(on-connection-buffer-name (nrepl-on-connection-buffer-name))
(proc (start-process-shell-command
"nrepl-on-connection"
on-connection-buffer-name
cmd))
(on-connection-buffer (get-buffer
on-connection-buffer-name)))
(with-current-buffer on-connection-buffer-name
(setq-local nrepl-wait-for-port t))
(set-process-filter proc (nrepl--ssh-tunnel-filter port))
(while (and (buffer-local-value 'nrepl-wait-for-port
on-connection-buffer)
(process-live-p proc))
(accept-process-output nil 0.005))
(unless (process-live-p proc)
(message "SSH port forwarding failed"))
(list :hostname "localhost" :port port
:proc-buffer-name on-connection-buffer-name))
(nrepl--default-endpoint dir port)))
(list :hostname "localhost" :port port :proc-buffer-name nil)))

(defun nrepl-current-dir ()
"Return the directory of the current buffer."
(let ((file-name (buffer-file-name (current-buffer))))
Expand Down