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