cider-popup.el (5547B)
1 ;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- 2 3 ;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors 4 5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com> 6 7 ;; This program is free software; you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 ;;; Commentary: 21 22 ;; Common functionality for dealing with popup buffers. 23 24 ;;; Code: 25 26 (require 'subr-x) 27 28 (define-minor-mode cider-popup-buffer-mode 29 "Mode for CIDER popup buffers." 30 :lighter (" cider-tmp") 31 :keymap '(("q" . cider-popup-buffer-quit-function))) 32 33 (defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit 34 "The function that is used to quit a temporary popup buffer.") 35 36 (defun cider-popup-buffer-quit-function (&optional kill-buffer-p) 37 "Wrapper to invoke the function `cider-popup-buffer-quit-function'. 38 KILL-BUFFER-P is passed along." 39 (interactive) 40 (funcall cider-popup-buffer-quit-function kill-buffer-p)) 41 42 (defun cider-popup-buffer (name &optional select mode ancillary) 43 "Create new popup buffer called NAME. 44 If SELECT is non-nil, select the newly created window. 45 If major MODE is non-nil, enable it for the popup buffer. 46 If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' 47 and automatically removed when killed." 48 (thread-first (cider-make-popup-buffer name mode ancillary) 49 (cider-popup-buffer-display select))) 50 51 (defun cider-popup-buffer-display (buffer &optional select) 52 "Display BUFFER. 53 If SELECT is non-nil, select the BUFFER." 54 (let ((window (get-buffer-window buffer 'visible))) 55 (when window 56 (with-current-buffer buffer 57 (set-window-point window (point)))) 58 ;; If the buffer we are popping up is already displayed in the selected 59 ;; window, the below `inhibit-same-window' logic will cause it to be 60 ;; displayed twice - so we early out in this case. Note that we must check 61 ;; `selected-window', as async request handlers are executed in the context 62 ;; of the current connection buffer (i.e. `current-buffer' is dynamically 63 ;; bound to that). 64 (unless (eq window (selected-window)) 65 ;; Non nil `inhibit-same-window' ensures that current window is not covered 66 ;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected 67 ;; if that's where the buffer is being shown. 68 (funcall (if select #'pop-to-buffer #'display-buffer) 69 buffer `(nil . ((inhibit-same-window . ,pop-up-windows) 70 (reusable-frames . visible)))))) 71 buffer) 72 73 (defun cider-popup-buffer-quit (&optional kill) 74 "Quit the current (temp) window. 75 Bury its buffer using `quit-restore-window'. 76 If prefix argument KILL is non-nil, kill the buffer instead of burying it." 77 (interactive) 78 (quit-restore-window (selected-window) (if kill 'kill 'append))) 79 80 (defvar-local cider-popup-output-marker nil) 81 82 (defvar cider-ancillary-buffers nil 83 "A list ancillary buffers created by the various CIDER commands. 84 We track them mostly to be able to clean them up on quit.") 85 86 (defun cider-make-popup-buffer (name &optional mode ancillary) 87 "Create a temporary buffer called NAME using major MODE (if specified). 88 If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' 89 and automatically removed when killed." 90 (with-current-buffer (get-buffer-create name) 91 (kill-all-local-variables) 92 (setq buffer-read-only nil) 93 (erase-buffer) 94 (when mode 95 (funcall mode)) 96 (cider-popup-buffer-mode 1) 97 (setq cider-popup-output-marker (point-marker)) 98 (setq buffer-read-only t) 99 (when ancillary 100 (add-to-list 'cider-ancillary-buffers name) 101 (add-hook 'kill-buffer-hook 102 (lambda () 103 (setq cider-ancillary-buffers 104 (remove name cider-ancillary-buffers))) 105 nil 'local)) 106 (current-buffer))) 107 108 (defun cider-emit-into-popup-buffer (buffer value &optional face inhibit-indent) 109 "Emit into BUFFER the provided VALUE optionally using FACE. 110 Indent emitted value (usually a sexp) unless INHIBIT-INDENT is specified 111 and non-nil." 112 ;; Long string output renders Emacs unresponsive and users might intentionally 113 ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and 114 ;; silently ignore the output. 115 (when (buffer-live-p buffer) 116 (with-current-buffer buffer 117 (let ((inhibit-read-only t) 118 (buffer-undo-list t) 119 (moving (= (point) cider-popup-output-marker))) 120 (save-excursion 121 (goto-char cider-popup-output-marker) 122 (let ((value-str (format "%s" value))) 123 (when face 124 (add-face-text-property 0 (length value-str) face nil value-str)) 125 (insert value-str)) 126 (unless inhibit-indent 127 (indent-sexp)) 128 (set-marker cider-popup-output-marker (point))) 129 (when moving (goto-char cider-popup-output-marker)))))) 130 131 (provide 'cider-popup) 132 133 ;;; cider-popup.el ends here