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