More bug fixes from master for the 0.10.1 release

CHANGELOG.md

@@ -1,16 +1,26 @@
 # Changelog
 
-## master (unreleased)
-
 ## 0.10.1 / (unreleased)
 
+### Changes
+
+* Suppress eldoc when the current sexp seems to be too large.
+* [#1500](https://github.com/clojure-emacs/cider/pull/1500): Improve the performance of REPL buffers by using text properties instead of overlays for ANSI coloring.
+
 ### Bugs fixed
 
 * [#1480](https://github.com/clojure-emacs/cider/issues/1480): Fix an error in `cider-restart` caused by not using the REPL's buffer as the current connection when calling `cider-current-connection` from REPL buffer.
 * [#1450](https://github.com/clojure-emacs/cider/pull/1450): Fix an error in `cider-restart` caused by a reference to a killed buffer.
 * [#1459](https://github.com/clojure-emacs/cider/issues/1459): Add support for dynamic dispatch in scratch buffers.
 * [#1466](https://github.com/clojure-emacs/cider/issues/1466): Correctly font-lock pretty-printed results in the REPL.
 * [#1475](https://github.com/clojure-emacs/cider/pull/1475): Fix `args-out-of-range` error in `cider--get-symbol-indent`.
+* [#1479](https://github.com/clojure-emacs/cider/pull/1479): Make paredit and `cider-repl-mode` play nice.
+* [#1452](https://github.com/clojure-emacs/cider/issues/1452): Fix wrong ANSI coloring in the REPL buffer.
+* [#1486](https://github.com/clojure-emacs/cider/issues/1486): Complete a partial fix in stacktrace font-locking.
+* [#1482](https://github.com/clojure-emacs/cider/issues/1482): Clear nREPL sessions when a connection is closed.
+* [#1435](https://github.com/clojure-emacs/cider/issues/1435): Improve error display in cider-test.
+* [#1379](https://github.com/clojure-emacs/cider/issues/1379): Fix test highlighting at start of line.
+* [#1490](https://github.com/clojure-emacs/cider/issues/1490): Don't display the inspector buffer when evaluation fails.
 
 ## 0.10.0 / 2015-12-03
 

cider-debug.el

@@ -536,8 +536,7 @@ needed.  It is expected to contain at least \"key\", \"input-type\", and
              (setq cider--debug-mode-response response)
              (cider--debug-mode 1)))
           (when inspect
-            (cider-inspector--value-handler nil inspect)
-            (cider-inspector--done-handler (current-buffer))))
+            (cider-inspector--value-handler nil inspect)))
       ;; If something goes wrong, we send a "quit" or the session hangs.
       (error (cider-debug-mode-send-reply ":quit" key)
              (message "Error encountered while handling the debug message: %S" e)))))

cider-eldoc.el

@@ -42,6 +42,9 @@
 (defvar cider-extra-eldoc-commands '("yas-expand")
   "Extra commands to be added to eldoc's safe commands list.")
 
+(defvar cider-eldoc-max-num-sexps-to-skip 30
+  "The maximum number of sexps to skip while searching the beginning of current sexp.")
+
 (defvar-local cider-eldoc-last-symbol nil
   "The eldoc information for the last symbol we checked.")
 
@@ -89,7 +92,8 @@ POS is the index of current argument."
 (defun cider-eldoc-beginning-of-sexp ()
   "Move to the beginning of current sexp.
 
-Return the number of nested sexp the point was over or after."
+Return the number of nested sexp the point was over or after.  Return nil
+if the maximum number of sexps to skip is exceeded."
   (let ((parse-sexp-ignore-comments t)
         (num-skipped-sexps 0))
     (condition-case _
@@ -107,14 +111,25 @@ Return the number of nested sexp the point was over or after."
               (let ((p (point)))
                 (forward-sexp -1)
                 (when (< (point) p)
-                  (setq num-skipped-sexps (1+ num-skipped-sexps))))))
+                  (setq num-skipped-sexps
+                        (unless (and cider-eldoc-max-num-sexps-to-skip
+                                     (>= num-skipped-sexps
+                                         cider-eldoc-max-num-sexps-to-skip))
+                          ;; Without the above guard,
+                          ;; `cider-eldoc-beginning-of-sexp' could traverse the
+                          ;; whole buffer when the point is not within a
+                          ;; list. This behavior is problematic especially with
+                          ;; a buffer containing a large number of
+                          ;; non-expressions like a REPL buffer.
+                          (1+ num-skipped-sexps)))))))
       (error))
     num-skipped-sexps))
 
 (defun cider-eldoc-info-in-current-sexp ()
   "Return a list of the current sexp and the current argument index."
   (save-excursion
-    (let ((argument-index (1- (cider-eldoc-beginning-of-sexp))))
+    (when-let ((beginning-of-sexp (cider-eldoc-beginning-of-sexp))
+               (argument-index (1- beginning-of-sexp)))
       ;; If we are at the beginning of function name, this will be -1.
       (when (< argument-index 0)
         (setq argument-index 0))

cider-inspector.el

@@ -94,19 +94,15 @@ The page size can be also changed interactively within the inspector."
 ;; Operations
 (defun cider-inspector--value-handler (_buffer value)
   (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode)
-  (cider-irender cider-inspector-buffer value))
+  (cider-inspector-render cider-inspector-buffer value)
+  (cider-popup-buffer-display cider-inspector-buffer t))
 
 (defun cider-inspector--out-handler (_buffer value)
   (cider-emit-interactive-eval-output value))
 
 (defun cider-inspector--err-handler (_buffer err)
   (cider-emit-interactive-eval-err-output err))
 
-(defun cider-inspector--done-handler (buffer)
-  (when (get-buffer cider-inspector-buffer)
-    (with-current-buffer buffer
-      (cider-popup-buffer-display cider-inspector-buffer t))))
-
 (defun cider-inspector-response-handler (buffer)
   "Create an inspector response handler for BUFFER.
 
@@ -120,7 +116,7 @@ Used for all inspector nREPL ops."
                                #'cider-inspector--value-handler
                                #'cider-inspector--out-handler
                                #'cider-inspector--err-handler
-                               #'cider-inspector--done-handler))
+                               #'identity))
 
 (defun cider-inspect-expr (expr ns)
   (cider--prep-interactive-eval expr)
@@ -176,33 +172,33 @@ Current page will be reset to zero."
                             (cider-inspector-response-handler (current-buffer))))
 
 ;; Render Inspector from Structured Values
-(defun cider-irender (buffer str)
+(defun cider-inspector-render (buffer str)
   (with-current-buffer buffer
     (cider-inspector-mode)
     (let ((inhibit-read-only t))
       (condition-case nil
-          (cider-irender* (car (read-from-string str)))
+          (cider-inspector-render* (car (read-from-string str)))
         (error (insert "\nInspector error for: " str))))
     (goto-char (point-min))))
 
-(defun cider-irender* (elements)
+(defun cider-inspector-render* (elements)
   (dolist (el elements)
-    (cider-irender-el* el)))
+    (cider-inspector-render-el* el)))
 
-(defun cider-irender-el* (el)
+(defun cider-inspector-render-el* (el)
   (cond ((symbolp el) (insert (symbol-name el)))
         ((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face)))
         ((and (consp el) (eq (car el) :newline))
          (insert "\n"))
         ((and (consp el) (eq (car el) :value))
-         (cider-irender-value (cadr el) (cl-caddr el)))
+         (cider-inspector-render-value (cadr el) (cl-caddr el)))
         (t (message "Unrecognized inspector object: %s" el))))
 
-(defun cider-irender-value (value idx)
+(defun cider-inspector-render-value (value idx)
   (cider-propertize-region
       (list 'cider-value-idx idx
             'mouse-face 'highlight)
-    (cider-irender-el* (cider-font-lock-as-clojure value))))
+    (cider-inspector-render-el* (cider-font-lock-as-clojure value))))
 
 
 ;; ===================================================
@@ -277,7 +273,7 @@ If ARG is negative, move forwards."
 
 (defun cider-inspector-operate-on-point ()
   "Invoke the command for the text at point.
-1. If point is on a value then recursivly call the inspector on
+1. If point is on a value then recursively call the inspector on
 that value.
 2. If point is on an action then call that action.
 3. If point is on a range-button fetch and insert the range."

cider-repl.el

@@ -469,22 +469,21 @@ If BOL is non-nil insert at the beginning of line."
           (goto-char position)
           ;; TODO: Review the need for bol
           (when (and bol (not (bolp))) (insert-before-markers "\n"))
-          (cider-propertize-region `(font-lock-face ,output-face
-                                                    rear-nonsticky (font-lock-face))
-            (insert-before-markers string)
-            (when (and (= (point) cider-repl-prompt-start-mark)
-                       (not (bolp)))
-              (insert-before-markers "\n")
-              (set-marker cider-repl-output-end (1- (point))))))))
+          (insert-before-markers (ansi-color-apply (propertize string
+                                                               'font-lock-face output-face
+                                                               'rear-nonsticky '(font-lock-face))))
+          (when (and (= (point) cider-repl-prompt-start-mark)
+                     (not (bolp)))
+            (insert-before-markers "\n")
+            (set-marker cider-repl-output-end (1- (point)))))))
     (cider-repl--show-maximum-output)))
 
 (defun cider-repl--emit-interactive-output (string face)
   "Emit STRING as interactive output using FACE."
   (with-current-buffer (cider-current-repl-buffer)
     (let ((pos (cider-repl--end-of-line-before-input-start))
           (string (replace-regexp-in-string "\n\\'" "" string)))
-      (cider-repl--emit-output-at-pos (current-buffer) string face pos t)
-      (ansi-color-apply-on-region pos (point-max)))))
+      (cider-repl--emit-output-at-pos (current-buffer) string face pos t))))
 
 (defun cider-repl-emit-interactive-stdout (string)
   "Emit STRING as interactive output."
@@ -509,9 +508,7 @@ FORMAT is a format string to compile with ARGS and display on the REPL."
   "Using BUFFER, emit STRING font-locked with FACE.
 If BOL is non-nil, emit at the beginning of the line."
   (with-current-buffer buffer
-    (let ((pos (cider-repl--end-of-line-before-input-start)))
-      (cider-repl--emit-output-at-pos buffer string face cider-repl-input-start-mark bol)
-      (ansi-color-apply-on-region pos (point-max)))))
+    (cider-repl--emit-output-at-pos buffer string face cider-repl-input-start-mark bol)))
 
 (defun cider-repl-emit-stdout (buffer string)
   "Using BUFFER, emit STRING as standard output."
@@ -731,12 +728,17 @@ text property `cider-old-input'."
 
 (defvar cider-repl-clear-buffer-hook)
 
+(defun cider-repl--clear-region (start end)
+  "Delete the output and its overlays between START and END."
+  (mapc 'delete-overlay (overlays-in start end))
+  (delete-region start end))
+
 (defun cider-repl-clear-buffer ()
   "Delete the output generated by the Clojure process."
   (interactive)
   (let ((inhibit-read-only t))
-    (delete-region (point-min) cider-repl-prompt-start-mark)
-    (delete-region cider-repl-output-start cider-repl-output-end)
+    (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark)
+    (cider-repl--clear-region cider-repl-output-start cider-repl-output-end)
     (when (< (point) cider-repl-input-start-mark)
       (goto-char cider-repl-input-start-mark))
     (recenter t))
@@ -761,7 +763,7 @@ With a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead."
           (end (cider-repl--end-of-line-before-input-start)))
       (when (< start end)
         (let ((inhibit-read-only t))
-          (delete-region start end)
+          (cider-repl--clear-region start end)
           (save-excursion
             (goto-char start)
             (insert
@@ -1231,7 +1233,7 @@ constructs."
     (cider-repl-history-load cider-repl-history-file)
     (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t)
     (add-hook 'kill-emacs-hook #'cider-repl-history-just-save))
-  (add-hook 'paredit-mode-hook #'clojure-paredit-setup))
+  (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map))))
 
 (provide 'cider-repl)
 

cider-stacktrace.el

@@ -497,7 +497,8 @@ This associates text properties to enable filtering and source navigation."
                             'flags flags 'follow-link t
                             'action 'cider-stacktrace-navigate
                             'help-echo "View source at this location"
-                            'face 'cider-stacktrace-face)
+                            'font-lock-face 'cider-stacktrace-face
+                            'type 'cider-plain-button)
         (save-excursion
           (let ((p4 (point))
                 (p1 (search-backward " "))

cider-test.el

@@ -196,7 +196,8 @@
                (status (when causes
                          (cider-stacktrace-render
                           (cider-popup-buffer cider-error-buffer
-                                              cider-auto-select-error-buffer)
+                                              cider-auto-select-error-buffer
+                                              #'cider-stacktrace-mode)
                           (reverse causes))))))))))
 
 (defun cider-test-stacktrace ()
@@ -287,18 +288,20 @@ With the actual value, the outermost '(not ...)' s-expression is removed."
         (cider-insert var 'font-lock-function-name-face t)
         (when context  (cider-insert context 'font-lock-doc-face t))
         (when message  (cider-insert message 'font-lock-doc-string-face t))
-        (when expected (cider-insert "expected: " 'font-lock-comment-face nil
-                                     (cider-font-lock-as-clojure expected)))
-        (when actual   (cider-insert "  actual: " 'font-lock-comment-face)
-              (if error
-                  (progn (insert-text-button
-                          error
-                          'follow-link t
-                          'action '(lambda (_button) (cider-test-stacktrace))
-                          'help-echo "View causes and stacktrace")
-                         (insert "\n"))
-                (insert (cider-font-lock-as-clojure actual)))))
-      (insert "\n"))))
+        (when expected
+          (cider-insert "expected: " 'font-lock-comment-face nil
+                        (cider-font-lock-as-clojure expected)))
+        (when actual
+          (cider-insert "  actual: " 'font-lock-comment-face nil
+                        (cider-font-lock-as-clojure actual)))
+        (when error
+          (cider-insert "   error: " 'font-lock-comment-face nil)
+          (insert-text-button error
+                              'follow-link t
+                              'action '(lambda (_button) (cider-test-stacktrace))
+                              'help-echo "View causes and stacktrace")
+          (insert "\n"))
+        (insert "\n")))))
 
 (defun cider-test-render-report (buffer ns summary results)
   "Emit into BUFFER the report for the NS, SUMMARY, and test RESULTS."
@@ -358,8 +361,7 @@ With the actual value, the outermost '(not ...)' s-expression is removed."
         (save-excursion
           (goto-char (point-min))
           (forward-line (1- line))
-          (forward-whitespace 1)
-          (forward-char)
+          (search-forward "(" nil t)
           (let ((beg (point)))
             (forward-sexp)
             (let ((overlay (make-overlay beg (point))))

cider-util.el

@@ -269,6 +269,10 @@ Unless you specify a BUFFER it will default to the current one."
   "Font-lock STRING as Clojure code."
   (cider-font-lock-as 'clojure-mode string))
 
+;; Button allowing use of `font-lock-face', ignoring any inherited `face'
+(define-button-type 'cider-plain-button
+  'face nil)
+
 ;;; Colors
 
 (defun cider-scale-color (color scale)

nrepl-client.el

@@ -615,6 +615,7 @@ and kill the process buffer."
              (substring message 0 -1)))
   (when (equal (process-status process) 'closed)
     (when-let ((client-buffer (process-buffer process)))
+      (nrepl--clear-client-sessions client-buffer)
       (with-current-buffer client-buffer
         (run-hooks 'nrepl-disconnected-hook)
         (when (buffer-live-p nrepl-server-buffer)
@@ -800,6 +801,12 @@ values of *1, *2, etc."
         (setq nrepl-ops ops)
         (setq nrepl-versions versions)))))
 
+(defun nrepl--clear-client-sessions (conn-buffer)
+  "Clear client nREPL sessions in CONN-BUFFER."
+  (with-current-buffer conn-buffer
+    (setq nrepl-session nil)
+    (setq nrepl-tooling-session nil)))
+
 (define-obsolete-function-alias 'nrepl-close 'cider--close-connection-buffer "0.10.0")
 
 ;;; Client: Response Handling

test/cider-tests.el

@@ -517,10 +517,54 @@
   (should (equal (cider-repl-prompt-abbreviated "some.pretty.long.namespace.name")
                  "s.p.l.n.name> ")))
 
+(ert-deftest test-cider-repl--emit-output-at-pos-with-ansi-code ()
+  (with-temp-buffer
+    (let* ((ansi-color-names-vector ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"])
+           (ansi-color-map (ansi-color-make-color-map)))
+      (cider-repl-reset-markers)
+
+      (cider-repl--emit-output-at-pos (current-buffer) "a" 'cider-repl-stdout-face (point))
+      (cider-repl--emit-output-at-pos (current-buffer) "b" 'cider-repl-stdout-face (point))
+      (cider-repl--emit-output-at-pos (current-buffer) "c" 'cider-repl-stdout-face (point))
+      (cider-repl--emit-output-at-pos (current-buffer) "d" 'cider-repl-stdout-face (point))
+
+      (should (string= (buffer-string) "a\nb\nc\nd\n"))
+      (should (equal (get-text-property 1 'font-lock-face) '(foreground-color . "black")))
+      (should (equal (get-text-property 3 'font-lock-face) 'cider-repl-stdout-face))
+      (should (equal (get-text-property 5 'font-lock-face) '(foreground-color . "red3")))
+      (should (equal (get-text-property 7 'font-lock-face) '(foreground-color . "red3"))))))
+
 (ert-deftest test-cider--url-to-file ()
   (should (equal "/space test" (cider--url-to-file "file:/space%20test")))
   (should (equal "C:/space test" (cider--url-to-file "file:/C:/space%20test"))))
 
+(ert-deftest test-cider-eldoc-beginning-of-sexp ()
+  (with-temp-buffer
+    (save-excursion
+      (insert "(a (b b) (c c) d)"))
+    (search-forward "d")
+
+    (let ((cider-eldoc-max-num-sexps-to-skip nil))
+      (save-excursion
+        (should (eq (cider-eldoc-beginning-of-sexp) 4))
+        (should (eq (point) 2))))
+
+    (let ((cider-eldoc-max-num-sexps-to-skip 4))
+      (save-excursion
+        (should (eq (cider-eldoc-beginning-of-sexp) 4))
+        (should (eq (point) 2))))
+
+    (let ((cider-eldoc-max-num-sexps-to-skip 3))
+      (save-excursion
+        (should (eq (cider-eldoc-beginning-of-sexp) nil))
+        (should (eq (point) 2))))
+
+    (let ((cider-eldoc-max-num-sexps-to-skip 2))
+      (save-excursion
+        (should (eq (cider-eldoc-beginning-of-sexp) nil))
+        (should (eq (point) 4))))))
+
+
 
 ;;; Cygwin tests