diff options
author | Bozhidar Batsov <bozhidar@batsov.com> | 2015-11-25 19:13:42 +0200 |
---|---|---|
committer | Bozhidar Batsov <bozhidar@batsov.com> | 2015-11-25 19:13:42 +0200 |
commit | abb69bbf74ca511217e05b1e76b98230b96637b8 (patch) | |
tree | 5f7776735889acffbee71d793d43ee28bfaa7a7b | |
parent | 6fafa1b240076cff80c7fb411a8c85a01b315806 (diff) |
[#1412] Track nREPL messages per session
-rw-r--r-- | CHANGELOG.md | 1 | ||||
-rw-r--r-- | cider-client.el | 4 | ||||
-rw-r--r-- | cider-popup.el | 2 | ||||
-rw-r--r-- | cider-selector.el | 2 | ||||
-rw-r--r-- | nrepl-client.el | 43 | ||||
-rw-r--r-- | test/cider-selector-tests.el | 18 |
6 files changed, 44 insertions, 26 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index d8ce9f5d..bcf2b52f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -57,6 +57,7 @@ * Renamed `cider-repl-output-face` to `cider-repl-stdout-face` and `cider-repl-err-output-face` to `cider-repl-stderr-face`. * Clearing the REPL buffer is now bound to `C-u C-C C-o`. * [#1422](https://github.com/clojure-emacs/cider/issues/1422): Don't display mismatching parens error on incomplete expressions in REPL buffers. +* [#1412](https://github.com/clojure-emacs/cider/issues/1412): nREPL messages for separate sessions are tracked in separate buffers. ### Bugs fixed diff --git a/cider-client.el b/cider-client.el index f2760c47..b27a1af5 100644 --- a/cider-client.el +++ b/cider-client.el @@ -529,6 +529,10 @@ Return the REPL buffer given by `cider-current-connection'.") (with-current-buffer (cider-current-connection) nrepl-session)) +(defun cider-current-messages-buffer () + "The nREPL messages buffer, matching the current connection." + (format nrepl-message-buffer-name-template (cider-current-session))) + (define-obsolete-function-alias 'nrepl-current-session 'cider-current-session "0.10") (defun cider-current-tooling-session () diff --git a/cider-popup.el b/cider-popup.el index 13d28bfd..515e3299 100644 --- a/cider-popup.el +++ b/cider-popup.el @@ -74,7 +74,7 @@ If prefix argument KILL is non-nil, kill the buffer instead of burying it." (defvar-local cider-popup-output-marker nil) -(defvar cider-ancillary-buffers (list nrepl-message-buffer-name)) +(defvar cider-ancillary-buffers nil) (defun cider-make-popup-buffer (name &optional mode ancillary) "Create a temporary buffer called NAME using major MODE (if specified). diff --git a/cider-selector.el b/cider-selector.el index 6c886d25..fc016862 100644 --- a/cider-selector.el +++ b/cider-selector.el @@ -143,7 +143,7 @@ is chosen. The returned buffer is selected with (def-cider-selector-method ?m "*nrepl-messages* buffer." - nrepl-message-buffer-name) + (cider-current-messages-buffer)) (def-cider-selector-method ?x "*cider-error* buffer." diff --git a/nrepl-client.el b/nrepl-client.el index 200c0b18..2d2bd462 100644 --- a/nrepl-client.el +++ b/nrepl-client.el @@ -181,7 +181,7 @@ To be used for tooling calls (i.e. completion, eldoc, etc)") ;;; nREPL Buffer Names -(defconst nrepl-message-buffer-name "*nrepl-messages*") +(defconst nrepl-message-buffer-name-template "*nrepl-messages %s*") (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*") @@ -597,7 +597,7 @@ First we check the callbacks of pending requests. If no callback was found, we check the completed requests, since responses could be received even for older requests with \"done\" status." (nrepl-dbind-response response (id) - (nrepl-log-message (cons '<- (cdr response))) + (nrepl-log-message response 'response) (let ((callback (or (gethash id nrepl-pending-requests) (gethash id nrepl-completed-requests)))) (if callback @@ -899,7 +899,7 @@ 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 (cons '---> (cdr request))) + (nrepl-log-message request 'request) (with-current-buffer connection (puthash id callback nrepl-pending-requests) (process-send-string nil message)) @@ -1174,17 +1174,26 @@ operations.") (setq-local paragraph-start "(--->\\|(<-") (setq-local paragraph-separate "(<-")) -(defun nrepl-log-message (msg) - "Log the given MSG to the buffer given by `nrepl-message-buffer-name'." +(defun nrepl-decorate-msg (msg type) + "Decorate nREPL MSG according to its TYPE." + (pcase type + ('request (cons '---> (cdr msg))) + ('response (cons '<- (cdr msg))))) + +(defun nrepl-log-message (msg type) + "Log the given MSG to the buffer given by `nrepl-message-buffer-name'. + +TYPE is either request or response." (when nrepl-log-messages - (with-current-buffer (nrepl-messages-buffer) + (with-current-buffer (nrepl-messages-buffer msg) (setq buffer-read-only nil) (when (> (buffer-size) nrepl-message-buffer-max-size) (goto-char (/ (buffer-size) nrepl-message-buffer-reduce-denominator)) (re-search-forward "^(" nil t) (delete-region (point-min) (- (point) 1))) (goto-char (point-max)) - (nrepl--pp msg (nrepl--message-color (lax-plist-get (cdr msg) "id"))) + (nrepl--pp (nrepl-decorate-msg msg type) + (nrepl--message-color (lax-plist-get (cdr msg) "id"))) (when-let ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t)))) @@ -1248,15 +1257,17 @@ Set this to nil to prevent truncation." 'follow-link t)))) (insert (color ")\n")))))))) -(defun nrepl-messages-buffer () - "Return or create the buffer given by `nrepl-message-buffer-name'. -The default buffer name is *nrepl-messages*." - (or (get-buffer nrepl-message-buffer-name) - (let ((buffer (get-buffer-create nrepl-message-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl-messages-mode) - buffer)))) +(defun nrepl-messages-buffer (msg) + "Return or create the buffer for MSG. +The default buffer name is *nrepl-messages session*." + (let* ((msg-session (nrepl-dict-get msg "session")) + (msg-buffer-name (format nrepl-message-buffer-name-template msg-session))) + (or (get-buffer msg-buffer-name) + (let ((buffer (get-buffer-create msg-buffer-name))) + (with-current-buffer buffer + (buffer-disable-undo) + (nrepl-messages-mode) + buffer))))) (defun nrepl-create-client-buffer-default (endpoint) "Create an nREPL client process buffer. diff --git a/test/cider-selector-tests.el b/test/cider-selector-tests.el index 62112469..30933abd 100644 --- a/test/cider-selector-tests.el +++ b/test/cider-selector-tests.el @@ -1,10 +1,11 @@ +(require 'noflet) (require 'cider) (require 'cider-selector) ;; selector (defun cider-invoke-selector-method-by-key (ch) (let ((method (find ch cider-selector-methods :key #'car))) - (funcall (third method)))) + (funcall (third method)))) (ert-deftest test-cider-selector-n () (with-temp-buffer @@ -48,10 +49,11 @@ (should (equal (current-buffer) b1))))))) (ert-deftest test-cider-selector-m () - (with-temp-buffer - (rename-buffer "*nrepl-messages*") - (let ((b1 (current-buffer))) - (with-temp-buffer - (should (not (equal (current-buffer) b1))) - (cider-invoke-selector-method-by-key ?m) - (should (equal (current-buffer) b1)))))) + (noflet ((cider-current-messages-buffer () "*nrepl-messages session-id*")) + (with-temp-buffer + (rename-buffer "*nrepl-messages session-id*") + (let ((b1 (current-buffer))) + (with-temp-buffer + (should (not (equal (current-buffer) b1))) + (cider-invoke-selector-method-by-key ?m) + (should (equal (current-buffer) b1))))))) |