-
Notifications
You must be signed in to change notification settings - Fork 15
/
Copy patheros.el
282 lines (228 loc) · 9.91 KB
/
eros.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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
;;; eros.el --- Evaluation Result OverlayS for Emacs Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2016-2018 Tianxiang Xiong
;; Author: Tianxiang Xiong <tianxiang.xiong@gmail.com>
;; Keywords: convenience, lisp
;; Package-Requires: ((emacs "24.4"))
;; URL: https://github.com/xiongtx/eros
;; Version: 0.1.0
;; 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:
;; Evaluation result overlays for Emacs Lisp.
;; The code is mostly taken from CIDER. For more about CIDER, see:
;; https://github.com/clojure-emacs/cider
;;; Code:
(require 'cl-lib)
(require 'pp)
;; Customize
(defgroup eros nil
"Evaluation Result OverlayS for Emacs Lisp"
:prefix "eros-"
:group 'lisp)
(defcustom eros-eval-result-prefix "=> "
"The prefix displayed in the minibuffer before a result value."
:group 'eros
:type 'string
:package-version '(eros "0.1.0"))
(defface eros-result-overlay-face
'((((class color) (background light))
:background "grey90" :box (:line-width -1 :color "yellow"))
(((class color) (background dark))
:background "grey10" :box (:line-width -1 :color "black")))
"Face used to display evaluation results at the end of line.
If `eros-overlays-use-font-lock' is non-nil, this face is applied
with lower priority than the syntax highlighting."
:group 'eros
:package-version '(eros "0.1.0"))
(defcustom eros-overlays-use-font-lock t
"If non-nil, results overlays are font-locked as Clojure code.
If nil, apply `eros-result-overlay-face' to the entire overlay instead of
font-locking it."
:group 'eros
:type 'boolean
:package-version '(eros "0.1.0"))
(defcustom eros-eval-result-duration 'command
"Duration, in seconds, of eval-result overlays.
If nil, overlays last indefinitely.
If the symbol `command', they're erased before the next command."
:group 'eros
:type '(choice (integer :tag "Duration in seconds")
(const :tag "Until next command" command)
(const :tag "Last indefinitely" nil))
:package-version '(eros "0.1.0"))
;; Internals
(defvar eros--inspect-buffer-name "*eros inspect*"
"Buffer name for showing pretty printed results.")
(defvar eros--last-result nil
"Result of the last `eros-eval-*' call.")
;; Overlay
(defun eros--make-overlay (l r type &rest props)
"Place an overlay between L and R and return it.
TYPE is a symbol put on the overlay's category property. It is
used to easily remove all overlays from a region with:
(remove-overlays start end 'category TYPE)
PROPS is a plist of properties and values to add to the overlay."
(let ((o (make-overlay l (or r l) (current-buffer))))
(overlay-put o 'category type)
(overlay-put o 'eros-temporary t)
(while props (overlay-put o (pop props) (pop props)))
(push #'eros--delete-overlay (overlay-get o 'modification-hooks))
o))
(defun eros--delete-overlay (ov &rest _)
"Safely delete overlay OV.
Never throws errors, and can be used in an overlay's
modification-hooks."
(ignore-errors (delete-overlay ov)))
(cl-defun eros--make-result-overlay (value &rest props &key where duration (type 'result)
(format (concat " " eros-eval-result-prefix "%s "))
(prepend-face 'eros-result-overlay-face)
&allow-other-keys)
"Place an overlay displaying VALUE at the end of line.
VALUE is used as the overlay's after-string property, meaning it
is displayed at the end of the overlay. The overlay itself is
placed from beginning to end of current line.
Return nil if the overlay was not placed or if it might not be
visible, and return the overlay otherwise.
Return the overlay if it was placed successfully, and nil if it
failed.
This function takes some optional keyword arguments:
- If WHERE is a number or a marker, apply the overlay over the
entire line at that place (defaulting to `point'). If it is a
cons cell, the car and cdr determine the start and end of the
overlay.
- DURATION takes the same possible values as the
`eros-eval-result-duration' variable.
- TYPE is passed to `eros--make-overlay' (defaults to `result').
- FORMAT is a string passed to `format'. It should have exactly
one %s construct (for VALUE).
All arguments beyond these (PROPS) are properties to be used on
the overlay."
(declare (indent 1))
(while (keywordp (car props))
(setq props (cddr props)))
;; If the marker points to a dead buffer, don't do anything.
(let ((buffer (cond
((markerp where) (marker-buffer where))
((markerp (car-safe where)) (marker-buffer (car where)))
(t (current-buffer)))))
(with-current-buffer buffer
(save-excursion
(when (number-or-marker-p where)
(goto-char where))
;; Make sure the overlay is actually at the end of the sexp.
(skip-chars-backward "\r\n[:blank:]")
(let* ((beg (if (consp where)
(car where)
(save-excursion
(backward-sexp 1)
(point))))
(end (if (consp where)
(cdr where)
(line-end-position)))
(display-string (format format value))
(o nil))
(remove-overlays beg end 'category type)
(funcall (if eros-overlays-use-font-lock
#'font-lock-prepend-text-property
#'put-text-property)
0 (length display-string)
'face prepend-face
display-string)
;; If the display spans multiple lines or is very long, display it at
;; the beginning of the next line.
(when (or (string-match "\n." display-string)
(> (string-width display-string)
(- (window-width) (current-column))))
(setq display-string (concat " \n" display-string)))
;; Put the cursor property only once we're done manipulating the
;; string, since we want it to be at the first char.
(put-text-property 0 1 'cursor 0 display-string)
(when (> (string-width display-string) (* 3 (window-width)))
(setq display-string
(concat (substring display-string 0 (* 3 (window-width)))
"...\nResult truncated.")))
;; Create the result overlay.
(setq o (apply #'eros--make-overlay
beg end type
'after-string display-string
props))
(pcase duration
((pred numberp) (run-at-time duration nil #'eros--delete-overlay o))
(`command (if this-command
(add-hook 'pre-command-hook
#'eros--remove-result-overlay
nil 'local)
(eros--remove-result-overlay))))
(let ((win (get-buffer-window buffer)))
;; Left edge is visible.
(when (and win
(<= (window-start win) (point))
;; In 24.3 `<=' is still a binary predicate.
(<= (point) (window-end win))
;; Right edge is visible. This is a little conservative
;; if the overlay contains line breaks.
(or (< (+ (current-column) (string-width value))
(window-width win))
(not truncate-lines)))
o)))))))
(defun eros--remove-result-overlay ()
"Remove result overlay from current buffer.
This function also removes itself from `pre-command-hook'."
(remove-hook 'pre-command-hook #'eros--remove-result-overlay 'local)
(remove-overlays nil nil 'category 'result))
(defun eros--eval-overlay (value point)
"Make overlay for VALUE at POINT."
(eros--make-result-overlay (format "%S" value)
:where point
:duration eros-eval-result-duration)
value)
;; API
(defun eros-eval-last-sexp (eval-last-sexp-arg-internal)
"Wrapper for `eval-last-sexp' that overlays results."
(interactive "P")
(let ((result (eval-last-sexp eval-last-sexp-arg-internal)))
(setq eros--last-result result)
(when (get-buffer eros--inspect-buffer-name)
(eros-inspect-last-result))
(eros--eval-overlay
result
(point))))
(defun eros-eval-defun (edebug-it)
"Wrapper for `eval-defun' that overlays results."
(interactive "P")
(eros--eval-overlay
(eval-defun edebug-it)
(save-excursion
(end-of-defun)
(point))))
(defun eros-inspect-last-result ()
"Inspect the result of last `eros-eval-'."
(interactive)
(when eros--last-result
(get-buffer-create eros--inspect-buffer-name)
(let ((print-length nil)
(print-level nil))
(pp-display-expression eros--last-result eros--inspect-buffer-name))
(unless (get-buffer-window eros--inspect-buffer-name)
(switch-to-buffer-other-window eros--inspect-buffer-name))))
;; Minor mode
;;;###autoload
(define-minor-mode eros-mode
"Display Emacs Lisp evaluation results overlays."
:global t
(if eros-mode
(progn
(global-set-key [remap eval-last-sexp] #'eros-eval-last-sexp)
(global-set-key [remap eval-defun] #'eros-eval-defun))
(global-set-key [remap eval-last-sexp] nil)
(global-set-key [remap eval-defun] nil)))
(provide 'eros)
;;; eros.el ends here