Merge pull request #1399 from clojure-emacs/dual-dispatch-eval

[Fix #1299] Eval in both REPLs for cljc and cljx

Author: bbatsov

CHANGELOG.md

@@ -49,6 +49,7 @@
 
 ### Changes
 
+* [#1299]https://github.com/clojure-emacs/cider/issues/1299 <kbd>C-c C-k</kbd> and <kbd> C-c C-l</kbd> now dispatch to both the Clojure and ClojureScript REPL (in the same project) when called from a `.cljc` or `.cljx` file.
 * [#1397](https://github.com/clojure-emacs/cider/issues/1297) <kbd>C-c M-n</kbd> now changes the ns of both the Clojure and ClojureScript REPL (in the same project) when called from a cljc or cljx file.
 * [#1348](https://github.com/clojure-emacs/cider/issues/1348): Drop the dash dependency.
 * The usage of the default connection has been reduced significantly. Now evaluations & related commands will be routed via the connection matching the current project automatically unless there's some ambiguity when determining the connection (like multiple or no matching connections). Simply put you'll no longer have to mess around much with connecting-setting commands (e.g. `nrepl-connection-browser`, `cider-rotate-default-connection`).

cider-client.el

@@ -207,30 +207,28 @@ from the file extension."
   (cider-connections) ; Cleanup the connections list.
   (if (eq cider-request-dispatch 'dynamic)
       (cond
-       ((cider--in-connection-buffer-p) (current-buffer))
+       ((and (not type) (cider--in-connection-buffer-p)) (current-buffer))
        ((= 1 (length cider-connections)) (car cider-connections))
-       (t (let ((repls (cider-find-connection-buffer-for-project-directory
-                        nil :all-connections)))
-            (if (= 1 (length repls))
+       (t (let ((project-connections
+                 (cider-find-connection-buffer-for-project-directory
+                  nil :all-connections)))
+            (if (= 1 (length project-connections))
                 ;; Only one match, just return it.
-                (car repls)
+                (car project-connections)
               ;; OW, find one matching the extension of current file.
               (let ((type (or type (file-name-extension (or (buffer-file-name) "")))))
                 (or (seq-find (lambda (conn)
-                                (equal (with-current-buffer conn
-                                         cider-repl-type)
-                                       type))
-                              (append repls cider-connections))
-                    (car repls)
+                                (equal (cider--connection-type conn) type))
+                              project-connections)
+                    (car project-connections)
                     (car cider-connections)))))))
     ;; TODO: Add logic to dispatch to a matching Clojure/ClojureScript REPL based on file type
     (car cider-connections)))
 
 (defun cider-other-connection (&optional connection)
-  "Return the first connection of another type than `cider-current-connection', \
-in the same project, or nil.
-
-If CONNECTION is provided act on that connection instead."
+  "Return the first connection of another type than CONNECTION
+Only return connections in the same project or nil.
+CONNECTION defaults to `cider-current-connection'."
   (let* ((connection (or connection (cider-current-connection)))
          (connection-type (cider--connection-type connection))
          (other (if (equal connection-type "clj")
@@ -239,6 +237,17 @@ If CONNECTION is provided act on that connection instead."
     (unless (equal connection-type (cider--connection-type other))
       other)))
 
+(defun cider-map-connections (function)
+  "Call FUNCTION once for each appropriate connection.
+The function is called with one argument, the connection buffer.
+The appropriate connections are found by inspecting the current buffer.  If
+the buffer is associated with a .cljc or .cljx file, BODY will be executed
+multiple times."
+  (if-let ((is-cljc (cider--cljc-or-cljx-buffer-p))
+           (other-connection (cider-other-connection)))
+      (mapc function (list (cider-current-connection) other-connection))
+    (funcall function (cider-current-connection))))
+
 
 ;;; Connection Browser
 (defvar cider-connections-buffer-mode-map
@@ -422,29 +431,26 @@ Signal an error if it is not supported."
   (unless (cider-nrepl-op-supported-p op)
     (error "Can't find nREPL middleware providing op \"%s\".  Please, install (or update) cider-nrepl %s and restart CIDER" op (upcase cider-version))))
 
-(defun cider--ensure-session (request)
-  "Make sure REQUEST has session.
-
-If the nREPL request lacks a session `cider-current-session' is added."
-  (if (seq-contains request "session")
-      request
-    (append request (list "session" (cider-current-session)))))
-
-(defun cider-nrepl-send-request (request callback)
+(defun cider-nrepl-send-request (request callback &optional connection)
   "Send REQUEST and register response handler CALLBACK.
 REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
 \"par1\" ... ).
+If CONNECTION is provided dispatch to that connection instead of
+the current connection.
+
 Return the id of the sent message."
-  (nrepl-send-request (cider--ensure-session request) callback (cider-current-connection)))
+  (nrepl-send-request request callback (or connection (cider-current-connection))))
 
-(defun cider-nrepl-send-sync-request (request &optional abort-on-input)
+(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input)
   "Send REQUEST to the nREPL server synchronously.
 Hold till final \"done\" message has arrived and join all response messages
 of the same \"op\" that came along and return the accumulated response.
 If ABORT-ON-INPUT is non-nil, the function will return nil
 at the first sign of user input, so as not to hang the
 interface."
-  (nrepl-send-sync-request (cider--ensure-session request) (cider-current-connection) abort-on-input))
+  (nrepl-send-sync-request request
+                           (or connection (cider-current-connection))
+                           abort-on-input))
 
 (defun cider-nrepl-send-unhandled-request (request)
   "Send REQUEST to the nREPL server and ignore any responses.
@@ -612,17 +618,21 @@ thing at point."
 ;;; Requests
 
 (declare-function cider-load-file-handler "cider-interaction")
-(defun cider-request:load-file (file-contents file-path file-name &optional callback)
+(defun cider-request:load-file (file-contents file-path file-name &optional connection callback)
   "Perform the nREPL \"load-file\" op.
 FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be
-loaded. If CALLBACK is nil, use `cider-load-file-handler'."
+loaded.
+
+If CONNECTION is nil, use `cider-current-connection'.
+If CALLBACK is nil, use `cider-load-file-handler'."
   (cider-nrepl-send-request (list "op" "load-file"
                                   "session" (cider-current-session)
                                   "file" file-contents
                                   "file-path" file-path
                                   "file-name" file-name)
                             (or callback
-                                (cider-load-file-handler (current-buffer)))))
+                                (cider-load-file-handler (current-buffer)))
+                            connection))
 
 
 ;;; Sync Requests

cider-interaction.el

@@ -1350,32 +1350,15 @@ unloaded."
   (with-current-buffer (find-file-noselect file)
     (substring-no-properties (buffer-string))))
 
-(defun cider-load-file (filename)
-  "Load (eval) the Clojure file FILENAME in nREPL."
-  (interactive (list
-                (read-file-name "Load file: " nil nil nil
-                                (when (buffer-file-name)
-                                  (file-name-nondirectory
-                                   (buffer-file-name))))))
-  (cider-ensure-connected)
-  (when-let ((buf (find-buffer-visiting filename)))
-    (with-current-buffer buf
-      (remove-overlays nil nil 'cider-type 'instrumented-defs)
-      (cider--clear-compilation-highlights)))
-  (cider--quit-error-window)
-  (cider--cache-ns-form)
-  (cider-request:load-file
-   (cider-file-string filename)
-   (funcall cider-to-nrepl-filename-function (cider--server-filename filename))
-   (file-name-nondirectory filename))
-  (message "Loading %s..." filename))
-
 (defun cider-load-buffer (&optional buffer)
   "Load (eval) BUFFER's file in nREPL.
 If no buffer is provided the command acts on the current buffer.
-The heavy lifting is done by `cider-load-file'."
+
+If the buffer is for a cljc or cljx file, and both a Clojure and
+ClojureScript REPL exists for the project, it is evaluated in both REPLs."
   (interactive)
   (check-parens)
+  (cider-ensure-connected)
   (setq buffer (or buffer (current-buffer)))
   (with-current-buffer buffer
     (unless buffer-file-name
@@ -1385,7 +1368,34 @@ The heavy lifting is done by `cider-load-file'."
                (or (eq cider-prompt-save-file-on-load 'always-save)
                    (y-or-n-p (format "Save file %s? " buffer-file-name))))
       (save-buffer))
-    (cider-load-file buffer-file-name)))
+    (remove-overlays nil nil 'cider-type 'instrumented-defs)
+    (cider--clear-compilation-highlights)
+    (cider--quit-error-window)
+    (cider--cache-ns-form)
+    (let ((filename (buffer-file-name)))
+      (cider-map-connections
+       (lambda (connection)
+         (cider-request:load-file (cider-file-string filename)
+                                  (funcall cider-to-nrepl-filename-function
+                                           (cider--server-filename filename))
+                                  (file-name-nondirectory filename)
+                                  connection)))
+      (message "Loading %s..." filename))))
+
+(defun cider-load-file (filename)
+  "Load (eval) the Clojure file FILENAME in nREPL.
+
+If the file is a cljc or cljx file, and both a Clojure and ClojureScript
+REPL exists for the project, it is evaluated in both REPLs.
+
+The heavy lifting is done by `cider-load-buffer'."
+  (interactive (list
+                (read-file-name "Load file: " nil nil nil
+                                (when (buffer-file-name)
+                                  (file-name-nondirectory
+                                   (buffer-file-name))))))
+  (when-let ((buffer (find-buffer-visiting filename)))
+    (cider-load-buffer buffer)))
 
 (defalias 'cider-eval-file 'cider-load-file
   "A convenience alias as some people are confused by the load-* names.")

cider-mode.el

@@ -409,7 +409,8 @@ namespace itself."
   (interactive)
   (when cider-font-lock-dynamically
     (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)
-    (when-let ((symbols (cider-resolve-ns-symbols (or ns (cider-current-ns)))))
+    (when-let ((ns (or ns (cider-current-ns)))
+               (symbols (cider-resolve-ns-symbols ns)))
       (setq-local cider--dynamic-font-lock-keywords
                   (cider--compile-font-lock-keywords
                    symbols (cider-resolve-ns-symbols (cider-resolve-core-ns))))

cider-repl.el

@@ -790,13 +790,10 @@ namespace to switch to."
                        (cider-current-ns))))
   (when (or (not ns) (equal ns ""))
     (user-error "No namespace selected"))
-  (cider-nrepl-request:eval (format "(in-ns '%s)" ns)
-                            (cider-repl-switch-ns-handler
-                             (cider-current-connection)))
-  (when (cider--cljc-or-cljx-buffer-p)
-    (when-let ((other-connection (cider-other-connection)))
-      (cider-nrepl-request:eval (format "(in-ns '%s)" ns)
-                                (cider-repl-switch-ns-handler other-connection)))))
+  (cider-map-connections
+   (lambda (connection)
+     (cider-nrepl-request:eval (format "(in-ns '%s)" ns)
+                               (cider-repl-switch-ns-handler connection)))))
 
 
 ;;;;; History

nrepl-client.el

@@ -493,7 +493,7 @@ object is a root list or dict."
    ;; else, throw a quiet error
    (t
     (message "Invalid bencode message detected. See %s buffer."
-             nrepl-message-buffer-name)
+             nrepl-message-buffer-name-template)
     (nrepl-log-message
      (format "Decoder error at position %d (`%s'):"
              (point) (buffer-substring (point) (min (+ (point) 10) (point-max)))))
@@ -896,14 +896,17 @@ REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
 \"par1\" ... ). See the code of `nrepl-request:clone',
 `nrepl-request:stdin', etc.
 Return the ID of the sent message."
-  (let* ((id (nrepl-next-request-id connection))
-         (request (cons 'dict (lax-plist-put request "id" id)))
-         (message (nrepl-bencode request)))
-    (nrepl-log-message request 'request)
-    (with-current-buffer connection
+  (with-current-buffer connection
+    (unless (or (plist-get request "session")
+                (not nrepl-session))
+      (setq request (append request (list "session" nrepl-session))))
+    (let* ((id (nrepl-next-request-id connection))
+           (request (cons 'dict (lax-plist-put request "id" id)))
+           (message (nrepl-bencode request)))
+      (nrepl-log-message request 'request)
       (puthash id callback nrepl-pending-requests)
-      (process-send-string nil message))
-    id))
+      (process-send-string nil message)
+      id)))
 
 (defvar nrepl-ongoing-sync-request nil
   "Dynamically bound to t while a sync request is ongoing.")
@@ -995,7 +998,7 @@ If LINE and COLUMN are non-nil and current buffer is a file buffer, \"line\",
                     "line" line
                     "column" column)))))
 
-(defun nrepl-request:eval (input callback connection session &optional ns line column)
+(defun nrepl-request:eval (input callback connection &optional session ns line column)
   "Send the request INPUT and register the CALLBACK as the response handler.
 The request is dispatched via CONNECTION and SESSION.  If NS is non-nil,
 include it in the request. LINE and COLUMN, if non-nil, define the position
@@ -1137,7 +1140,7 @@ the port, and the client buffer."
 ;;; Messages
 
 (defcustom nrepl-log-messages t
-  "If non-nil, log protocol messages to the `nrepl-message-buffer-name' buffer."
+  "If non-nil, log protocol messages to the `nrepl-message-buffer-name-template' buffer."
   :type 'boolean
   :group 'nrepl)
 
@@ -1181,7 +1184,7 @@ operations.")
     (`response (cons '<- (cdr msg)))))
 
 (defun nrepl-log-message (msg type)
-  "Log the given MSG to the buffer given by `nrepl-message-buffer-name'.
+  "Log the given MSG to the buffer given by `nrepl-message-buffer-name-template'.
 
 TYPE is either request or response."
   (when nrepl-log-messages