cider-repl-history.el

;;; cider-repl-history.el --- REPL input history browser  -*- lexical-binding: t; -*-

;; Copyright (c) 2017-2021 John Valente and browse-kill-ring authors

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;; This file is not part of GNU Emacs.

;; Based heavily on browse-kill-ring
;; https://github.com/browse-kill-ring/browse-kill-ring

;;; Commentary:

;; REPL input history browser for CIDER.

;; Allows you to browse the full input history for your REPL buffer, and
;; insert previous commands at the prompt.

;;; Code:

(require 'cl-lib)
(require 'cider-popup)
(require 'clojure-mode)
(require 'derived)
(require 'pulse)
(require 'sesman)

(defconst cider-repl-history-buffer "*cider-repl-history*")

(defgroup cider-repl-history nil
  "A package for browsing and inserting the items in the CIDER command history."
  :prefix "cider-repl-history-"
  :group 'cider)

(defvar cider-repl-history-display-styles
  '((separated . cider-repl-history-insert-as-separated)
    (one-line . cider-repl-history-insert-as-one-line)))

(defcustom cider-repl-history-display-style 'separated
  "How to display the CIDER command history items.

If `one-line', then replace newlines with \"\\n\" for display.

If `separated', then display `cider-repl-history-separator' between
entries."
  :type '(choice (const :tag "One line" one-line)
                 (const :tag "Separated" separated))
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-quit-action 'quit-window
  "What action to take when `cider-repl-history-quit' is called.

If `bury-buffer', then simply bury the *cider-repl-history* buffer, but keep
the window.

If `bury-and-delete-window', then bury the buffer, and (if there is
more than one window) delete the window.

If `delete-and-restore', then restore the window configuration to what it was
before `cider-repl-history' was called, and kill the *cider-repl-history*
buffer.

If `quit-window', then restore the window configuration to what
it was before `cider-repl-history' was called, and bury *cider-repl-history*.
This is the default.

If `kill-and-delete-window', then kill the *cider-repl-history* buffer, and
delete the window on close.

Otherwise, it should be a function to call."
  ;; Note, if you use one of the non-"delete" options, after you "quit",
  ;; the *cider-repl-history* buffer is still available.  If you are using
  ;; `cider-repl-history-show-preview', and you switch to *cider-repl-history* (i.e.,
  ;; with C-x b), it will not give the preview unless and until you "update"
  ;; the *cider-repl-history* buffer.
  ;;
  ;; This really should not be an issue, because there's no reason to "switch"
  ;; back to the buffer.  If you want to get it back, you can just do C-c M-p
  ;; from the REPL buffer.

  ;; If you get in this situation and find it annoying, you can either disable
  ;; the preview, or set `cider-repl-history-quit-action' to 'delete-and-restore.
  ;; Then you will simply not have the *cider-repl-history* buffer after you quit,
  ;; and it won't be an issue.

  :type '(choice (const :tag "Bury buffer"
                        :value bury-buffer)
                 (const :tag "Bury buffer and delete window"
                        :value bury-and-delete-window)
                 (const :tag "Delete window"
                        :value delete-and-restore)
                 (const :tag "Save and restore"
                        :value quit-window)
                 (const :tag "Kill buffer and delete window"
                        :value kill-and-delete-window)
                 function)
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-resize-window nil
  "Whether to resize the `cider-repl-history' window to fit its contents.
Value is either t, meaning yes, or a cons pair of integers,
 (MAXIMUM . MINIMUM) for the size of the window.  MAXIMUM defaults to
the window size chosen by `pop-to-buffer'; MINIMUM defaults to
`window-min-height'."
  :type '(choice (const :tag "No" nil)
                 (const :tag "Yes" t)
                 (cons (integer :tag "Maximum") (integer :tag "Minimum")))
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-separator ";;;;;;;;;;"
  "The string separating entries in the `separated' style.
See `cider-repl-history-display-style'."
  ;; The (default) separator is a Clojure comment, to preserve fontification
  ;; in the buffer.
  :type 'string
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-recenter nil
  "If non-nil, then always keep the current entry at the top of the window."
  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-highlight-current-entry nil
  "If non-nil, highlight the currently selected command history entry."
  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-highlight-inserted-item nil
  "If non-nil, then temporarily highlight the inserted command history entry.
The value selected controls how the inserted item is highlighted,
possible values are `solid' (highlight the inserted text for a
fixed period of time), or `pulse' (fade out the highlighting gradually).
Setting this variable to the value t will select the default
highlighting style, which currently `pulse'.

The variable `cider-repl-history-inserted-item-face' contains the
face used for highlighting."
  :type '(choice (const nil) (const t) (const solid) (const pulse))
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-separator-face 'bold
  "The face in which to highlight the `cider-repl-history-separator'."
  :type 'face
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-current-entry-face 'highlight
  "The face in which to highlight the command history current entry."
  :type 'face
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-inserted-item-face 'highlight
  "The face in which to highlight the inserted item."
  :type 'face
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-maximum-display-length nil
  "Whether or not to limit the length of displayed items.

If this variable is an integer, the display of the command history will be
limited to that many characters.
Setting this variable to nil means no limit."
  :type '(choice (const :tag "None" nil)
                 integer)
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-display-duplicates t
  "If non-nil, then display duplicate items in the command history."
  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-display-duplicate-highest t
  "When `cider-repl-history-display-duplicates' is nil, then display highest (most recent) duplicate items in the command history."
  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-text-properties nil
  "If non-nil, maintain text properties of the command history items."
  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-hook nil
  "A list of functions to call after `cider-repl-history'."
  :type 'hook
  :package-version '(cider . "0.15.0"))

(defcustom cider-repl-history-show-preview nil
  "If non-nil, show a preview of the inserted text in the REPL buffer.

The REPL buffer would show a preview of what the buffer would look like
if the item under point were inserted."

  :type 'boolean
  :package-version '(cider . "0.15.0"))

(defvar cider-repl-history-repl-window nil
  "The window in which chosen command history data will be inserted.
It is probably not a good idea to set this variable directly; simply
call `cider-repl-history' again.")

(defvar cider-repl-history-repl-buffer nil
  "The buffer in which chosen command history data will be inserted.
It is probably not a good idea to set this variable directly; simply
call `cider-repl-history' again.")

(defvar cider-repl-history-preview-overlay nil
  "Overlay used to preview what would happen if the user inserted the given text.")

(defvar cider-repl-history-previous-overlay nil
  "Previous overlay within *cider-repl-history* buffer.")


(defun cider-repl-history-get-history ()
  "Function to retrieve history from the REPL buffer."
  (if cider-repl-history-repl-buffer
      (buffer-local-value
       'cider-repl-input-history
       cider-repl-history-repl-buffer)
    (error "Variable `cider-repl-history-repl-buffer' not bound to a buffer")))

(defun cider-repl-history-resize-window ()
  "Resize the *cider-repl-history* window if needed.
Controlled by variable `cider-repl-history-resize-window'."
  (when cider-repl-history-resize-window
    (apply #'fit-window-to-buffer (selected-window)
           (if (consp cider-repl-history-resize-window)
               (list (car cider-repl-history-resize-window)
                     (or (cdr cider-repl-history-resize-window)
                         window-min-height))
             (list nil window-min-height)))))

(defun cider-repl-history-read-regexp (msg use-default-p)
  "Get a regular expression from the user.
Prompts with MSG; previous entry is default if USE-DEFAULT-P."
  (let* ((default (car regexp-history))
         (prompt (if (and default use-default-p)
                     (format "%s for regexp (default `%s'): "
                             msg
                             default)
                   (format "%s (regexp): " msg)))
         (input
          (read-from-minibuffer prompt nil nil nil 'regexp-history
                                (if use-default-p nil default))))
    (if (equal input "")
        (if use-default-p default nil)
      input)))

