-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathslime-star.el
197 lines (159 loc) · 7.07 KB
/
slime-star.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
;;; slime-star --- SLIME with augmented features. -*- lexical-binding: t -*-
;; Copyright (C) 2022 Mariano Montone
;; 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:
;;; Code:
(require 'slime)
(require 'slime-stepper)
(require 'slime-toolbars)
(require 'slime-star-commands)
(require 'sldb-show-frame-local)
(require 'inline-message)
(require 'info)
(require 'info-look)
(defgroup slime-star nil
"SLIME Star (SLIME extensions)."
:group 'slime)
(defcustom slime-star-use-custom-stepper-highlighter nil
"Use custom stepper highlighter when enabled."
:type 'boolean
:group 'slime-star)
(defcustom slime-star-use-toolbars nil
"Use custom toolbars for SLIME buffers."
:type 'boolean
:group 'slime-star)
(defcustom slime-star-show-frame-local-on-cursor-move nil
"Show frame local in debugger when cursor moves."
:type 'boolean
:group 'slime-star)
;; -- Highlight expression before evaluating it ----------------------------
(defun slime-last-expression-region ()
"Return last expression at point, and its region."
(let (start end)
(cl-values
(buffer-substring-no-properties
(save-excursion (backward-sexp) (setq start (point)))
(setq end (point)))
start end)))
(defun slime-highlight-last-expression ()
"Highlight last expression."
(cl-multiple-value-bind (exp start end)
(slime-last-expression-region)
(slime-flash-region start end)))
(advice-add 'slime-eval-last-expression
:before #'slime-highlight-last-expression)
;; -- Display evaluation results in buffer -------------------
;; This is not implemented very prettily.
;; Function advice is used to hook into SLIME machinery for displaying evaluation results.
(defcustom slime-star-display-eval-result-in-buffer nil
"Temporarily print SLIME evaluations at current position in buffer."
:type 'boolean
:group 'slime-star)
(defvar slime-current-buffer nil
"Saved value of `current-buffer' before SLIME switches to using the connection buffer as `current-buffer'.
This is used by the `inline-message' display functions, as it needs to know the user's buffer.")
(defun slime-star-save-current-buffer (form)
"Save current buffer and call `slime-eval-with-transcript'."
(setq slime-current-buffer (current-buffer)))
(defun slime-star-display-eval-result (value)
"Maybe show evaluation result in buffer too."
(when slime-star-display-eval-result-in-buffer
(if (buffer-live-p slime-current-buffer)
(with-current-buffer slime-current-buffer
(inline-message value))
(slime-message "%s" value))))
(advice-add 'slime-eval-with-transcript
:before #'slime-star-save-current-buffer)
(advice-add 'slime-display-eval-result
:after #'slime-star-display-eval-result)
(defun slime-toggle-output-buffer ()
"Toggle sending output to a buffer."
(interactive)
(let ((enabled? (slime-eval `(slime-star:toggle-send-output-to-buffer))))
(message (if enabled?
"Output buffer enabled"
"Output buffer disabled"))))
(defun slime-toggle-trace-buffer ()
"Toggle sending traces to a buffer."
(interactive)
(let ((enabled? (slime-eval `(slime-star:toggle-send-trace-to-buffer))))
(message (if enabled?
"Trace buffer enabled"
"Trace buffer disabled"))))
(defun slime-toggle-error-buffer ()
"Toggle sending errors to a buffer."
(interactive)
(let ((enabled? (slime-eval `(slime-star:toggle-send-error-to-buffer))))
(message (if enabled?
"Error buffer enabled"
"Error buffer disabled"))))
(defun slime-star--setup-key-bindings ()
(define-key sldb-mode-map "Q" 'sldb-kill-all-buffers))
(defun slime-star--setup-menus ()
(easy-menu-add-item 'menubar-slime nil
'("Tools"
["System Browser" lisp-system-browser]
["Quicklisp Systems" quicklisp-systems]
["Quicksearch" quicksearch])
"Documentation")
(easy-menu-add-item 'menubar-slime nil
'("Stream buffers"
["Toggle output buffer" slime-toggle-output-buffer]
["Toggle error buffer" slime-toggle-error-buffer]
["Toggle trace buffer" slime-toggle-trace-buffer])
"Documentation"))
(defvar slime-star--load-path (file-name-directory load-file-name))
;;--- ANSI Common Lisp spec in Info format ------------------------
(add-to-list 'Info-default-directory-list (concat slime-star--load-path "info"))
(setq Info-directory-list nil)
(info-initialize)
(info-lookup-add-help
:mode 'lisp-mode
:regexp "[^][()'\" \t\n]+"
:ignore-case t
:doc-spec '(("(ansicl)Symbol Index" nil nil nil)))
(defun slime-star-ansicl-lookup (symbol-name)
(info-lookup-symbol (slime-cl-symbol-name symbol-name) 'lisp-mode))
(setq slime-help-ansicl-lookup-function 'slime-star-ansicl-lookup)
;;--- SLIME contrib -----------------------------------------------
(defun slime-star--add-swank-path ()
(slime-eval `(cl:progn (cl:push ,slime-star--load-path swank::*load-path*) nil)))
;; This is a hack. Sort SWANK requirements for proper loading (they are dependent on each other.)
(defun slime-star--sort-requirements ()
(setq slime-required-modules
(list* 'swank-buffer-streams
'swank-trace-dialog
(cl-remove-if (lambda (x) (member x '(swank-buffer-streams swank-trace-dialog)))
slime-required-modules))))
(define-slime-contrib slime-star
"SLIME with extra extensions preinstalled."
(:authors "Mariano Montone")
(:license "GPL")
(:slime-dependencies slime-buffer-streams slime-print-buffer slime-trace-buffer quicklisp-systems quicklisp-apropos quicksearch slime-help system-browser-cl slime-breakpoints slime-stream-inspector sldb-source-eval slime-critic slime-buffer-streams)
(:swank-dependencies slime-star)
(:on-load
;; setup key bindings
(slime-star--setup-key-bindings)
;; add submenu to SLIME menu
(slime-star--setup-menus)
(when slime-star-show-frame-local-on-cursor-move
(sldb-show-frame-local-on-cursor-move))
(add-hook 'slime-connected-hook
(lambda ()
(when slime-star-use-toolbars
(slime-toolbars-setup-tool-bars))
(when slime-star-use-custom-stepper-highlighter
(slime-stepper--install))))
(advice-add 'slime-load-contribs :before #'slime-star--sort-requirements)
(advice-add 'slime-load-contribs :before #'slime-star--add-swank-path)
))
(provide 'slime-star)