cider-repl-history.el (30557B)
1 ;;; cider-repl-history.el --- REPL input history browser -*- lexical-binding: t; -*- 2 3 ;; Copyright (c) 2017-2023 John Valente and browse-kill-ring authors 4 5 ;; This program is free software: you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 17 18 ;; This file is not part of GNU Emacs. 19 20 ;; Based heavily on browse-kill-ring 21 ;; https://github.com/browse-kill-ring/browse-kill-ring 22 23 ;;; Commentary: 24 25 ;; REPL input history browser for CIDER. 26 27 ;; Allows you to browse the full input history for your REPL buffer, and 28 ;; insert previous commands at the prompt. 29 30 ;;; Code: 31 32 (require 'cl-lib) 33 (require 'cider-popup) 34 (require 'clojure-mode) 35 (require 'derived) 36 (require 'pulse) 37 (require 'sesman) 38 39 (defconst cider-repl-history-buffer "*cider-repl-history*") 40 41 (defgroup cider-repl-history nil 42 "A package for browsing and inserting the items in the CIDER command history." 43 :prefix "cider-repl-history-" 44 :group 'cider) 45 46 (defvar cider-repl-history-display-styles 47 '((separated . cider-repl-history-insert-as-separated) 48 (one-line . cider-repl-history-insert-as-one-line))) 49 50 (defcustom cider-repl-history-display-style 'separated 51 "How to display the CIDER command history items. 52 53 If `one-line', then replace newlines with \"\\n\" for display. 54 55 If `separated', then display `cider-repl-history-separator' between 56 entries." 57 :type '(choice (const :tag "One line" one-line) 58 (const :tag "Separated" separated)) 59 :package-version '(cider . "0.15.0")) 60 61 (defcustom cider-repl-history-quit-action 'quit-window 62 "What action to take when `cider-repl-history-quit' is called. 63 64 If `bury-buffer', then simply bury the *cider-repl-history* buffer, but keep 65 the window. 66 67 If `bury-and-delete-window', then bury the buffer, and (if there is 68 more than one window) delete the window. 69 70 If `delete-and-restore', then restore the window configuration to what it was 71 before `cider-repl-history' was called, and kill the *cider-repl-history* 72 buffer. 73 74 If `quit-window', then restore the window configuration to what 75 it was before `cider-repl-history' was called, and bury *cider-repl-history*. 76 This is the default. 77 78 If `kill-and-delete-window', then kill the *cider-repl-history* buffer, and 79 delete the window on close. 80 81 Otherwise, it should be a function to call." 82 ;; Note, if you use one of the non-"delete" options, after you "quit", 83 ;; the *cider-repl-history* buffer is still available. If you are using 84 ;; `cider-repl-history-show-preview', and you switch to *cider-repl-history* (i.e., 85 ;; with C-x b), it will not give the preview unless and until you "update" 86 ;; the *cider-repl-history* buffer. 87 ;; 88 ;; This really should not be an issue, because there's no reason to "switch" 89 ;; back to the buffer. If you want to get it back, you can just do C-c M-p 90 ;; from the REPL buffer. 91 92 ;; If you get in this situation and find it annoying, you can either disable 93 ;; the preview, or set `cider-repl-history-quit-action' to 'delete-and-restore. 94 ;; Then you will simply not have the *cider-repl-history* buffer after you quit, 95 ;; and it won't be an issue. 96 97 :type '(choice (const :tag "Bury buffer" 98 :value bury-buffer) 99 (const :tag "Bury buffer and delete window" 100 :value bury-and-delete-window) 101 (const :tag "Delete window" 102 :value delete-and-restore) 103 (const :tag "Save and restore" 104 :value quit-window) 105 (const :tag "Kill buffer and delete window" 106 :value kill-and-delete-window) 107 function) 108 :package-version '(cider . "0.15.0")) 109 110 (defcustom cider-repl-history-resize-window nil 111 "Whether to resize the `cider-repl-history' window to fit its contents. 112 Value is either t, meaning yes, or a cons pair of integers, 113 (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to 114 the window size chosen by `pop-to-buffer'; MINIMUM defaults to 115 `window-min-height'." 116 :type '(choice (const :tag "No" nil) 117 (const :tag "Yes" t) 118 (cons (integer :tag "Maximum") (integer :tag "Minimum"))) 119 :package-version '(cider . "0.15.0")) 120 121 (defcustom cider-repl-history-separator ";;;;;;;;;;" 122 "The string separating entries in the `separated' style. 123 See `cider-repl-history-display-style'." 124 ;; The (default) separator is a Clojure comment, to preserve fontification 125 ;; in the buffer. 126 :type 'string 127 :package-version '(cider . "0.15.0")) 128 129 (defcustom cider-repl-history-recenter nil 130 "If non-nil, then always keep the current entry at the top of the window." 131 :type 'boolean 132 :package-version '(cider . "0.15.0")) 133 134 (defcustom cider-repl-history-highlight-current-entry nil 135 "If non-nil, highlight the currently selected command history entry." 136 :type 'boolean 137 :package-version '(cider . "0.15.0")) 138 139 (defcustom cider-repl-history-highlight-inserted-item nil 140 "If non-nil, then temporarily highlight the inserted command history entry. 141 The value selected controls how the inserted item is highlighted, 142 possible values are `solid' (highlight the inserted text for a 143 fixed period of time), or `pulse' (fade out the highlighting gradually). 144 Setting this variable to the value t will select the default 145 highlighting style, which currently `pulse'. 146 147 The variable `cider-repl-history-inserted-item-face' contains the 148 face used for highlighting." 149 :type '(choice (const nil) (const t) (const solid) (const pulse)) 150 :package-version '(cider . "0.15.0")) 151 152 (defcustom cider-repl-history-separator-face 'bold 153 "The face in which to highlight the `cider-repl-history-separator'." 154 :type 'face 155 :package-version '(cider . "0.15.0")) 156 157 (defcustom cider-repl-history-current-entry-face 'highlight 158 "The face in which to highlight the command history current entry." 159 :type 'face 160 :package-version '(cider . "0.15.0")) 161 162 (defcustom cider-repl-history-inserted-item-face 'highlight 163 "The face in which to highlight the inserted item." 164 :type 'face 165 :package-version '(cider . "0.15.0")) 166 167 (defcustom cider-repl-history-maximum-display-length nil 168 "Whether or not to limit the length of displayed items. 169 170 If this variable is an integer, the display of the command history will be 171 limited to that many characters. 172 Setting this variable to nil means no limit." 173 :type '(choice (const :tag "None" nil) 174 integer) 175 :package-version '(cider . "0.15.0")) 176 177 (defcustom cider-repl-history-display-duplicates t 178 "If non-nil, then display duplicate items in the command history." 179 :type 'boolean 180 :package-version '(cider . "0.15.0")) 181 182 (defcustom cider-repl-history-display-duplicate-highest t 183 "If non-nil, then display most recent duplicate items in the command history. 184 Only takes effect when `cider-repl-history-display-duplicates' is nil." 185 :type 'boolean 186 :package-version '(cider . "0.15.0")) 187 188 (defcustom cider-repl-history-text-properties nil 189 "If non-nil, maintain text properties of the command history items." 190 :type 'boolean 191 :package-version '(cider . "0.15.0")) 192 193 (defcustom cider-repl-history-hook nil 194 "A list of functions to call after `cider-repl-history'." 195 :type 'hook 196 :package-version '(cider . "0.15.0")) 197 198 (defcustom cider-repl-history-show-preview nil 199 "If non-nil, show a preview of the inserted text in the REPL buffer. 200 201 The REPL buffer would show a preview of what the buffer would look like 202 if the item under point were inserted." 203 204 :type 'boolean 205 :package-version '(cider . "0.15.0")) 206 207 (defvar cider-repl-history-repl-window nil 208 "The window in which chosen command history data will be inserted. 209 It is probably not a good idea to set this variable directly; simply 210 call `cider-repl-history' again.") 211 212 (defvar cider-repl-history-repl-buffer nil 213 "The buffer in which chosen command history data will be inserted. 214 It is probably not a good idea to set this variable directly; simply 215 call `cider-repl-history' again.") 216 217 (defvar cider-repl-history-preview-overlay nil 218 "Overlay used to preview what would happen if the user inserted the given text.") 219 220 (defvar cider-repl-history-previous-overlay nil 221 "Previous overlay within *cider-repl-history* buffer.") 222 223 224 (defun cider-repl-history-get-history () 225 "Function to retrieve history from the REPL buffer." 226 (if cider-repl-history-repl-buffer 227 (buffer-local-value 228 'cider-repl-input-history 229 cider-repl-history-repl-buffer) 230 (error "Variable `cider-repl-history-repl-buffer' not bound to a buffer"))) 231 232 (defun cider-repl-history-resize-window () 233 "Resize the *cider-repl-history* window if needed. 234 Controlled by variable `cider-repl-history-resize-window'." 235 (when cider-repl-history-resize-window 236 (apply #'fit-window-to-buffer (selected-window) 237 (if (consp cider-repl-history-resize-window) 238 (list (car cider-repl-history-resize-window) 239 (or (cdr cider-repl-history-resize-window) 240 window-min-height)) 241 (list nil window-min-height))))) 242 243 (defun cider-repl-history-read-regexp (msg use-default-p) 244 "Get a regular expression from the user. 245 Prompts with MSG; previous entry is default if USE-DEFAULT-P." 246 (let* ((default (car regexp-history)) 247 (prompt (if (and default use-default-p) 248 (format "%s for regexp (default `%s'): " 249 msg 250 default) 251 (format "%s (regexp): " msg))) 252 (input 253 (read-from-minibuffer prompt nil nil nil 'regexp-history 254 (if use-default-p nil default)))) 255 (if (equal input "") 256 (if use-default-p default nil) 257 input))) 258 259 (defun cider-repl-history-clear-preview () 260 "Clear the preview, if one is present." 261 (interactive) 262 (when cider-repl-history-preview-overlay 263 (cl-assert (overlayp cider-repl-history-preview-overlay)) 264 (delete-overlay cider-repl-history-preview-overlay))) 265 266 (defun cider-repl-history-cleanup-on-exit () 267 "Function called when the user is finished with `cider-repl-history'. 268 This function performs any cleanup that is required when the user 269 has finished interacting with the *cider-repl-history* buffer. For now 270 the only cleanup performed is to remove the preview overlay, if 271 it's turned on." 272 (cider-repl-history-clear-preview)) 273 274 (defun cider-repl-history-quit () 275 "Take the action specified by `cider-repl-history-quit-action'." 276 (interactive) 277 (cider-repl-history-cleanup-on-exit) 278 (pcase cider-repl-history-quit-action 279 (`delete-and-restore 280 (quit-restore-window (selected-window) 'kill)) 281 (`quit-window 282 (quit-window)) 283 (`kill-and-delete-window 284 (kill-buffer (current-buffer)) 285 (unless (= (count-windows) 1) 286 (delete-window))) 287 (`bury-and-delete-window 288 (bury-buffer) 289 (unless (= (count-windows) 1) 290 (delete-window))) 291 (_ 292 (funcall cider-repl-history-quit-action)))) 293 294 (defun cider-repl-history-preview-overlay-setup (orig-buf) 295 "Setup the preview overlay in ORIG-BUF." 296 (when cider-repl-history-show-preview 297 (with-current-buffer orig-buf 298 (let* ((will-replace (region-active-p)) 299 (start (if will-replace 300 (min (point) (mark)) 301 (point))) 302 (end (if will-replace 303 (max (point) (mark)) 304 (point)))) 305 (cider-repl-history-clear-preview) 306 (setq cider-repl-history-preview-overlay 307 (make-overlay start end orig-buf)) 308 (overlay-put cider-repl-history-preview-overlay 309 'invisible t))))) 310 311 (defun cider-repl-history-highlight-inserted (start end) 312 "Insert the text between START and END." 313 (pcase cider-repl-history-highlight-inserted-item 314 ((or `pulse `t) 315 (let ((pulse-delay .05) (pulse-iterations 10)) 316 (with-no-warnings 317 (pulse-momentary-highlight-region 318 start end cider-repl-history-inserted-item-face)))) 319 (`solid 320 (let ((o (make-overlay start end))) 321 (overlay-put o 'face cider-repl-history-inserted-item-face) 322 (sit-for 0.5) 323 (delete-overlay o))))) 324 325 (defun cider-repl-history-insert-and-highlight (str) 326 "Helper function to insert STR at point, highlighting it if appropriate." 327 (let ((before-insert (point))) 328 (let (deactivate-mark) 329 (insert-for-yank str)) 330 (cider-repl-history-highlight-inserted 331 before-insert 332 (point)))) 333 334 (defun cider-repl-history-target-overlay-at (_position &optional no-error) 335 "Return overlay at POSITION that has property `cider-repl-history-target'. 336 If no such overlay, raise an error unless NO-ERROR is true, in which 337 case return nil." 338 (let ((ovs (overlays-at (point)))) 339 (catch 'cider-repl-history-target-overlay-at 340 (dolist (ov ovs) 341 (when (overlay-get ov 'cider-repl-history-target) 342 (throw 'cider-repl-history-target-overlay-at ov))) 343 (unless no-error 344 (error "No CIDER history item here"))))) 345 346 (defun cider-repl-history-current-string (pt &optional no-error) 347 "Find the string to insert into the REPL by looking for the overlay at PT. 348 Might error unless NO-ERROR set." 349 (let ((o (cider-repl-history-target-overlay-at pt t))) 350 (if o 351 (overlay-get o 'cider-repl-history-target) 352 (unless no-error 353 (error "No CIDER history item in this buffer"))))) 354 355 (defun cider-repl-history-do-insert (_buf pt) 356 "Helper function to insert text from BUF at PT into the REPL buffer. 357 Also kills *cider-repl-history*." 358 ;; Note: as mentioned at the top, this file is based on browse-kill-ring, 359 ;; which has numerous insertion options. The functionality of 360 ;; browse-kill-ring allows users to insert at point, and move point to the end 361 ;; of the inserted text; or insert at the beginning or end of the buffer, 362 ;; while leaving point alone. And each of these had the option of leaving the 363 ;; history buffer in place, or getting rid of it. That was appropriate for a 364 ;; generic paste tool, but for inserting a previous command into an 365 ;; interpreter, I felt the only useful option would be inserting it at the end 366 ;; and quitting the history buffer, so that is all that's provided. 367 (let ((str (cider-repl-history-current-string pt))) 368 (cider-repl-history-quit) 369 (with-selected-window cider-repl-history-repl-window 370 (with-current-buffer cider-repl-history-repl-buffer 371 (let ((max (point-max))) 372 (if (= max (point)) 373 (cider-repl-history-insert-and-highlight str) 374 (save-excursion 375 (goto-char max) 376 (cider-repl-history-insert-and-highlight str)))))))) 377 378 (defun cider-repl-history-insert-and-quit () 379 "Insert the item into the REPL buffer, and close *cider-repl-history*. 380 381 The text is always inserted at the very bottom of the REPL buffer. If your 382 cursor is already at the bottom, it is advanced to the end of the inserted 383 text. If your cursor is somewhere else, the cursor is not moved, but the 384 text is still inserted at the end." 385 (interactive) 386 (cider-repl-history-do-insert (current-buffer) (point))) 387 388 (defun cider-repl-history-mouse-insert (e) 389 "Insert the item at E into the REPL buffer, and close *cider-repl-history*. 390 391 The text is always inserted at the very bottom of the REPL buffer. If your 392 cursor is already at the bottom, it is advanced to the end of the inserted 393 text. If your cursor is somewhere else, the cursor is not moved, but the 394 text is still inserted at the end." 395 (interactive "e") 396 (let* ((data (save-excursion 397 (mouse-set-point e) 398 (cons (current-buffer) (point)))) 399 (buf (car data)) 400 (pt (cdr data))) 401 (cider-repl-history-do-insert buf pt))) 402 403 (defun cider-repl-history-clear-highlighted-entry () 404 "Clear the highlighted entry, when one exists." 405 (when cider-repl-history-previous-overlay 406 (cl-assert (overlayp cider-repl-history-previous-overlay) 407 nil "not an overlay") 408 (overlay-put cider-repl-history-previous-overlay 'face nil))) 409 410 (defun cider-repl-history-update-highlighted-entry () 411 "Update highlighted entry, when feature is turned on." 412 (when cider-repl-history-highlight-current-entry 413 (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t))) 414 (unless (equal cider-repl-history-previous-overlay current-overlay) 415 ;; We've changed overlay. Clear current highlighting, 416 ;; and highlight the new overlay. 417 (cl-assert (overlay-get current-overlay 'cider-repl-history-target) t) 418 (cider-repl-history-clear-highlighted-entry) 419 (setq cider-repl-history-previous-overlay current-overlay) 420 (overlay-put current-overlay 'face 421 cider-repl-history-current-entry-face)) 422 ;; No overlay at point. Just clear all current highlighting. 423 (cider-repl-history-clear-highlighted-entry)))) 424 425 (defun cider-repl-history-forward (&optional arg) 426 "Move forward by ARG command history entries." 427 (interactive "p") 428 (beginning-of-line) 429 (while (not (zerop arg)) 430 (let ((o (cider-repl-history-target-overlay-at (point) t))) 431 (cond 432 ((>= arg 0) 433 (setq arg (1- arg)) 434 ;; We're on a cider-repl-history overlay, skip to the end of it. 435 (when o 436 (goto-char (overlay-end o)) 437 (setq o nil)) 438 (while (not (or o (eobp))) 439 (goto-char (next-overlay-change (point))) 440 (setq o (cider-repl-history-target-overlay-at (point) t)))) 441 (t 442 (setq arg (1+ arg)) 443 (when o 444 (goto-char (overlay-start o)) 445 (setq o nil)) 446 (while (not (or o (bobp))) 447 (goto-char (previous-overlay-change (point))) 448 (setq o (cider-repl-history-target-overlay-at (point) t))))))) 449 (when cider-repl-history-recenter 450 (recenter 1))) 451 452 (defun cider-repl-history-previous (&optional arg) 453 "Move backward by ARG command history entries." 454 (interactive "p") 455 (cider-repl-history-forward (- arg))) 456 457 (defun cider-repl-history-search-forward (regexp &optional backwards) 458 "Move to the next command history entry matching REGEXP from point. 459 If optional arg BACKWARDS is non-nil, move to the previous matching 460 entry." 461 (interactive 462 (list (cider-repl-history-read-regexp "Search forward" t) 463 current-prefix-arg)) 464 (let ((orig (point))) 465 (cider-repl-history-forward (if backwards -1 1)) 466 (let ((over (cider-repl-history-target-overlay-at (point) t))) 467 (while (and over 468 (not (if backwards (bobp) (eobp))) 469 (not (string-match regexp 470 (overlay-get over 471 'cider-repl-history-target)))) 472 (cider-repl-history-forward (if backwards -1 1)) 473 (setq over (cider-repl-history-target-overlay-at (point) t))) 474 (unless (and over 475 (string-match regexp 476 (overlay-get over 477 'cider-repl-history-target))) 478 (goto-char orig) 479 (message "No more command history entries matching %s" regexp))))) 480 481 (defun cider-repl-history-search-backward (regexp) 482 "Move to the previous command history entry matching REGEXP from point." 483 (interactive 484 (list (cider-repl-history-read-regexp "Search backward" t))) 485 (cider-repl-history-search-forward regexp t)) 486 487 (defun cider-repl-history-elide (str) 488 ;; FIXME: Use `truncate-string-to-width'? 489 "If STR is too long, abbreviate it with an ellipsis. 490 Otherwise, return it unchanged." 491 (if (and cider-repl-history-maximum-display-length 492 (> (length str) 493 cider-repl-history-maximum-display-length)) 494 (concat (substring str 0 (- cider-repl-history-maximum-display-length 3)) 495 (propertize "..." 'cider-repl-history-extra t)) 496 str)) 497 498 (defmacro cider-repl-history-add-overlays-for (item &rest body) 499 "Add overlays for ITEM, and execute BODY." 500 (let ((beg (cl-gensym "cider-repl-history-add-overlays-")) 501 (end (cl-gensym "cider-repl-history-add-overlays-"))) 502 `(let ((,beg (point)) 503 (,end 504 (progn 505 ,@body 506 (point)))) 507 (let ((o (make-overlay ,beg ,end))) 508 (overlay-put o 'cider-repl-history-target ,item) 509 (overlay-put o 'mouse-face 'highlight))))) 510 511 (defun cider-repl-history-insert-as-separated (items) 512 "Insert ITEMS into the current buffer, with separators between items." 513 (while items 514 (let* ((origitem (car items)) 515 (item (cider-repl-history-elide origitem)) 516 ) ;; (len (length item)) 517 (cider-repl-history-add-overlays-for origitem (insert item)) 518 ;; When the command history has items with read-only text property at 519 ;; **the end of** string, cider-repl-history-setup fails with error 520 ;; `Text is read-only'. So inhibit-read-only here. 521 ;; See http://bugs.debian.org/225082 522 (let ((inhibit-read-only t)) 523 (insert "\n") 524 (when (cdr items) 525 (insert (propertize cider-repl-history-separator 526 'cider-repl-history-extra t 527 'cider-repl-history-separator t)) 528 (insert "\n")))) 529 (setq items (cdr items)))) 530 531 (defun cider-repl-history-insert-as-one-line (items) 532 "Insert ITEMS into the current buffer, formatting each item as a single line. 533 534 An explicit newline character will replace newlines so that the text retains its 535 spacing when it's actually inserted into the REPL buffer." 536 (dolist (item items) 537 (cider-repl-history-add-overlays-for 538 item 539 (let* ((item (cider-repl-history-elide item)) 540 (len (length item)) 541 (start 0) 542 (newl (propertize "\\n" 'cider-repl-history-extra t))) 543 (while (and (< start len) 544 (string-match "\n" item start)) 545 (insert (substring item start (match-beginning 0)) 546 newl) 547 (setq start (match-end 0))) 548 (insert (substring item start len)))) 549 (insert "\n"))) 550 551 (defun cider-repl-history-preview-update-text (preview-text) 552 "Update `cider-repl-history-preview-overlay' to show `PREVIEW-TEXT`." 553 ;; If preview-text is nil, replacement should be nil too. 554 (cl-assert (overlayp cider-repl-history-preview-overlay)) 555 (let ((replacement (when preview-text 556 (propertize preview-text 'face 'highlight)))) 557 (overlay-put cider-repl-history-preview-overlay 558 'before-string replacement))) 559 560 (defun cider-repl-history-preview-update-by-position (&optional pt) 561 "Update `cider-repl-history-preview-overlay' to match item at PT. 562 563 This function is called whenever the selection in the *cider-repl-history* 564 buffer is adjusted, the `cider-repl-history-preview-overlay' 565 is updated to preview the text of the selection at PT (or the 566 current point if not specified)." 567 (let ((new-text (cider-repl-history-current-string 568 (or pt (point)) t))) 569 (cider-repl-history-preview-update-text new-text))) 570 571 (defun cider-repl-history-undo-other-window () 572 "Undo the most recent change in the other window's buffer. 573 You most likely want to use this command for undoing an insertion of 574 text from the *cider-repl-history* buffer." 575 (interactive) 576 (with-current-buffer cider-repl-history-repl-buffer 577 (undo))) 578 579 (defun cider-repl-history-setup (repl-win repl-buf history-buf &optional regexp) 580 "Setup. 581 REPL-WIN and REPL-BUF are where to insert commands; 582 HISTORY-BUF is the history, and optional arg REGEXP is a filter." 583 (cider-repl-history-preview-overlay-setup repl-buf) 584 (with-current-buffer history-buf 585 (unwind-protect 586 (progn 587 (cider-repl-history-mode) 588 (setq buffer-read-only nil) 589 (when (eq 'one-line cider-repl-history-display-style) 590 (setq truncate-lines t)) 591 (let ((inhibit-read-only t)) 592 (erase-buffer)) 593 (setq cider-repl-history-repl-buffer repl-buf) 594 (setq cider-repl-history-repl-window repl-win) 595 (let* ((cider-repl-history-maximum-display-length 596 (if (and cider-repl-history-maximum-display-length 597 (<= cider-repl-history-maximum-display-length 3)) 598 4 599 cider-repl-history-maximum-display-length)) 600 (cider-command-history (cider-repl-history-get-history)) 601 (items (mapcar 602 (if cider-repl-history-text-properties 603 #'copy-sequence 604 #'substring-no-properties) 605 cider-command-history))) 606 (unless cider-repl-history-display-duplicates 607 ;; display highest or lowest duplicate. 608 ;; if `cider-repl-history-display-duplicate-highest' is t, 609 ;; display highest (most recent) duplicate. 610 (cl-delete-duplicates 611 items 612 :test #'equal 613 :from-end cider-repl-history-display-duplicate-highest)) 614 (when (stringp regexp) 615 (setq items (delq nil 616 (mapcar 617 #'(lambda (item) 618 (when (string-match regexp item) 619 item)) 620 items)))) 621 (funcall (or (cdr (assq cider-repl-history-display-style 622 cider-repl-history-display-styles)) 623 (error "Invalid `cider-repl-history-display-style': %s" 624 cider-repl-history-display-style)) 625 items) 626 (when cider-repl-history-show-preview 627 (cider-repl-history-preview-update-by-position (point-min)) 628 ;; Local post-command-hook, only happens in *cider-repl-history* 629 (add-hook 'post-command-hook 630 #'cider-repl-history-preview-update-by-position 631 nil t) 632 (add-hook 'kill-buffer-hook 633 #'cider-repl-history-cleanup-on-exit 634 nil t)) 635 (when cider-repl-history-highlight-current-entry 636 (add-hook 'post-command-hook 637 #'cider-repl-history-update-highlighted-entry 638 nil t)) 639 (message 640 (let ((entry (if (= 1 (length cider-command-history)) 641 "entry" 642 "entries"))) 643 (concat 644 (if (and (not regexp) 645 cider-repl-history-display-duplicates) 646 (format "%s %s in the command history." 647 (length cider-command-history) entry) 648 (format "%s (of %s) %s in the command history shown." 649 (length items) (length cider-command-history) entry)) 650 (substitute-command-keys 651 (concat " Type \\[cider-repl-history-quit] to quit. " 652 "\\[describe-mode] for help."))))) 653 (set-buffer-modified-p nil) 654 (goto-char (point-min)) 655 (cider-repl-history-forward 0) 656 (setq mode-name (if regexp 657 (concat "History [" regexp "]") 658 "History")) 659 (run-hooks 'cider-repl-history-hook))) 660 (setq buffer-read-only t)))) 661 662 (defun cider-repl-history-update () 663 "Update the history buffer to reflect the latest state of the command history." 664 (interactive) 665 (cl-assert (eq major-mode 'cider-repl-history-mode)) 666 (cider-repl-history-setup cider-repl-history-repl-window 667 cider-repl-history-repl-buffer 668 (current-buffer)) 669 (cider-repl-history-resize-window)) 670 671 (defun cider-repl-history-occur (regexp) 672 "Display all command history entries matching REGEXP." 673 (interactive 674 (list (cider-repl-history-read-regexp 675 "Display command history entries matching" nil))) 676 (cl-assert (eq major-mode 'cider-repl-history-mode)) 677 (cider-repl-history-setup cider-repl-history-repl-window 678 cider-repl-history-repl-buffer 679 (current-buffer) 680 regexp) 681 (cider-repl-history-resize-window)) 682 683 (defvar cider-repl-history-mode-map 684 (let ((map (make-sparse-keymap))) 685 (define-key map (kbd "n") #'cider-repl-history-forward) 686 (define-key map (kbd "p") #'cider-repl-history-previous) 687 (define-key map (kbd "SPC") #'cider-repl-history-insert-and-quit) 688 (define-key map (kbd "RET") #'cider-repl-history-insert-and-quit) 689 (define-key map [(mouse-2)] #'cider-repl-history-mouse-insert) 690 (define-key map (kbd "l") #'cider-repl-history-occur) 691 (define-key map (kbd "s") #'cider-repl-history-search-forward) 692 (define-key map (kbd "r") #'cider-repl-history-search-backward) 693 (define-key map (kbd "g") #'cider-repl-history-update) 694 (define-key map (kbd "q") #'cider-repl-history-quit) 695 (define-key map (kbd "U") #'cider-repl-history-undo-other-window) 696 (define-key map (kbd "?") #'describe-mode) 697 (define-key map (kbd "h") #'describe-mode) 698 map)) 699 700 (put 'cider-repl-history-mode 'mode-class 'special) 701 (define-derived-mode cider-repl-history-mode clojure-mode "History" 702 "Major mode for browsing the entries in the command input history." 703 (setq-local sesman-system 'CIDER)) 704 705 ;;;###autoload 706 (defun cider-repl-history () 707 "Display items in the CIDER command history in another buffer." 708 (interactive) 709 (when (eq major-mode 'cider-repl-history-mode) 710 (user-error "Already viewing the CIDER command history")) 711 712 (let* ((repl-win (selected-window)) 713 (repl-buf (window-buffer repl-win)) 714 (buf (get-buffer-create cider-repl-history-buffer))) 715 (cider-repl-history-setup repl-win repl-buf buf) 716 (pop-to-buffer buf) 717 (cider-repl-history-resize-window))) 718 719 (provide 'cider-repl-history) 720 721 ;;; cider-repl-history.el ends here