1;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- 2 3;; Copyright © 2015-2021 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(require 'cider-compat) 28 29(define-minor-mode cider-popup-buffer-mode 30 "Mode for CIDER popup buffers" 31 nil 32 (" cider-tmp") 33 '(("q" . cider-popup-buffer-quit-function))) 34 35(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit 36 "The function that is used to quit a temporary popup buffer.") 37 38(defun cider-popup-buffer-quit-function (&optional kill-buffer-p) 39 "Wrapper to invoke the function `cider-popup-buffer-quit-function'. 40KILL-BUFFER-P is passed along." 41 (interactive) 42 (funcall cider-popup-buffer-quit-function kill-buffer-p)) 43 44(defun cider-popup-buffer (name &optional select mode ancillary) 45 "Create new popup buffer called NAME. 46If SELECT is non-nil, select the newly created window. 47If major MODE is non-nil, enable it for the popup buffer. 48If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' 49and automatically removed when killed." 50 (thread-first (cider-make-popup-buffer name mode ancillary) 51 (cider-popup-buffer-display select))) 52 53(defun cider-popup-buffer-display (buffer &optional select) 54 "Display BUFFER. 55If SELECT is non-nil, select the BUFFER." 56 (let ((window (get-buffer-window buffer 'visible))) 57 (when window 58 (with-current-buffer buffer 59 (set-window-point window (point)))) 60 ;; If the buffer we are popping up is already displayed in the selected 61 ;; window, the below `inhibit-same-window' logic will cause it to be 62 ;; displayed twice - so we early out in this case. Note that we must check 63 ;; `selected-window', as async request handlers are executed in the context 64 ;; of the current connection buffer (i.e. `current-buffer' is dynamically 65 ;; bound to that). 66 (unless (eq window (selected-window)) 67 ;; Non nil `inhibit-same-window' ensures that current window is not covered 68 ;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected 69 ;; if that's where the buffer is being shown. 70 (funcall (if select #'pop-to-buffer #'display-buffer) 71 buffer `(nil . ((inhibit-same-window . ,pop-up-windows) 72 (reusable-frames . visible)))))) 73 buffer) 74 75(defun cider-popup-buffer-quit (&optional kill) 76 "Quit the current (temp) window. 77Bury its buffer using `quit-restore-window'. 78If prefix argument KILL is non-nil, kill the buffer instead of burying it." 79 (interactive) 80 (quit-restore-window (selected-window) (if kill 'kill 'append))) 81 82(defvar-local cider-popup-output-marker nil) 83 84(defvar cider-ancillary-buffers nil 85 "A list ancillary buffers created by the various CIDER commands. 86We track them mostly to be able to clean them up on quit.") 87 88(defun cider-make-popup-buffer (name &optional mode ancillary) 89 "Create a temporary buffer called NAME using major MODE (if specified). 90If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' 91and automatically removed when killed." 92 (with-current-buffer (get-buffer-create name) 93 (kill-all-local-variables) 94 (setq buffer-read-only nil) 95 (erase-buffer) 96 (when mode 97 (funcall mode)) 98 (cider-popup-buffer-mode 1) 99 (setq cider-popup-output-marker (point-marker)) 100 (setq buffer-read-only t) 101 (when ancillary 102 (add-to-list 'cider-ancillary-buffers name) 103 (add-hook 'kill-buffer-hook 104 (lambda () 105 (setq cider-ancillary-buffers 106 (remove name cider-ancillary-buffers))) 107 nil 'local)) 108 (current-buffer))) 109 110(defun cider-emit-into-popup-buffer (buffer value &optional face inhibit-indent) 111 "Emit into BUFFER the provided VALUE optionally using FACE. 112Indent emitted value (usually a sexp) unless INHIBIT-INDENT is specified 113and non-nil." 114 ;; Long string output renders Emacs unresponsive and users might intentionally 115 ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and 116 ;; silently ignore the output. 117 (when (buffer-live-p buffer) 118 (with-current-buffer buffer 119 (let ((inhibit-read-only t) 120 (buffer-undo-list t) 121 (moving (= (point) cider-popup-output-marker))) 122 (save-excursion 123 (goto-char cider-popup-output-marker) 124 (let ((value-str (format "%s" value))) 125 (when face 126 (if (fboundp 'add-face-text-property) 127 (add-face-text-property 0 (length value-str) face nil value-str) 128 (add-text-properties 0 (length value-str) (list 'face face) value-str))) 129 (insert value-str)) 130 (unless inhibit-indent 131 (indent-sexp)) 132 (set-marker cider-popup-output-marker (point))) 133 (when moving (goto-char cider-popup-output-marker)))))) 134 135(provide 'cider-popup) 136 137;;; cider-popup.el ends here 138