(defun cider-repl-history-clear-preview ()
  "Clear the preview, if one is present."
  (interactive)
  (when cider-repl-history-preview-overlay
    (cl-assert (overlayp cider-repl-history-preview-overlay))
    (delete-overlay cider-repl-history-preview-overlay)))

(defun cider-repl-history-cleanup-on-exit ()
  "Function called when the user is finished with `cider-repl-history'.
This function performs any cleanup that is required when the user
has finished interacting with the *cider-repl-history* buffer.  For now
the only cleanup performed is to remove the preview overlay, if
it's turned on."
  (cider-repl-history-clear-preview))

(defun cider-repl-history-quit ()
  "Take the action specified by `cider-repl-history-quit-action'."
  (interactive)
  (cider-repl-history-cleanup-on-exit)
  (pcase cider-repl-history-quit-action
    (`delete-and-restore
     (quit-restore-window (selected-window) 'kill))
    (`quit-window
     (quit-window))
    (`kill-and-delete-window
     (kill-buffer (current-buffer))
     (unless (= (count-windows) 1)
       (delete-window)))
    (`bury-and-delete-window
     (bury-buffer)
     (unless (= (count-windows) 1)
       (delete-window)))
    (_
     (funcall cider-repl-history-quit-action))))

(defun cider-repl-history-preview-overlay-setup (orig-buf)
  "Setup the preview overlay in ORIG-BUF."
  (when cider-repl-history-show-preview
    (with-current-buffer orig-buf
      (let* ((will-replace (region-active-p))
             (start (if will-replace
                        (min (point) (mark))
                      (point)))
             (end (if will-replace
                      (max (point) (mark))
                    (point))))
        (cider-repl-history-clear-preview)
        (setq cider-repl-history-preview-overlay
              (make-overlay start end orig-buf))
        (overlay-put cider-repl-history-preview-overlay
                     'invisible t)))))

(defun cider-repl-history-highlight-inserted (start end)
  "Insert the text between START and END."
  (pcase cider-repl-history-highlight-inserted-item
    ((or `pulse `t)
     (let ((pulse-delay .05) (pulse-iterations 10))
       (with-no-warnings
         (pulse-momentary-highlight-region
          start end cider-repl-history-inserted-item-face))))
    (`solid
     (let ((o (make-overlay start end)))
       (overlay-put o 'face cider-repl-history-inserted-item-face)
       (sit-for 0.5)
       (delete-overlay o)))))

(defun cider-repl-history-insert-and-highlight (str)
  "Helper function to insert STR at point, highlighting it if appropriate."
  (let ((before-insert (point)))
    (let (deactivate-mark)
      (insert-for-yank str))
    (cider-repl-history-highlight-inserted
     before-insert
     (point))))

(defun cider-repl-history-target-overlay-at (position &optional no-error)
  "Return overlay at POSITION that has property `cider-repl-history-target'.
If no such overlay, raise an error unless NO-ERROR is true, in which
case return nil."
  ;; FIXME: `position' is not used!
  (let ((ovs  (overlays-at (point))))
    (catch 'cider-repl-history-target-overlay-at
      (dolist (ov ovs)
        (when (overlay-get ov 'cider-repl-history-target)
          (throw 'cider-repl-history-target-overlay-at ov)))
      (unless no-error
        (error "No CIDER history item here")))))

(defun cider-repl-history-current-string (pt &optional no-error)
  "Find the string to insert into the REPL by looking for the overlay at PT
Might error unless NO-ERROR set."
  (let ((o (cider-repl-history-target-overlay-at pt t)))
    (if o
        (overlay-get o 'cider-repl-history-target)
      (unless no-error
        (error "No CIDER history item in this buffer")))))

(defun cider-repl-history-do-insert (buf pt)
  "Helper function to insert text from BUF at PT into the REPL buffer.
Also kills *cider-repl-history*."
  ;; Note: as mentioned at the top, this file is based on browse-kill-ring,
  ;; which has numerous insertion options.  The functionality of
  ;; browse-kill-ring allows users to insert at point, and move point to the end
  ;; of the inserted text; or insert at the beginning or end of the buffer,
  ;; while leaving point alone.  And each of these had the option of leaving the
  ;; history buffer in place, or getting rid of it.  That was appropriate for a
  ;; generic paste tool, but for inserting a previous command into an
  ;; interpreter, I felt the only useful option would be inserting it at the end
  ;; and quitting the history buffer, so that is all that's provided.
  ;; FIXME: `buf' is not used!
  (let ((str (cider-repl-history-current-string pt)))
    (cider-repl-history-quit)
    (with-selected-window cider-repl-history-repl-window
      (with-current-buffer cider-repl-history-repl-buffer
        (let ((max (point-max)))
          (if (= max (point))
              (cider-repl-history-insert-and-highlight str)
            (save-excursion
              (goto-char max)
              (cider-repl-history-insert-and-highlight str))))))))

(defun cider-repl-history-insert-and-quit ()
  "Insert the item into the REPL buffer, and close *cider-repl-history*.

The text is always inserted at the very bottom of the REPL buffer.  If your
cursor is already at the bottom, it is advanced to the end of the inserted
text.  If your cursor is somewhere else, the cursor is not moved, but the
text is still inserted at the end."
  (interactive)
  (cider-repl-history-do-insert (current-buffer) (point)))

(defun cider-repl-history-mouse-insert (e)
  "Insert the item at E into the REPL buffer, and close *cider-repl-history*.

The text is always inserted at the very bottom of the REPL buffer.  If your
cursor is already at the bottom, it is advanced to the end of the inserted
text.  If your cursor is somewhere else, the cursor is not moved, but the
text is still inserted at the end."
  (interactive "e")
  (let* ((data (save-excursion
                 (mouse-set-point e)
                 (cons (current-buffer) (point))))
         (buf (car data))
         (pt (cdr data)))
    (cider-repl-history-do-insert buf pt)))

(defun cider-repl-history-clear-highlighted-entry ()
  "Clear the highlighted entry, when one exists."
  (when cider-repl-history-previous-overlay
    (cl-assert (overlayp cider-repl-history-previous-overlay)
               nil "not an overlay")
    (overlay-put cider-repl-history-previous-overlay 'face nil)))

(defun cider-repl-history-update-highlighted-entry ()
  "Update highlighted entry, when feature is turned on."
  (when cider-repl-history-highlight-current-entry
    (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t)))
        (unless (equal cider-repl-history-previous-overlay current-overlay)
          ;; We've changed overlay.  Clear current highlighting,
          ;; and highlight the new overlay.
          (cl-assert (overlay-get current-overlay 'cider-repl-history-target) t)
          (cider-repl-history-clear-highlighted-entry)
          (setq cider-repl-history-previous-overlay current-overlay)
          (overlay-put current-overlay 'face
                       cider-repl-history-current-entry-face))
      ;; No overlay at point.  Just clear all current highlighting.
      (cider-repl-history-clear-highlighted-entry))))

(defun cider-repl-history-forward (&optional arg)
  "Move forward by ARG command history entries."
  (interactive "p")
  (beginning-of-line)
  (while (not (zerop arg))
    (let ((o (cider-repl-history-target-overlay-at (point) t)))
      (cond
       ((>= arg 0)
        (setq arg (1- arg))
        ;; We're on a cider-repl-history overlay, skip to the end of it.
        (when o
          (goto-char (overlay-end o))
          (setq o nil))
        (while (not (or o (eobp)))
          (goto-char (next-overlay-change (point)))
          (setq o (cider-repl-history-target-overlay-at (point) t))))
       (t
        (setq arg (1+ arg))
        (when o
          (goto-char (overlay-start o))
          (setq o nil))
        (while (not (or o (bobp)))
          (goto-char (previous-overlay-change (point)))
          (setq o (cider-repl-history-target-overlay-at (point) t)))))))
  (when cider-repl-history-recenter
    (recenter 1)))

(defun cider-repl-history-previous (&optional arg)
  "Move backward by ARG command history entries."
  (interactive "p")
  (cider-repl-history-forward (- arg)))

(defun cider-repl-history-search-forward (regexp &optional backwards)
  "Move to the next command history entry matching REGEXP from point.
If optional arg BACKWARDS is non-nil, move to the previous matching
entry."
  (interactive
   (list (cider-repl-history-read-regexp "Search forward" t)
         current-prefix-arg))
  (let ((orig (point)))
    (cider-repl-history-forward (if backwards -1 1))
    (let ((over (cider-repl-history-target-overlay-at (point) t)))
      (while (and over
                  (not (if backwards (bobp) (eobp)))
                  (not (string-match regexp
                                     (overlay-get over
                                                  'cider-repl-history-target))))
        (cider-repl-history-forward (if backwards -1 1))
        (setq over (cider-repl-history-target-overlay-at (point) t)))
      (unless (and over
                   (string-match regexp
                                 (overlay-get over
                                              'cider-repl-history-target)))
        (goto-char orig)
        (message "No more command history entries matching %s" regexp)))))

(defun cider-repl-history-search-backward (regexp)
  "Move to the previous command history entry matching REGEXP from point."
  (interactive
   (list (cider-repl-history-read-regexp "Search backward" t)))
  (cider-repl-history-search-forward regexp t))

(defun cider-repl-history-elide (str)
  ;; FIXME: Use `truncate-string-to-width'?
  "If STR is too long, abbreviate it with an ellipsis.
Otherwise, return it unchanged."
  (if (and cider-repl-history-maximum-display-length
           (> (length str)
              cider-repl-history-maximum-display-length))
      (concat (substring str 0 (- cider-repl-history-maximum-display-length 3))
              (propertize "..." 'cider-repl-history-extra t))
    str))

(defmacro cider-repl-history-add-overlays-for (item &rest body)
  "Add overlays for ITEM, and execute BODY."
  (let ((beg (cl-gensym "cider-repl-history-add-overlays-"))
        (end (cl-gensym "cider-repl-history-add-overlays-")))
    `(let ((,beg (point))
           (,end
            (progn
              ,@body
              (point))))
       (let ((o (make-overlay ,beg ,end)))
         (overlay-put o 'cider-repl-history-target ,item)
         (overlay-put o 'mouse-face 'highlight)))))

(defun cider-repl-history-insert-as-separated (items)
  "Insert ITEMS into the current buffer, with separators between items."
  (while items
    (let* ((origitem (car items))
           (item (cider-repl-history-elide origitem))
           ) ;; (len (length item))
      (cider-repl-history-add-overlays-for origitem (insert item))
      ;; When the command history has items with read-only text property at
      ;; **the end of** string, cider-repl-history-setup fails with error
      ;; `Text is read-only'.  So inhibit-read-only here.
      ;; See http://bugs.debian.org/225082
      (let ((inhibit-read-only t))
        (insert "\n")
        (when (cdr items)
          (insert (propertize cider-repl-history-separator
                              'cider-repl-history-extra t
                              'cider-repl-history-separator t))
          (insert "\n"))))
    (setq items (cdr items))))

(defun cider-repl-history-insert-as-one-line (items)
  "Insert ITEMS into the current buffer, formatting each item as a single line.

An explicit newline character will replace newlines so that the text retains its
spacing when it's actually inserted into the REPL buffer."
  (dolist (item items)
    (cider-repl-history-add-overlays-for
     item
     (let* ((item (cider-repl-history-elide item))
            (len (length item))
            (start 0)
            (newl (propertize "\\n" 'cider-repl-history-extra t)))
       (while (and (< start len)
                   (string-match "\n" item start))
         (insert (substring item start (match-beginning 0))
                 newl)
         (setq start (match-end 0)))
       (insert (substring item start len))))
    (insert "\n")))

(defun cider-repl-history-preview-update-text (preview-text)
  "Update `cider-repl-history-preview-overlay' to show `PREVIEW-TEXT`."
  ;; If preview-text is nil, replacement should be nil too.
  (cl-assert (overlayp cider-repl-history-preview-overlay))
  (let ((replacement (when preview-text
                       (propertize preview-text 'face 'highlight))))
    (overlay-put cider-repl-history-preview-overlay
                 'before-string replacement)))

(defun cider-repl-history-preview-update-by-position (&optional pt)
  "Update `cider-repl-history-preview-overlay' to match item at PT.

This function is called whenever the selection in the *cider-repl-history*
buffer is adjusted, the `cider-repl-history-preview-overlay'
is updated to preview the text of the selection at PT (or the
current point if not specified)."
  (let ((new-text (cider-repl-history-current-string
                   (or pt (point)) t)))
    (cider-repl-history-preview-update-text new-text)))

(defun cider-repl-history-undo-other-window ()
  "Undo the most recent change in the other window's buffer.
You most likely want to use this command for undoing an insertion of
text from the *cider-repl-history* buffer."
  (interactive)
  (with-current-buffer cider-repl-history-repl-buffer
    (undo)))

(defun cider-repl-history-setup (repl-win repl-buf history-buf &optional regexp)
  "Setup.
REPL-WIN and REPL-BUF are where to insert commands;
HISTORY-BUF is the history, and optional arg REGEXP is a filter."
  (cider-repl-history-preview-overlay-setup repl-buf)
  (with-current-buffer history-buf
    (unwind-protect
        (progn
          (cider-repl-history-mode)
          (setq buffer-read-only nil)
          (when (eq 'one-line cider-repl-history-display-style)
            (setq truncate-lines t))
          (let ((inhibit-read-only t))
            (erase-buffer))
          (setq cider-repl-history-repl-buffer repl-buf)
          (setq cider-repl-history-repl-window repl-win)
          (let* ((cider-repl-history-maximum-display-length
                  (if (and cider-repl-history-maximum-display-length
                           (<= cider-repl-history-maximum-display-length 3))
                      4
                    cider-repl-history-maximum-display-length))
                 (cider-command-history (cider-repl-history-get-history))
                 (items (mapcar
                         (if cider-repl-history-text-properties
                             #'copy-sequence
                           #'substring-no-properties)
                         cider-command-history)))
            (unless cider-repl-history-display-duplicates
              ;; display highest or lowest duplicate.
              ;; if `cider-repl-history-display-duplicate-highest' is t,
              ;; display highest (most recent) duplicate.
              (cl-delete-duplicates
               items
               :test #'equal
               :from-end cider-repl-history-display-duplicate-highest))
            (when (stringp regexp)
              (setq items (delq nil
                                (mapcar
                                 #'(lambda (item)
                                     (when (string-match regexp item)
                                       item))
                                 items))))
            (funcall (or (cdr (assq cider-repl-history-display-style
                                    cider-repl-history-display-styles))
                         (error "Invalid `cider-repl-history-display-style': %s"
                                cider-repl-history-display-style))
                     items)
            (when cider-repl-history-show-preview
              (cider-repl-history-preview-update-by-position (point-min))
              ;; Local post-command-hook, only happens in *cider-repl-history*
              (add-hook 'post-command-hook
                        #'cider-repl-history-preview-update-by-position
                        nil t)
              (add-hook 'kill-buffer-hook
                        #'cider-repl-history-cleanup-on-exit
                        nil t))
            (when cider-repl-history-highlight-current-entry
              (add-hook 'post-command-hook
                        #'cider-repl-history-update-highlighted-entry
                        nil t))
            (message
             (let ((entry (if (= 1 (length cider-command-history))
                              "entry"
                            "entries")))
               (concat
                (if (and (not regexp)
                         cider-repl-history-display-duplicates)
                    (format "%s %s in the command history."
                            (length cider-command-history) entry)
                  (format "%s (of %s) %s in the command history shown."
                          (length items) (length cider-command-history) entry))
                (substitute-command-keys
                 (concat "  Type \\[cider-repl-history-quit] to quit.  "
                         "\\[describe-mode] for help.")))))
            (set-buffer-modified-p nil)
            (goto-char (point-min))
            (cider-repl-history-forward 0)
            (setq mode-name (if regexp
                                (concat "History [" regexp "]")
                              "History"))
            (run-hooks 'cider-repl-history-hook)))
      (setq buffer-read-only t))))

(defun cider-repl-history-update ()
  "Update the history buffer to reflect the latest state of the command history."
  (interactive)
  (cl-assert (eq major-mode 'cider-repl-history-mode))
  (cider-repl-history-setup cider-repl-history-repl-window
                            cider-repl-history-repl-buffer
                            (current-buffer))
  (cider-repl-history-resize-window))

(defun cider-repl-history-occur (regexp)
  "Display all command history entries matching REGEXP."
  (interactive
   (list (cider-repl-history-read-regexp
          "Display command history entries matching" nil)))
  (cl-assert (eq major-mode 'cider-repl-history-mode))
  (cider-repl-history-setup cider-repl-history-repl-window
                            cider-repl-history-repl-buffer
                            (current-buffer)
                            regexp)
  (cider-repl-history-resize-window))

(defvar cider-repl-history-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "n")   #'cider-repl-history-forward)
    (define-key map (kbd "p")   #'cider-repl-history-previous)
    (define-key map (kbd "SPC") #'cider-repl-history-insert-and-quit)
    (define-key map (kbd "RET") #'cider-repl-history-insert-and-quit)
    (define-key map [(mouse-2)] #'cider-repl-history-mouse-insert)
    (define-key map (kbd "l")   #'cider-repl-history-occur)
    (define-key map (kbd "s")   #'cider-repl-history-search-forward)
    (define-key map (kbd "r")   #'cider-repl-history-search-backward)
    (define-key map (kbd "g")   #'cider-repl-history-update)
    (define-key map (kbd "q")   #'cider-repl-history-quit)
    (define-key map (kbd "U")   #'cider-repl-history-undo-other-window)
    (define-key map (kbd "?")   #'describe-mode)
    (define-key map (kbd "h")   #'describe-mode)
    map))

(put 'cider-repl-history-mode 'mode-class 'special)
(define-derived-mode cider-repl-history-mode clojure-mode "History"
  "Major mode for browsing the entries in the command input history."
  (setq-local sesman-system 'CIDER))

;;;###autoload
(defun cider-repl-history ()
  "Display items in the CIDER command history in another buffer."
  (interactive)
  (when (eq major-mode 'cider-repl-history-mode)
    (user-error "Already viewing the CIDER command history"))

  (let* ((repl-win (selected-window))
         (repl-buf (window-buffer repl-win))
         (buf (get-buffer-create cider-repl-history-buffer)))
    (cider-repl-history-setup repl-win repl-buf buf)
    (pop-to-buffer buf)
    (cider-repl-history-resize-window)))

(provide 'cider-repl-history)

;;; cider-repl-history.el ends here