bench.el

(defun orig/cider-repl--emit-output-at-pos (buffer string output-face position &optional bol)
  "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION.
If BOL is non-nil insert at the beginning of line."
  (with-current-buffer buffer
    (save-excursion
      (cider-save-marker cider-repl-output-start
        (cider-save-marker cider-repl-output-end
          (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))))))))
    (cider-repl--show-maximum-output)))

(defun orig/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)))
      (orig/cider-repl--emit-output-at-pos (current-buffer) string face pos t)
      (ansi-color-apply-on-region pos (point-max))

      ;; If the output has a trailing overlay created by ansi-color, it would be
      ;; extended by the following outputs. To avoid this, ansi-color adds
      ;; `ansi-color-freeze-overlay' to the `modification-hooks', but it never
      ;; seems to be called. By using `insert-behind-hooks' instead, we can make
      ;; it work. For more details, please see
      ;; https://github.com/clojure-emacs/cider/issues/1452
      (dolist (ov (overlays-at (1- (cider-repl--end-of-line-before-input-start))))
        ;; Ensure ov is created by ansi-color
        (when (and (member #'ansi-color-freeze-overlay (overlay-get ov 'modification-hooks))
                   (not (member #'ansi-color-freeze-overlay (overlay-get ov 'insert-behind-hooks))))
          (push #'ansi-color-freeze-overlay (overlay-get ov 'insert-behind-hooks)))))))

(defun orig2/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)))
      (orig/cider-repl--emit-output-at-pos (current-buffer) string face pos t)
      (ansi-color-apply-on-region pos (point-max)))))

(defun prop/cider-repl--emit-output-at-pos (buffer string output-face position &optional bol)
  "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION.
If BOL is non-nil insert at the beginning of line."
  (with-current-buffer buffer
    (save-excursion
      (cider-save-marker cider-repl-output-start
        (cider-save-marker cider-repl-output-end
          (goto-char position)
          ;; TODO: Review the need for bol
          (when (and bol (not (bolp))) (insert-before-markers "\n"))
          (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 prop/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)))
      (prop/cider-repl--emit-output-at-pos (current-buffer) string face pos t))))

(defun my/cider-bench (out txt f n)
  (cider-find-and-clear-repl-output t)
  (write-region "" nil out)
  (garbage-collect)
  (dotimes (i n)
    (write-region (number-to-string (benchmark-elapse
                                      (funcall f txt 'cider-repl-stdout-face)))
                  nil out 'append)
    (write-region "\n" nil out 'append)))

;; (benchmark-elapse (dotimes (i 1000) (orig/cider-repl--emit-interactive-output "foobar" 'cider-repl-stdout-face)))
;; (benchmark-elapse (dotimes (i 1000) (prop/cider-repl--emit-interactive-output "foobar" 'cider-repl-stdout-face)))

(let ((iter 1000)
      (text "foobar")
      (trailing-color-text "foobar"))

  (when-let ((win (get-buffer-window (cider-current-repl-buffer))))
    (delete-window win))

  (my/cider-bench "ov" text #'orig/cider-repl--emit-interactive-output iter)
  (my/cider-bench "trailing_ov" trailing-color-text #'orig/cider-repl--emit-interactive-output iter)

  (my/cider-bench "ov_old" text #'orig2/cider-repl--emit-interactive-output iter)
  (my/cider-bench "trailing_ov_old" trailing-color-text #'orig2/cider-repl--emit-interactive-output iter)

  (my/cider-bench "prop" text #'prop/cider-repl--emit-interactive-output iter)
  (my/cider-bench "trailing_prop" trailing-color-text #'prop/cider-repl--emit-interactive-output iter)

  (save-selected-window
    (unless (get-buffer-window (cider-current-repl-buffer))
      (pop-to-buffer (cider-current-repl-buffer))))

  (my/cider-bench "active_ov" text #'orig/cider-repl--emit-interactive-output iter)
  (my/cider-bench "active_trailing_ov" trailing-color-text #'orig/cider-repl--emit-interactive-output iter)

  (my/cider-bench "active_ov_old" text #'orig2/cider-repl--emit-interactive-output iter)
  (my/cider-bench "active_trailing_ov_old" trailing-color-text #'orig2/cider-repl--emit-interactive-output iter)

  (my/cider-bench "active_prop" text #'prop/cider-repl--emit-interactive-output iter)
  (my/cider-bench "active_trailing_prop" trailing-color-text #'prop/cider-repl--emit-interactive-output iter)

  (message "Done"))