diff --git a/CHANGELOG.md b/CHANGELOG.md index fb12dbdd3..05f23e188 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -45,6 +45,11 @@ - Convert modern tuple-format indent specs (e.g. `[[:block 1] [:inner 0]]`) to legacy format for compatibility with older clojure-mode versions. - Rename `cider-eval-spinner-type`, `cider-show-eval-spinner`, and `cider-eval-spinner-delay` to `cider-spinner-type`, `cider-show-spinner`, and `cider-spinner-delay`. The old names are kept as obsolete aliases. - Replace `cider-jack-in-universal-options` with the more general `cider-jack-in-tools` registry; the old variable is removed. Anyone who customized it should migrate by calling `cider-register-jack-in-tool` instead. +- Performance and correctness pass on the nREPL message logger: + - `nrepl-log-message` no longer mutates the live response dict to attach its display timestamp. Response callbacks used to see a stray `"time-stamp"` key on freshly-arrived messages. + - `nrepl-log--pp-listlike` now walks the plist in a single pass instead of copy-sequencing it through a sort/filter/concat pipeline. Specials (`id`, `op`, `session`, `time-stamp`) still print first but in canonical order, and the remaining keys now print in insertion order rather than alphabetically. + - `pp` was swapped for `prin1` in the non-dict leaf paths of `nrepl-log-pp-object`. + - `nrepl-message-buffer-max-size` and `nrepl-message-buffer-reduce-denominator` are now `defcustom` to match their docstring intent. ## 1.21.0 (2026-02-07) diff --git a/lisp/nrepl-client.el b/lisp/nrepl-client.el index 308a957d5..0405d777c 100644 --- a/lisp/nrepl-client.el +++ b/lisp/nrepl-client.el @@ -1216,18 +1216,20 @@ keep it enabled unless you need to debug something." :type 'boolean :safe #'booleanp) -(defconst nrepl-message-buffer-max-size 1000000 +(defcustom nrepl-message-buffer-max-size 1000000 "Maximum size for the nREPL message buffer. Defaults to 1000000 characters, which should be an insignificant -memory burden, while providing reasonable history.") +memory burden, while providing reasonable history." + :type 'integer) -(defconst nrepl-message-buffer-reduce-denominator 4 +(defcustom nrepl-message-buffer-reduce-denominator 4 "Divisor by which to reduce message buffer size. When the maximum size for the nREPL message buffer is exceeded, the size of the buffer is reduced by one over this value. Defaults to 4, so that 1/4 of the buffer is removed, which should ensure the buffer's maximum is reasonably utilized, while limiting the number of buffer shrinking -operations.") +operations." + :type 'integer) (defvar nrepl-messages-mode-map (let ((map (make-sparse-keymap))) @@ -1263,11 +1265,14 @@ operations.") TYPE is either request or response. The message is logged to a buffer described by `nrepl-message-buffer-name-template'." (when nrepl-log-messages - ;; append a time-stamp to the message before logging it - ;; the time-stamps are quite useful for debugging + ;; Prepend a time-stamp pair to a fresh head, sharing the original + ;; cdr as the tail. Using `nrepl-plist-put' here would mutate the + ;; live message dict, so downstream response handlers would see an + ;; unexpected "time-stamp" key appearing on the response they got. (setq msg (cons (car msg) - (nrepl-plist-put (cdr msg) "time-stamp" - (format-time-string "%Y-%m-%0d %H:%M:%S.%N")))) + (cons "time-stamp" + (cons (format-time-string "%Y-%m-%0d %H:%M:%S.%N") + (cdr msg))))) (let ((log-buffer (nrepl-messages-buffer (current-buffer)))) (with-current-buffer log-buffer (setq buffer-read-only nil) @@ -1391,6 +1396,9 @@ If ID is nil, return nil." (mod (length nrepl-message-colors)) (nth nrepl-message-colors)))) +(defconst nrepl-log--special-keys '("id" "op" "session" "time-stamp") + "Keys that are displayed first, in this order, in `nrepl-log--pp-listlike'.") + (defun nrepl-log--pp-listlike (object &optional foreground button) "Pretty print nREPL list like OBJECT. FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." @@ -1402,28 +1410,32 @@ FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." (insert (color head)) (if (null (cdr object)) (insert ")\n") + ;; Walk the plist once: bucket pairs whose key is in + ;; `nrepl-log--special-keys' into a fixed-position vector so they + ;; emit in canonical order, collect the rest in insertion order, + ;; and track the widest key for column alignment. Replaces a + ;; pipeline that copy-sequence'd, partitioned, sorted, mapped, + ;; filtered, removed, and concatenated the plist for every message. (let* ((indent (+ 2 (- (current-column) (length head)))) - (sorted-pairs (sort (seq-partition (copy-sequence (cdr object)) 2) - (lambda (a b) - (string< (car a) (car b))))) - (name-lengths (seq-map (lambda (pair) (length (car pair))) sorted-pairs)) - (longest-name (seq-max name-lengths)) - ;; Special entries are displayed first - (specialq (lambda (pair) (member (car pair) '("id" "op" "session" "time-stamp")))) - (special-pairs (seq-filter specialq sorted-pairs)) - (not-special-pairs (seq-remove specialq sorted-pairs)) - (all-pairs (seq-concatenate 'list special-pairs not-special-pairs)) - (sorted-object (apply #'seq-concatenate 'list all-pairs))) + (specials (make-vector (length nrepl-log--special-keys) nil)) + (others nil) + (longest-name 0)) + (cl-loop for (k v) on (cdr object) by #'cddr + do (setq longest-name (max longest-name (length k))) + do (let ((idx (cl-position k nrepl-log--special-keys :test #'equal))) + (if idx + (aset specials idx (cons k v)) + (push (cons k v) others)))) (insert "\n") - (cl-loop for l on sorted-object by #'cddr - do (let ((indent-str (make-string indent ?\s)) - (name-str (propertize (car l) 'face - ;; Only highlight top-level keys. - (unless (eq (car object) 'dict) - 'font-lock-keyword-face))) - (spaces-str (make-string (- longest-name (length (car l))) ?\s))) - (insert (format "%s%s%s " indent-str name-str spaces-str)) - (nrepl-log-pp-object (cadr l) nil button))) + (let ((indent-str (make-string indent ?\s)) + ;; Only highlight top-level keys. + (face (unless (eq (car object) 'dict) 'font-lock-keyword-face))) + (dolist (pair (nconc (delq nil (append specials nil)) (nreverse others))) + (let* ((k (car pair)) + (v (cdr pair)) + (spaces-str (make-string (- longest-name (length k)) ?\s))) + (insert indent-str (propertize k 'face face) spaces-str " ") + (nrepl-log-pp-object v nil button)))) (when (eq (car object) 'dict) (delete-char -1)) (insert (color ")\n"))))))) @@ -1450,13 +1462,14 @@ it into the buffer." (t (if (and button (> (length object) min-list-fold-size)) (nrepl-log-insert-button (format "(%s ...)" (prin1-to-string head)) object) - (pp object (current-buffer))))) + (prin1 object (current-buffer)) + (insert "\n")))) ;; non-list objects (if (stringp object) (if (and button (> (length object) min-string-fold-size)) (nrepl-log-insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) (insert (prin1-to-string object) "\n")) - (pp object (current-buffer)) + (prin1 object (current-buffer)) (insert "\n"))))) (defun nrepl-messages-buffer (conn)