Klimi's new dotfiles with stow.
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

726 líneas
30 KiB

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