Commit b56eb28bbf15513e9eb9c2f1d62ee9cefdae383b - slime

+4

-2

.github/workflows/ci.yml less more

12	12	matrix:
13	13	lisp: [ccl, sbcl]
14	14	os: [ubuntu-latest]
15		emacs_version: [24-5, 25-3, 26-3, snapshot]
	15	emacs_version: [24-5, 25-3, 26-3, 27-1, snapshot]
16	16	fail-fast: false
17	17	steps:
18	18
19	19	- uses: cachix/install-nix-action@v12
	20	with:
	21	nix_path: nixpkgs=channel:nixos-unstable
20	22	- uses: purcell/setup-emacs@master
21	23	with:
22	24	version: ${{ matrix.emacs_version }}
23	25	- uses: actions/checkout@v2
24		- run: nix-env -i ${{ matrix.lisp }}
	26	- run: nix-env -i ${{ matrix.lisp }} -f '<nixpkgs>'
25	27	- run: make LISP="${{ matrix.lisp }}" check

+1

-1

.gitref less more

0		15cf0609d30255405957bf0612fd6291fea438bc⏎
	0	cf30941e5858e93eb91574ad91499075222a447b⏎

+3

-0

NEWS less more

0	0	* SLIME News -- mode: outline; coding: utf-8 --
	1	* 2.27 (January 2022)
	2	** Mostly improved compatibility with different implementations and bug fixes.
	3
1	4	* 2.26.1 (December 2020)
2	5	** SBCL compatibility
3	6

+2

-5

contrib/bridge.el less more

63	63	;;; alias devgnu '(echo -n "\!* "; cat -; echo -n "")'
64	64	;;;
65	65	;;; ls \| devgnu scratch
66
67		(eval-when-compile
68		(require 'cl))
69	66
70	67	;;;%Parameters
71	68	(defvar bridge-hook nil

289	286	;; equivalent sections have the same numbers here;
290	287	;; we fold them together in this code.
291	288
292		(block bridge-filter
	289	(cl-block bridge-filter
293	290	(unwind-protect
294	291	(while (< end (length output))
295	292

348	345	(bridge-insert pass-on))))
349	346
350	347	(if (and b-start-end (not b-end))
351		(return-from bridge-filter t) ; when last bit has prematurely ending message, exit early.
	348	(cl-return-from bridge-filter t) ; when last bit has prematurely ending message, exit early.
352	349	(progn
353	350	;;3 find handler (in b-start, b-end) if none current
354	351	(if (and b-start (not bridge-in-progress))

+19

-21

contrib/slime-cl-indent.el less more

42	42
43	43	(require 'slime) ; only for its cl-lib loading smartness
44	44	(require 'cl-lib)
45		(eval-when-compile (require 'cl))
46	45
47	46	(defgroup lisp-indent nil
48	47	"Indentation in Lisp."

228	227	;;;; explicitly, however, and offers name completion, etc.
229	228
230	229	;;; Convenience accessors
231		(defun common-lisp-style-name (style) (first style))
232		(defun common-lisp-style-inherits (style) (second style))
233		(defun common-lisp-style-variables (style) (third style))
234		(defun common-lisp-style-indentation (style) (fourth style))
235		(defun common-lisp-style-hook (style) (fifth style))
236		(defun common-lisp-style-docstring (style) (sixth style))
	230	(defun common-lisp-style-name (style) (cl-first style))
	231	(defun common-lisp-style-inherits (style) (cl-second style))
	232	(defun common-lisp-style-variables (style) (cl-third style))
	233	(defun common-lisp-style-indentation (style) (cl-fourth style))
	234	(defun common-lisp-style-hook (style) (cl-fifth style))
	235	(defun common-lisp-style-docstring (style) (cl-sixth style))
237	236
238	237	(defun common-lisp-make-style (stylename inherits variables indentation hook
239	238	documentation)

305	304	(push (list name (common-lisp-style-docstring style)) all))
306	305	common-lisp-styles)
307	306	(dolist (info (sort all (lambda (a b) (string< (car a) (car b)))))
308		(let ((style-name (first info))
309		(style-doc (second info)))
	307	(let ((style-name (cl-first info))
	308	(style-doc (cl-second info)))
310	309	(if style-doc
311	310	(setq doc (concat doc
312	311	"\n " style-name "\n"

326	325	(common-lisp-activate-style basename methods))
327	326	;; Copy methods
328	327	(dolist (spec (common-lisp-style-indentation style))
329		(puthash (first spec) (second spec) methods))
	328	(puthash (cl-first spec) (cl-second spec) methods))
330	329	;; Bind variables.
331	330	(dolist (var (common-lisp-style-variables style))
332		(set (make-local-variable (first var)) (second var)))
	331	(set (make-local-variable (cl-first var)) (cl-second var)))
333	332	;; Run hook.
334	333	(let ((hook (common-lisp-style-hook style)))
335	334	(when hook

617	616	(let ((guess nil)
618	617	(guess-n 0)
619	618	(package (common-lisp-symbol-package full)))
620		(dolist (info system-info guess)
	619	(cl-dolist (info system-info guess)
621	620	(let* ((pkgs (cdr info))
622	621	(n (length pkgs)))
623	622	(cond ((member package pkgs)
624	623	;; This is it.
625		(return (car info)))
	624	(cl-return (car info)))
626	625	((> n guess-n)
627	626	;; If we can't find the real thing, go with the one
628	627	;; accessible in most packages.

758	757	;;; boot, and sufficient for our needs.
759	758	(defun common-lisp-looking-back (string)
760	759	(let ((len (length string)))
761		(dotimes (i len t)
	760	(cl-dotimes (i len t)
762	761	(unless (eql (elt string (- len i 1)) (char-before (- (point) i)))
763		(return nil)))))
	762	(cl-return nil)))))
764	763
765	764	(defvar common-lisp-feature-expr-regexp "#!?\$+\\\|-\$")
766	765

1336	1335	(backward-sexp)
1337	1336	(looking-at "nil\\\|("))))
1338	1337	(+ sexp-column
1339		(case (car path)
	1338	(cl-case (car path)
1340	1339	((1 3) 4)
1341	1340	(2 4)
1342	1341	(t 2))))
1343	1342	;; Short form.
1344	1343	(t
1345	1344	(+ sexp-column
1346		(case (car path)
	1345	(cl-case (car path)
1347	1346	(1 4)
1348	1347	(2 4)
1349	1348	(t 2)))))

1375	1374	(when (setq nskip (lisp-beginning-of-defmethod-qualifiers))
1376	1375	(skip-chars-forward " \t\n")
1377	1376	(while (looking-at "\\sw\\\|\\s_")
1378		(incf nskip)
	1377	(cl-incf nskip)
1379	1378	(forward-sexp)
1380	1379	(skip-chars-forward " \t\n"))
1381	1380	t))

1702	1701
1703	1702	(defun common-lisp-indent-if*-advance-past-keyword-on-line ()
1704	1703	(forward-word 1)
1705		(block move-forward
1706		(while (and (looking-at "\\s-") (not (eolp)))
1707		(forward-char 1)))
	1704	(while (and (looking-at "\\s-") (not (eolp)))
	1705	(forward-char 1))
1708	1706	(if (eolp)
1709	1707	nil
1710	1708	(current-column)))

+6

-6

contrib/slime-clipboard.el less more

	0	;;;; -- lexical-binding: t --
	1
0	2	(require 'slime)
1	3	(require 'slime-repl)
2	4	(require 'cl-lib)
3		(eval-when-compile
4		(require 'cl)) ; lexical-let
5	5
6	6	(define-slime-contrib slime-clipboard
7	7	"This add a few commands to put objects into a clipboard and to

82	82	(defun slime-clipboard-redisplay ()
83	83	"Update the clipboard buffer."
84	84	(interactive)
85		(lexical-let ((saved (point)))
86		(slime-eval-async
87		`(swank-clipboard:entries)
88		(lambda (entries)
	85	(let ((saved (point)))
	86	(slime-eval-async
	87	`(swank-clipboard:entries)
	88	(lambda (entries)
89	89	(let ((inhibit-read-only t))
90	90	(erase-buffer)
91	91	(slime-clipboard-insert-entries entries)

+3

-3

contrib/slime-editing-commands.el less more

73	73	;; count sexps until either '(' or comment is found at first column
74	74	(while (and (not (looking-at "^[(;]"))
75	75	(ignore-errors (backward-up-list 1) t))
76		(incf sexp-level))))
	76	(cl-incf sexp-level))))
77	77	(when (> sexp-level 0)
78	78	;; insert correct number of right parens
79	79	(goto-char point)

111	111	(replace-match ""))))
112	112	(while (> arg 0)
113	113	(backward-char 1)
114		(cond ((looking-at ")") (incf arg))
115		((looking-at "(") (decf arg))))
	114	(cond ((looking-at ")") (cl-incf arg))
	115	((looking-at "(") (cl-decf arg))))
116	116	(insert "#\|")
117	117	(forward-sexp)
118	118	(insert "\|#")))

+3

-2

contrib/slime-fontifying-fu.el less more

181	181	(point)))))
182	182	(cl-values (or (/= beg orig-beg) (/= end orig-end)) beg end)))
183	183
184
	184
185	185	(defun slime-activate-font-lock-magic ()
186	186	(if (featurep 'xemacs)
187	187	(let ((pattern `((slime-search-suppressed-forms

202	202	(let ((byte-compile-warnings '()))
203	203	(mapc (lambda (sym)
204	204	(cond ((fboundp sym)
205		(unless (byte-code-function-p (symbol-function sym))
	205	(unless (or (byte-code-function-p (symbol-function sym))
	206	(subrp (symbol-function sym)))
206	207	(byte-compile sym)))
207	208	(t (error "%S is not fbound" sym))))
208	209	'(slime-extend-region-for-font-lock

+3

-3

contrib/slime-fuzzy.el less more

125	125	fuzzy completions in the target buffer. Most of the bindings will
126	126	do an implicit select in the completion window and let the
127	127	keypress be processed in the target buffer."
128		nil
129		nil
130		slime-target-buffer-fuzzy-completions-map)
	128	:init-value nil
	129	:lighter nil
	130	:keymap slime-target-buffer-fuzzy-completions-map)
131	131
132	132	(add-to-list 'minor-mode-alist
133	133	'(slime-fuzzy-target-buffer-completions-mode

+4

-3

contrib/slime-hyperdoc.el less more

	0	;;;; -- lexical-binding: t --
	1
0	2	(require 'slime)
1	3	(require 'url-http)
2	4	(require 'browse-url)
3		(eval-when-compile (require 'cl)) ; lexical-let
4	5
5		(defvar slime-old-documentation-lookup-function
	6	(defvar slime-old-documentation-lookup-function
6	7	slime-documentation-lookup-function)
7	8
8	9	(define-slime-contrib slime-hyperdoc

20	21
21	22	(defun slime-hyperdoc-lookup-rpc (symbol-name)
22	23	(slime-eval-async `(swank:hyperdoc ,symbol-name)
23		(lexical-let ((symbol-name symbol-name))
	24	(let ((symbol-name symbol-name))
24	25	#'(lambda (result)
25	26	(slime-log-event result)
26	27	(cl-loop with foundp = nil

+2

-1

contrib/slime-parse.el less more

111	111
112	112	(mapc (lambda (sym)
113	113	(cond ((fboundp sym)
114		(unless (byte-code-function-p (symbol-function sym))
	114	(unless (or (byte-code-function-p (symbol-function sym))
	115	(subrp (symbol-function sym)))
115	116	(byte-compile sym)))
116	117	(t (error "%S is not fbound" sym))))
117	118	'(slime-parse-form-upto-point

+77

-79

contrib/slime-presentations.el less more

0	0	(require 'slime)
1	1	(require 'bridge)
2	2	(require 'cl-lib)
3		(eval-when-compile
4		(require 'cl))
5	3
6	4	(define-slime-contrib slime-presentations
7	5	"Imitate LispM presentations."

53	51	;; FIXME: This conditional is not right - just used because the code
54	52	;; here does not work in XEmacs.
55	53	(when (boundp 'text-property-default-nonsticky)
56		(pushnew '(slime-repl-presentation . t) text-property-default-nonsticky
57		:test 'equal)
58		(pushnew '(slime-repl-result-face . t) text-property-default-nonsticky
59		:test 'equal))
	54	(cl-pushnew '(slime-repl-presentation . t) text-property-default-nonsticky
	55	:test 'equal)
	56	(cl-pushnew '(slime-repl-result-face . t) text-property-default-nonsticky
	57	:test 'equal))
60	58
61	59	(make-variable-buffer-local
62	60	(defvar slime-presentation-start-to-point (make-hash-table)))

121	119	syntax-table ,slime-presentation-syntax-table
122	120	rear-nonsticky t))
123	121	;; Use the presentation as the key of a text property
124		(case (- end start)
	122	(cl-case (- end start)
125	123	(0)
126	124	(1
127	125	(add-text-properties start end

186	184
187	185	(defun slime-presentation-whole-p (presentation start end &optional object)
188	186	(let ((object (or object (current-buffer))))
189		(string= (etypecase object
	187	(string= (cl-etypecase object
190	188	(buffer (with-current-buffer object
191	189	(buffer-substring-no-properties start end)))
192	190	(string (substring-no-properties object start end)))

194	192
195	193	(defun slime-presentations-around-point (point &optional object)
196	194	(let ((object (or object (current-buffer))))
197		(loop for (key value . rest) on (text-properties-at point object) by 'cddr
198		when (slime-presentation-p key)
199		collect key)))
	195	(cl-loop for (key value . rest) on (text-properties-at point object) by 'cddr
	196	when (slime-presentation-p key)
	197	collect key)))
200	198
201	199	(defun slime-presentation-start-p (tag)
202	200	(memq tag '(:start :start-and-end)))

213	211	(let ((change-point (previous-single-property-change
214	212	point presentation object (point-min))))
215	213	(unless change-point
216		(return-from slime-presentation-start
217		(values (etypecase object
218		(buffer (with-current-buffer object 1))
219		(string 0))
220		nil)))
	214	(cl-return-from slime-presentation-start
	215	(cl-values (cl-etypecase object
	216	(buffer (with-current-buffer object 1))
	217	(string 0))
	218	nil)))
221	219	(setq this-presentation (get-text-property change-point
222	220	presentation object))
223	221	(unless this-presentation
224		(return-from slime-presentation-start
225		(values point nil)))
	222	(cl-return-from slime-presentation-start
	223	(cl-values point nil)))
226	224	(setq point change-point)))
227		(values point t)))
	225	(cl-values point t)))
228	226
229	227	(cl-defun slime-presentation-end (point presentation
230	228	&optional (object (current-buffer)))

236	234	(let ((change-point (next-single-property-change
237	235	point presentation object)))
238	236	(unless change-point
239		(return-from slime-presentation-end
240		(values (etypecase object
241		(buffer (with-current-buffer object (point-max)))
242		(string (length object)))
243		nil)))
	237	(cl-return-from slime-presentation-end
	238	(cl-values (cl-etypecase object
	239	(buffer (with-current-buffer object (point-max)))
	240	(string (length object)))
	241	nil)))
244	242	(setq point change-point)
245	243	(setq this-presentation (get-text-property point
246	244	presentation object))))

248	246	(let ((after-end (next-single-property-change point
249	247	presentation object)))
250	248	(if (not after-end)
251		(values (etypecase object
252		(buffer (with-current-buffer object (point-max)))
253		(string (length object)))
254		t)
255		(values after-end t)))
256		(values point nil))))
	249	(cl-values (cl-etypecase object
	250	(buffer (with-current-buffer object (point-max)))
	251	(string (length object)))
	252	t)
	253	(cl-values after-end t)))
	254	(cl-values point nil))))
257	255
258	256	(cl-defun slime-presentation-bounds (point presentation
259	257	&optional (object (current-buffer)))
260	258	"Return start index and end index of `presentation' around `point'
261	259	in `object', and whether the presentation is complete."
262		(multiple-value-bind (start good-start)
	260	(cl-multiple-value-bind (start good-start)
263	261	(slime-presentation-start point presentation object)
264		(multiple-value-bind (end good-end)
	262	(cl-multiple-value-bind (end good-end)
265	263	(slime-presentation-end point presentation object)
266		(values start end
267		(and good-start good-end
268		(slime-presentation-whole-p presentation
269		start end object))))))
	264	(cl-values start end
	265	(and good-start good-end
	266	(slime-presentation-whole-p presentation
	267	start end object))))))
270	268
271	269	(defun slime-presentation-around-point (point &optional object)
272	270	"Return presentation, start index, end index, and whether the

276	274	(innermost-start 0)
277	275	(innermost-end most-positive-fixnum))
278	276	(dolist (presentation (slime-presentations-around-point point object))
279		(multiple-value-bind (start end whole-p)
	277	(cl-multiple-value-bind (start end whole-p)
280	278	(slime-presentation-bounds point presentation object)
281	279	(when whole-p
282	280	(when (< (- end start) (- innermost-end innermost-start))
283	281	(setq innermost-start start
284	282	innermost-end end
285	283	innermost-presentation presentation)))))
286		(values innermost-presentation
287		innermost-start innermost-end)))
	284	(cl-values innermost-presentation
	285	innermost-start innermost-end)))
288	286
289	287	(defun slime-presentation-around-or-before-point (point &optional object)
290	288	(let ((object (or object (current-buffer))))
291		(multiple-value-bind (presentation start end whole-p)
	289	(cl-multiple-value-bind (presentation start end whole-p)
292	290	(slime-presentation-around-point point object)
293	291	(if (or presentation (= point (point-min)))
294		(values presentation start end whole-p)
	292	(cl-values presentation start end whole-p)
295	293	(slime-presentation-around-point (1- point) object)))))
296	294
297	295	(defun slime-presentation-around-or-before-point-or-error (point)
298		(multiple-value-bind (presentation start end whole-p)
	296	(cl-multiple-value-bind (presentation start end whole-p)
299	297	(slime-presentation-around-or-before-point point)
300	298	(unless presentation
301	299	(error "No presentation at point"))
302		(values presentation start end whole-p)))
	300	(cl-values presentation start end whole-p)))
303	301
304	302	(cl-defun slime-for-each-presentation-in-region (from to function
305	303	&optional (object (current-buffer)))

307	305	`whole-p' for every presentation in the region `from'--`to' in the
308	306	string or buffer `object'."
309	307	(cl-labels ((handle-presentation (presentation point)
310		(multiple-value-bind (start end whole-p)
	308	(cl-multiple-value-bind (start end whole-p)
311	309	(slime-presentation-bounds point presentation object)
312	310	(funcall function presentation start end whole-p))))
313	311	;; Handle presentations active at `from'.

361	359	(let ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
362	360	(window (if (featurep 'xemacs) (event-window event) (caadr event))))
363	361	(with-current-buffer (window-buffer window)
364		(multiple-value-bind (presentation start end)
	362	(cl-multiple-value-bind (presentation start end)
365	363	(slime-presentation-around-point point)
366	364	(unless presentation
367	365	(error "No presentation at click"))
368		(values presentation start end (current-buffer))))))
	366	(cl-values presentation start end (current-buffer))))))
369	367
370	368	(defun slime-check-presentation (from to buffer presentation)
371	369	(unless (slime-eval `(cl:nth-value 1 (swank:lookup-presented-object

375	373
376	374	(defun slime-copy-or-inspect-presentation-at-mouse (event)
377	375	(interactive "e") ; no "@" -- we don't want to select the clicked-at window
378		(multiple-value-bind (presentation start end buffer)
	376	(cl-multiple-value-bind (presentation start end buffer)
379	377	(slime-presentation-around-click event)
380	378	(slime-check-presentation start end buffer presentation)
381	379	(if (with-current-buffer buffer

392	390
393	391	(defun slime-inspect-presentation-at-mouse (event)
394	392	(interactive "e")
395		(multiple-value-bind (presentation start end buffer)
	393	(cl-multiple-value-bind (presentation start end buffer)
396	394	(slime-presentation-around-click event)
397	395	(slime-inspect-presentation presentation start end buffer)))
398	396
399	397	(defun slime-inspect-presentation-at-point (point)
400	398	(interactive "d")
401		(multiple-value-bind (presentation start end)
	399	(cl-multiple-value-bind (presentation start end)
402	400	(slime-presentation-around-or-before-point-or-error point)
403	401	(slime-inspect-presentation presentation start end (current-buffer))))
404	402

418	416
419	417	(defun slime-M-.-presentation-at-mouse (event)
420	418	(interactive "e")
421		(multiple-value-bind (presentation start end buffer)
	419	(cl-multiple-value-bind (presentation start end buffer)
422	420	(slime-presentation-around-click event)
423	421	(slime-M-.-presentation presentation start end buffer)))
424	422
425	423	(defun slime-M-.-presentation-at-point (point)
426	424	(interactive "d")
427		(multiple-value-bind (presentation start end)
	425	(cl-multiple-value-bind (presentation start end)
428	426	(slime-presentation-around-or-before-point-or-error point)
429	427	(slime-M-.-presentation presentation start end (current-buffer))))
430	428
431	429	(defun slime-edit-presentation (name &optional where)
432	430	(if (or current-prefix-arg (not (equal (slime-symbol-at-point) name)))
433	431	nil ; NAME came from user explicitly, so decline.
434		(multiple-value-bind (presentation start end whole-p)
	432	(cl-multiple-value-bind (presentation start end whole-p)
435	433	(slime-presentation-around-or-before-point (point))
436	434	(when presentation
437	435	(slime-M-.-presentation presentation start end (current-buffer) where)))))

460	458
461	459	(defun slime-copy-presentation-at-mouse-to-repl (event)
462	460	(interactive "e")
463		(multiple-value-bind (presentation start end buffer)
	461	(cl-multiple-value-bind (presentation start end buffer)
464	462	(slime-presentation-around-click event)
465	463	(slime-copy-presentation-to-repl presentation start end buffer)))
466	464
467	465	(defun slime-copy-presentation-at-point-to-repl (point)
468	466	(interactive "d")
469		(multiple-value-bind (presentation start end)
	467	(cl-multiple-value-bind (presentation start end)
470	468	(slime-presentation-around-or-before-point-or-error point)
471	469	(slime-copy-presentation-to-repl presentation start end (current-buffer))))
472	470
473	471	(defun slime-copy-presentation-at-mouse-to-point (event)
474	472	(interactive "e")
475		(multiple-value-bind (presentation start end buffer)
	473	(cl-multiple-value-bind (presentation start end buffer)
476	474	(slime-presentation-around-click event)
477	475	(let ((presentation-text
478	476	(with-current-buffer buffer

494	492
495	493	(defun slime-copy-presentation-at-mouse-to-kill-ring (event)
496	494	(interactive "e")
497		(multiple-value-bind (presentation start end buffer)
	495	(cl-multiple-value-bind (presentation start end buffer)
498	496	(slime-presentation-around-click event)
499	497	(slime-copy-presentation-to-kill-ring presentation start end buffer)))
500	498
501	499	(defun slime-copy-presentation-at-point-to-kill-ring (point)
502	500	(interactive "d")
503		(multiple-value-bind (presentation start end)
	501	(cl-multiple-value-bind (presentation start end)
504	502	(slime-presentation-around-or-before-point-or-error point)
505	503	(slime-copy-presentation-to-kill-ring presentation start end (current-buffer))))
506	504

511	509
512	510	(defun slime-describe-presentation-at-mouse (event)
513	511	(interactive "@e")
514		(multiple-value-bind (presentation) (slime-presentation-around-click event)
	512	(cl-multiple-value-bind (presentation) (slime-presentation-around-click event)
515	513	(slime-describe-presentation presentation)))
516	514
517	515	(defun slime-describe-presentation-at-point (point)
518	516	(interactive "d")
519		(multiple-value-bind (presentation)
	517	(cl-multiple-value-bind (presentation)
520	518	(slime-presentation-around-or-before-point-or-error point)
521	519	(slime-describe-presentation presentation)))
522	520

528	526
529	527	(defun slime-pretty-print-presentation-at-mouse (event)
530	528	(interactive "@e")
531		(multiple-value-bind (presentation) (slime-presentation-around-click event)
	529	(cl-multiple-value-bind (presentation) (slime-presentation-around-click event)
532	530	(slime-pretty-print-presentation presentation)))
533	531
534	532	(defun slime-pretty-print-presentation-at-point (point)
535	533	(interactive "d")
536		(multiple-value-bind (presentation)
	534	(cl-multiple-value-bind (presentation)
537	535	(slime-presentation-around-or-before-point-or-error point)
538	536	(slime-pretty-print-presentation presentation)))
539	537
540	538	(defun slime-mark-presentation (point)
541	539	(interactive "d")
542		(multiple-value-bind (presentation start end)
	540	(cl-multiple-value-bind (presentation start end)
543	541	(slime-presentation-around-or-before-point-or-error point)
544	542	(goto-char start)
545	543	(push-mark end nil t)))

559	557	(interactive "p")
560	558	(unless arg (setq arg 1))
561	559	(cond
562		((plusp arg)
	560	((cl-plusp arg)
563	561	(dotimes (i arg)
564	562	;; First skip outside the current surrounding presentation (if any)
565		(multiple-value-bind (presentation start end)
	563	(cl-multiple-value-bind (presentation start end)
566	564	(slime-presentation-around-point (point))
567	565	(when presentation
568	566	(goto-char end)))
569	567	(let ((p (next-single-property-change (point) 'slime-repl-presentation)))
570	568	(unless p
571	569	(error "No next presentation"))
572		(multiple-value-bind (presentation start end)
	570	(cl-multiple-value-bind (presentation start end)
573	571	(slime-presentation-around-or-before-point-or-error p)
574	572	(goto-char start)))))
575		((minusp arg)
	573	((cl-minusp arg)
576	574	(dotimes (i (- arg))
577	575	;; First skip outside the current surrounding presentation (if any)
578		(multiple-value-bind (presentation start end)
	576	(cl-multiple-value-bind (presentation start end)
579	577	(slime-presentation-around-point (point))
580	578	(when presentation
581	579	(goto-char start)))
582	580	(let ((p (previous-single-property-change (point) 'slime-repl-presentation)))
583	581	(unless p
584	582	(error "No previous presentation"))
585		(multiple-value-bind (presentation start end)
	583	(cl-multiple-value-bind (presentation start end)
586	584	(slime-presentation-around-or-before-point-or-error p)
587	585	(goto-char start)))))))
588	586

609	607	(let ((sym (cl-gensym)))
610	608	(setf (gethash sym choice-to-lambda) f)
611	609	sym)))
612		(etypecase choices
	610	(cl-etypecase choices
613	611	(list
614	612	`(,(format "Presentation %s" (truncate-string-to-width
615	613	(slime-presentation-text presentation)

626	624	,@(let ((nchoice 0))
627	625	(mapcar
628	626	(lambda (choice)
629		(incf nchoice)
	627	(cl-incf nchoice)
630	628	(cons choice
631	629	(savel `(lambda ()
632	630	(interactive)

648	646	(window (if (featurep 'xemacs) (event-window event) (caadr event)))
649	647	(buffer (window-buffer window))
650	648	(choice-to-lambda (make-hash-table)))
651		(multiple-value-bind (presentation from to)
	649	(cl-multiple-value-bind (presentation from to)
652	650	(with-current-buffer buffer
653	651	(slime-presentation-around-point point))
654	652	(unless presentation

663	661	"Return a string that contains a CL s-expression accessing
664	662	the presented object."
665	663	(let ((id (slime-presentation-id presentation)))
666		(etypecase id
	664	(cl-etypecase id
667	665	(number
668	666	;; Make sure it works even if read-base is not 10.
669	667	(format "(swank:lookup-presented-object-or-lose %d.)" id))

680	678	(let ((pos (slime-property-position 'slime-repl-presentation str-props)))
681	679	(if (null pos)
682	680	str-no-props
683		(multiple-value-bind (presentation start-pos end-pos whole-p)
	681	(cl-multiple-value-bind (presentation start-pos end-pos whole-p)
684	682	(slime-presentation-around-point pos str-props)
685	683	(if (not presentation)
686	684	str-no-props

697	695	"Resend the old REPL output at point.
698	696	If replace it non-nil the current input is replaced with the old
699	697	output; otherwise the new input is appended."
700		(multiple-value-bind (presentation beg end)
	698	(cl-multiple-value-bind (presentation beg end)
701	699	(slime-presentation-around-or-before-point (point))
702	700	(slime-check-presentation beg end (current-buffer) presentation)
703	701	(let ((old-output (buffer-substring beg end))) ;;keep properties

732	730	(define-key slime-prefix-map "\C-v" slime-presentation-command-map))
733	731
734	732	(defun slime-presentation-around-or-before-point-p ()
735		(multiple-value-bind (presentation beg end)
	733	(cl-multiple-value-bind (presentation beg end)
736	734	(slime-presentation-around-or-before-point (point))
737	735	presentation))
738	736

793	791	(slime-repl-show-maximum-output)))
794	792
795	793	(defun slime-presentation-write (string &optional target)
796		(case target
	794	(cl-case target
797	795	((nil) ; Regular process output
798	796	(slime-repl-emit string))
799	797	(:repl-result

825	823	(setq bridge-destination-insert nil)
826	824	(setq bridge-source-insert nil)
827	825	(setq bridge-handlers
828		(list* '("<" . slime-mark-presentation-start-handler)
829		'(">" . slime-mark-presentation-end-handler)
830		bridge-handlers)))
	826	(cl-list* '("<" . slime-mark-presentation-start-handler)
	827	'(">" . slime-mark-presentation-end-handler)
	828	bridge-handlers)))
831	829
832	830	(defun slime-clear-presentations ()
833	831	"Forget all objects associated to SLIME presentations.

+27

-29

contrib/slime-repl.el less more

16	16	(require 'slime)
17	17	(require 'slime-parse)
18	18	(require 'cl-lib)
19		(eval-when-compile (require 'cl)) ; slime-def-connection-var, which
20		; expands to defsetf not in cl-lib
21	19
22	20	(define-slime-contrib slime-repl
23	21	"Read-Eval-Print Loop written in Emacs Lisp.

192	190
193	191	(defun slime-output-filter (process string)
194	192	(with-current-buffer (process-buffer process)
195		(when (and (plusp (length string))
	193	(when (and (cl-plusp (length string))
196	194	(eq (process-status slime-buffer-connection) 'open))
197	195	(slime-write-string string))))
198	196

253	251	(funcall slime-write-string-function string target))
254	252
255	253	(defun slime-repl-write-string (string &optional target)
256		(case target
	254	(cl-case target
257	255	((nil) (slime-repl-emit string))
258	256	(:repl-result (slime-repl-emit-result string t))
259	257	(t (slime-repl-emit-to-target string target))))

324	322	(set-marker marker (point)))))))
325	323
326	324	(defun slime-repl-output-target-marker (target)
327		(case target
	325	(cl-case target
328	326	((nil)
329	327	(with-current-buffer (slime-output-buffer)
330	328	slime-output-end))

426	424
427	425	(defvar slime-repl-mode-map
428	426	(let ((map (make-sparse-keymap)))
429		(set-keymap-parent map lisp-mode-map)
	427	(set-keymap-parent map (copy-keymap lisp-mode-map))
430	428	map))
431	429
432	430	(slime-define-keys slime-prefix-map

480	478	(define-minor-mode slime-repl-map-mode
481	479	"Minor mode which makes slime-repl-mode-map available.
482	480	\\{slime-repl-mode-map}"
483		nil
484		nil
485		slime-repl-mode-map)
	481	:init-value nil
	482	:lighter nil
	483	:keymap slime-repl-mode-map)
486	484
487	485	(defun slime-repl-mode ()
488	486	"Major mode for interacting with a superior Lisp.

771	769	(add-text-properties slime-repl-input-start-mark
772	770	(point)
773	771	`(slime-repl-old-input
774		,(incf slime-repl-old-input-counter))))
	772	,(cl-incf slime-repl-old-input-counter))))
775	773	(let ((overlay (make-overlay slime-repl-input-start-mark end)))
776	774	;; These properties are on an overlay so that they won't be taken
777	775	;; by kill/yank.

787	785	If replace is non-nil the current input is replaced with the old
788	786	input; otherwise the new input is appended. The old input has the
789	787	text property `slime-repl-old-input'."
790		(multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-input)
	788	(cl-multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-input)
791	789	(let ((old-input (buffer-substring beg end)) ;;preserve
792	790	;;properties, they will be removed later
793	791	(offset (- (point) beg)))

931	929	(with-current-buffer (slime-output-buffer)
932	930	(let ((previouse-point (- (point) slime-repl-input-start-mark))
933	931	(previous-prompt (slime-lisp-package-prompt-string)))
934		(destructuring-bind (name prompt-string)
	932	(cl-destructuring-bind (name prompt-string)
935	933	(slime-repl-shortcut-eval `(swank:set-package ,package))
936	934	(setf (slime-lisp-package) name)
937	935	(setf slime-buffer-package name)
938	936	(unless (equal previous-prompt prompt-string)
939	937	(setf (slime-lisp-package-prompt-string) prompt-string)
940	938	(slime-repl-insert-prompt))
941		(when (plusp previouse-point)
	939	(when (cl-plusp previouse-point)
942	940	(goto-char (+ previouse-point slime-repl-input-start-mark)))))))
943	941
944	942

1016	1014	Return -1 resp. the length of the history if no item matches.
1017	1015	If EXCLUDE-STRING is specified then it's excluded from the search."
1018	1016	;; Loop through the history list looking for a matching line
1019		(let* ((step (ecase direction
	1017	(let* ((step (cl-ecase direction
1020	1018	(forward -1)
1021	1019	(backward 1)))
1022	1020	(history slime-repl-input-history)
1023	1021	(len (length history)))
1024		(loop for pos = (+ start-pos step) then (+ pos step)
1025		if (< pos 0) return -1
1026		if (<= len pos) return len
1027		for history-item = (nth pos history)
1028		if (and (string-match regexp history-item)
1029		(not (equal history-item exclude-string)))
1030		return pos)))
	1022	(cl-loop for pos = (+ start-pos step) then (+ pos step)
	1023	if (< pos 0) return -1
	1024	if (<= len pos) return len
	1025	for history-item = (nth pos history)
	1026	if (and (string-match regexp history-item)
	1027	(not (equal history-item exclude-string)))
	1028	return pos)))
1031	1029
1032	1030	(defun slime-repl-previous-input ()
1033	1031	"Cycle backwards through input history.

1224	1222	(define-minor-mode slime-repl-read-mode
1225	1223	"Mode to read input from Emacs
1226	1224	\\{slime-repl-read-mode-map}"
1227		nil
1228		"[read]")
	1225	:init-value nil
	1226	:lighter "[read]")
1229	1227
1230	1228	(make-variable-buffer-local
1231	1229	(defvar slime-read-string-threads nil))

1290	1288	(call-interactively handler))))))
1291	1289
1292	1290	(defun slime-list-all-repl-shortcuts ()
1293		(loop for shortcut in slime-repl-shortcut-table
1294		append (slime-repl-shortcut.names shortcut)))
	1291	(cl-loop for shortcut in slime-repl-shortcut-table
	1292	append (slime-repl-shortcut.names shortcut)))
1295	1293
1296	1294	(defun slime-lookup-shortcut (name)
1297	1295	(cl-find-if (lambda (s) (member name (slime-repl-shortcut.names s)))

1310	1308	,(when elisp-name
1311	1309	`(defun ,elisp-name ()
1312	1310	(interactive)
1313		(call-interactively ,(second (assoc :handler options)))))
	1311	(call-interactively ,(cl-second (assoc :handler options)))))
1314	1312	(let ((new-shortcut (make-slime-repl-shortcut
1315	1313	:symbol ',elisp-name
1316	1314	:names (list ,@names)

1516	1514	(let ((buffer (get-buffer-create (slime-buffer-name :trace))))
1517	1515	(with-current-buffer buffer
1518	1516	(let ((marker (copy-marker (buffer-size)))
1519		(target (incf slime-last-output-target-id)))
	1517	(target (cl-incf slime-last-output-target-id)))
1520	1518	(puthash target marker slime-output-target-to-marker)
1521	1519	(slime-eval `(swank-repl:redirect-trace-output ,target))))
1522	1520	;; Note: We would like the entries in

1716	1714	(error "Can't find suitable coding-system"))))
1717	1715
1718	1716	(defun slime-repl-connected-hook-function ()
1719		(destructuring-bind (package prompt)
	1717	(cl-destructuring-bind (package prompt)
1720	1718	(let ((slime-current-thread t)
1721	1719	(cs (slime-repl-choose-coding-system)))
1722	1720	(slime-eval `(swank-repl:create-repl nil :coding-system ,cs)))

1731	1729	(slime-write-string output target)
1732	1730	t)
1733	1731	((:read-string thread tag)
1734		(assert thread)
	1732	(cl-assert thread)
1735	1733	(slime-repl-read-string thread tag)
1736	1734	t)
1737	1735	((:read-aborted thread tag)

+12

-0

contrib/slime-sbcl-exts.el less more

30	30	(browse-url (format "http://bugs.launchpad.net/sbcl/+bug/%s"
31	31	(substring bug 1))))
32	32
	33	(defun slime-indent-define-vop (path state indent-point sexp-column normal-indent)
	34	(if (save-excursion
	35	(backward-sexp)
	36	(ignore-errors (down-list))
	37	(looking-at ":generator"))
	38	(+ sexp-column 2)
	39	(lisp-indent-259 '((&whole 4) &body)
	40	path state indent-point sexp-column normal-indent)))
	41
	42	(put 'define-vop 'common-lisp-indent-function
	43	'slime-indent-define-vop)
	44
33	45	(provide 'slime-sbcl-exts)

+7

-6

contrib/slime-sprof.el less more

	0	;;;; -- lexical-binding: t --
	1
0	2	(require 'slime)
1	3	(require 'cl-lib)
2		(eval-when-compile (require 'cl)) ; lexical-let*
3	4
4	5	(define-slime-contrib slime-sprof
5	6	"Integration with SBCL's sb-sprof."

138	139	(delete-char 1)))))
139	140
140	141	(defun slime-sprof-browser-expand ()
141		(lexical-let* ((buffer (current-buffer))
142		(point (point))
143		(index (get-text-property point 'profile-index)))
	142	(let* ((buffer (current-buffer))
	143	(point (point))
	144	(index (get-text-property point 'profile-index)))
144	145	(slime-eval-async `(swank:swank-sprof-expand-node ,index)
145	146	(lambda (data)
146	147	(with-current-buffer buffer
147		(save-excursion
148		(destructuring-bind (&key callers calls)
	148	(save-excursion
	149	(cl-destructuring-bind (&key callers calls)
149	150	data
150	151	(slime-sprof-browser-add-expansion callers
151	152	"Callers"

+4

-2

contrib/slime-trace-dialog.el less more

134	134
135	135	(define-minor-mode slime-trace-dialog-hide-details-mode
136	136	"Hide details in `slime-trace-dialog-mode'"
137		nil " Brief"
	137	:init-value nil
	138	:lighter " Brief"
138	139	:group 'slime-trace-dialog
139	140	(unless (derived-mode-p 'slime-trace-dialog-mode)
140	141	(error "Not a SLIME Trace Dialog buffer"))

142	143
143	144	(define-minor-mode slime-trace-dialog-autofollow-mode
144	145	"Automatically open buffers with trace details from `slime-trace-dialog-mode'"
145		nil " Autofollow"
	146	:init-value nil
	147	:lighter " Autofollow"
146	148	:group 'slime-trace-dialog
147	149	(unless (derived-mode-p 'slime-trace-dialog-mode)
148	150	(error "Not a SLIME Trace Dialog buffer")))

+6

-5

contrib/slime-tramp.el less more

	0	;;;; -- lexical-binding: t --
	1
0	2	(require 'slime)
1	3	(require 'tramp)
2		(eval-when-compile (require 'cl)) ; lexical-let
3	4
4	5	(define-slime-contrib slime-tramp
5	6	"Filename translations for tramp"

95	96	should login with.
96	97	The functions created here expect your tramp-default-method or
97	98	tramp-default-method-alist to be setup correctly."
98		(lexical-let ((remote-host (or remote-host machine-instance))
99		(username (or username (user-login-name))))
	99	(let ((remote-host (or remote-host machine-instance))
	100	(username (or username (user-login-name))))
100	101	(list (concat "^" machine-instance "$")
101	102	(lambda (emacs-filename)
102	103	(tramp-file-name-localname

109	110
110	111	(defun slime-tramp-to-lisp-filename (filename)
111	112	(funcall (if (slime-connected-p)
112		(first (slime-find-filename-translators (slime-machine-instance)))
	113	(cl-first (slime-find-filename-translators (slime-machine-instance)))
113	114	'identity)
114	115	(expand-file-name filename)))
115	116
116	117	(defun slime-tramp-from-lisp-filename (filename)
117		(funcall (second (slime-find-filename-translators (slime-machine-instance)))
	118	(funcall (cl-second (slime-find-filename-translators (slime-machine-instance)))
118	119	filename))
119	120
120	121	(provide 'slime-tramp)

+5

-1

contrib/swank-fancy-inspector.lisp less more

726	726	(defmethod emacs-inspect ((package package))
727	727	(let ((package-name (package-name package))
728	728	(package-nicknames (package-nicknames package))
	729	(local-nicknames (package-local-nicknames package))
729	730	(package-use-list (package-use-list package))
730	731	(package-used-by-list (package-used-by-list package))
731	732	(shadowed-symbols (package-shadowing-symbols package))

762	763	`("" ;; dummy to preserve indentation.
763	764	"Name: " (:value ,package-name) (:newline)
764	765
765		"Nick names: " ,@(common-seperated-spec package-nicknames) (:newline)
	766	"Nicknames: " ,@(common-seperated-spec package-nicknames) (:newline)
	767
	768	,@(when local-nicknames
	769	`("Package-local nicknames: " (:value ,local-nicknames) (:newline)))
766	770
767	771	,@(when (documentation package t)
768	772	`("Documentation:" (:newline)

+12

-12

contrib/swank-sbcl-exts.lisp less more

23	23	;; The arglist of INST is (instruction ...INSTR-ARGLIST...).
24	24	(push 'sb-assem::instruction (arglist.required-args decoded-arglist))
25	25	(values decoded-arglist
26		(list instr-name)
	26	(list (string-downcase instr-name))
27	27	t))))
28	28	(if (null argument-forms)
29	29	(call-next-method)

34	34	(arglist-dummy
35	35	(string-upcase (arglist-dummy.string-representation instruction)))
36	36	(symbol
37		(string-downcase instruction))))
	37	(string-upcase instruction))))
38	38	(instr-fn
39		#+#.(swank/backend:with-symbol 'op-encoder-name 'sb-assem)
40		(or (sb-assem::op-encoder-name instr-name)
41		(sb-assem::op-encoder-name (string-upcase instr-name)))
42		#+#.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem)
43		(sb-assem::inst-emitter-symbol instr-name)
44	39	#+(and
45		(not #.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem))
46		#.(swank/backend:with-symbol 'assem-instructions 'sb-assem))
47		(gethash instr-name sb-assem:assem-instructions)))
	40	#.(swank/backend:with-symbol 'inst-encoder 'sb-assem)
	41	#.(swank/backend:with-symbol 'backend-instruction-set-package 'sb-assem))
	42	(or (gethash (find-symbol instr-name sb-assem::backend-instruction-set-package)
	43	sb-assem::inst-encoder)
	44	(find-symbol (format nil "M:~A" instr-name)
	45	sb-assem::backend-instruction-set-package))))
	46	(when (consp instr-fn)
	47	(setf instr-fn (car instr-fn)))
48	48	(cond ((functionp instr-fn)
49	49	(with-available-arglist (arglist) (arglist instr-fn)
50		(decode-instruction-arglist instr-name arglist)))
	50	(decode-instruction-arglist instr-name (cdr arglist))))
51	51	((fboundp instr-fn)
52	52	(with-available-arglist (arglist) (arglist instr-fn)
53	53	;; SB-ASSEM:INST invokes a symbolic INSTR-FN with

56	56	(if (or (get instr-fn :macro)
57	57	(macro-function instr-fn))
58	58	arglist
59		(cddr arglist)))))
	59	(cdr arglist)))))
60	60	(t
61	61	(call-next-method))))))))
62	62

+1

-4

doc/slime.texi less more

2010	2010	after the first one (default: @code{NIL}). For ``long-running'' lisp processes
2011	2011	to which you want to be able to connect from time to time,
2012	2012	specify @code{:dont-close t}
2013		@item :CODING-SYSTEM
2014		String designating the encoding to be used to communicate between the
2015		Emacs and Lisp.
2016	2013	@end table
2017	2014
2018	2015	So the more complete example will be
2019	2016	@example
2020		(swank:create-server :port 4005 :dont-close t :coding-system "utf-8-unix")
	2017	(swank:create-server :port 4005 :dont-close t)
2021	2018	@end example
2022	2019	On the emacs side you will use something like
2023	2020	@example

+3

-2

lib/hyperspec.el less more

136	136	(forward-line)))
137	137
138	138	(defun common-lisp-hyperspec--parse-map-file (file)
139		(with-current-buffer (find-file-noselect file)
	139	(with-temp-buffer
	140	(insert-file-contents file)
140	141	(goto-char (point-min))
141	142	(let ((result '()))
142	143	(while (< (point) (point-max))

1315	1316	"Function that creates a URL for a glossary term.")
1316	1317
1317	1318	(define-obsolete-variable-alias 'common-lisp-glossary-fun
1318		'common-lisp-hyperspec-glossary-function)
	1319	'common-lisp-hyperspec-glossary-function "2015-12-29")
1319	1320
1320	1321	(defvar common-lisp-hyperspec--glossary-terms (make-hash-table :test #'equal)
1321	1322	"Collection of glossary terms and relative URLs.")

+2

-1

lib/macrostep.el less more

496	496	quit and return to normal editing.
497	497
498	498	\\{macrostep-keymap}"
499		nil " Macro-Stepper"
	499	:init-value nil
	500	:lighter " Macro-Stepper"
500	501	:keymap macrostep-keymap
501	502	:group macrostep
502	503	(if macrostep-mode

+58

-28

slime-tests.el less more

0		;;; slime-tests.el --- Automated tests for slime.el
	0	;;; slime-tests.el --- Automated tests for slime.el -- lexical-binding: t --
1	1	;;
2	2	;;;; License
3	3	;; Copyright (C) 2003 Eric Marsden, Luke Gorrie, Helmut Eller

29	29	(require 'ert "lib/ert" t) ;; look for bundled version for Emacs 23
30	30	(require 'cl-lib)
31	31	(require 'bytecomp) ; byte-compile-current-file
32		(eval-when-compile
33		(require 'cl)) ; lexical-let
34	32
35	33	(defun slime-shuffle-list (list)
36	34	(let* ((len (length list))

53	51	(slime-background-message-function #'ignore))
54	52	(slime)
55	53	;; Block until we are up and running.
56		(lexical-let (timed-out)
	54	(let (timed-out)
57	55	(run-with-timer timeout nil
58	56	(lambda () (setq timed-out t)))
59	57	(while (not (slime-connected-p))

105	103	(if (not (featurep 'ert))
106	104	(warn "No ert.el found: not defining test %s"
107	105	name)
108		(let* ((docstring (and (stringp (second args))
109		(second args)))
	106	(let* ((docstring (and (stringp (cl-second args))
	107	(cl-second args)))
110	108	(args (if docstring
111	109	(cddr args)
112	110	(cdr args)))

115	113	:tags ',tags
116	114	,@args))))
117	115
118		(defun slime-test-ert-test-for (name input i doc body fails-for style fname)
	116	(defun slime-test-ert-test-for (name input i doc _body fails-for style fname)
119	117	`(define-slime-ert-test
120	118	,(intern (format "%s-%d" name i)) ()
121	119	,(format "For input %s, %s" (truncate-string-to-width

203	201	(while (not (funcall predicate))
204	202	(let ((now (current-time)))
205	203	(message "waiting for condition: %s [%s.%06d]" name
206		(format-time-string "%H:%M:%S" now) (third now)))
	204	(format-time-string "%H:%M:%S" now) (cl-third now)))
207	205	(cond ((time-less-p end (current-time))
208	206	(error "Timeout waiting for condition: %S" name))
209	207	(t

271	269
272	270	(def-slime-test symbol-at-point.3 (sym)
273	271	"fancy symbol-name with leading ,"
274		(remove-if (lambda (s) (eq (aref (car s) 0) ?@)) slime-test-symbols)
	272	(cl-remove-if (lambda (s) (eq (aref (car s) 0) ?@)) slime-test-symbols)
275	273	(slime-check-symbol-at-point "," sym ""))
276	274
277	275	(def-slime-test symbol-at-point.4 (sym)

740	738	;;(encode-coding-string (string #x304a #x306f #x3088 #x3046)
741	739	;; 'utf-8)
742	740	(string (decode-coding-string bytes 'utf-8-unix)))
743		(assert (equal bytes (encode-coding-string string 'utf-8-unix)))
	741	(cl-assert (equal bytes (encode-coding-string string 'utf-8-unix)))
744	742	(list (concat "(defun cl-user::foo () \"" string "\")")
745	743	string)))
746	744	(slime-eval `(cl:eval (cl:read-from-string ,input)))

784	782	(def-slime-test async-eval-debugging (depth)
785	783	"Test recursive debugging of asynchronous evaluation requests."
786	784	'((1) (2) (3))
787		(lexical-let ((depth depth)
788		(debug-hook-max-depth 0))
	785	(let ((depth depth)
	786	(debug-hook-max-depth 0))
789	787	(let ((debug-hook
790	788	(lambda ()
791	789	(with-current-buffer (sldb-get-default-buffer)

808	806	"Test recursive debugging and returning to lower SLDB levels."
809	807	'((2 1) (4 2))
810	808	(slime-check-top-level)
811		(lexical-let ((level2 level2)
812		(level1 level1)
813		(state 'enter)
814		(max-depth 0))
	809	(let ((level2 level2)
	810	(level1 level1)
	811	(state 'enter)
	812	(max-depth 0))
815	813	(let ((debug-hook
816	814	(lambda ()
817	815	(with-current-buffer (sldb-get-default-buffer)
818	816	(setq max-depth (max sldb-level max-depth))
819		(ecase state
	817	(cl-ecase state
820	818	(enter
821	819	(cond ((= sldb-level level2)
822	820	(setq state 'leave)

886	884	"Test interactive eval and continuing from the debugger."
887	885	'(())
888	886	(slime-check-top-level)
889		(lexical-let ((done nil))
	887	(let ((done nil))
890	888	(let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
891	889	(slime-interactive-eval
892	890	"(progn\

909	907	("~a" "(let ((x (cons (make-string 100000 :initial-element #\\X) nil)))\
910	908	(setf (cdr x) x))"))
911	909	(slime-check-top-level)
912		(lexical-let ((done nil))
	910	(let ((done nil))
913	911	(let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
914	912	(slime-interactive-eval
915	913	(format "(with-standard-io-syntax (cerror \"foo\" \"%s\" %s) (+ 1 2))"

1081	1079	buffer-content
1082	1080	(substring-no-properties (buffer-string)))))
1083	1081
	1082	(def-slime-test indentation.2 (buffer-content point-markers)
	1083	"Check indentation update to work correctly."
	1084	'(("
	1085	\(in-package :swank)
	1086
	1087	\(defmacro lolipop (&body body)
	1088	`(progn ,@body))
	1089
	1090	\(defmacro lolipop (&rest body)
	1091	`(progn ,@body))
	1092
	1093	\(lolipop 1
	1094	2
	1095	23)
	1096	"
	1097	("23")))
	1098	(with-temp-buffer
	1099	(lisp-mode)
	1100	(slime-lisp-mode-hook)
	1101	(insert buffer-content)
	1102	(slime-compile-region (point-min) (point-max))
	1103	(slime-sync-to-top-level 3)
	1104	(slime-update-indentation)
	1105	(slime-sync-to-top-level 3)
	1106	(dolist (marker point-markers)
	1107	(search-backward marker)
	1108	(beginning-of-defun)
	1109	(indent-sexp))
	1110	(slime-test-expect "Correct buffer content"
	1111	buffer-content
	1112	(substring-no-properties (buffer-string)))))
	1113
1084	1114	(def-slime-test break
1085	1115	(times exp)
1086	1116	"Test whether BREAK invokes SLDB."

1278	1308	(with-current-buffer (process-buffer p)
1279	1309	(erase-buffer))
1280	1310	(delete-process c)
1281		(assert (equal (process-status c) 'closed) nil "Connection not closed")
	1311	(cl-assert (equal (process-status c) 'closed) nil "Connection not closed")
1282	1312	(accept-process-output nil 0.1)
1283		(assert (equal (process-status p) 'run) nil "Subprocess not running")
	1313	(cl-assert (equal (process-status p) 'run) nil "Subprocess not running")
1284	1314	(with-current-buffer (process-buffer p)
1285		(assert (< (buffer-size) 500) nil "Unusual output"))
	1315	(cl-assert (< (buffer-size) 500) nil "Unusual output"))
1286	1316	(slime-inferior-connect p (slime-inferior-lisp-args p))
1287		(lexical-let ((hook nil) (p p))
	1317	(let ((hook nil) (p p))
1288	1318	(setq hook (lambda ()
1289	1319	(slime-test-expect
1290	1320	"We are connected again" p (slime-inferior-process))

1304	1334	(let ((success nil)
1305	1335	(test-file (make-temp-file "slime-recipe-" nil ".el"))
1306	1336	(test-forms
1307		`((require 'cl)
1308		(labels
	1337	`((require 'cl-lib)
	1338	(cl-labels
1309	1339	((die
1310	1340	(reason &optional more)
1311	1341	(princ reason)

1370	1400	(setq slime-contribs '(slime-fancy)))
1371	1401	:takeoff `((call-interactively 'slime))
1372	1402	:landing `((unless (and (featurep 'slime-repl)
1373		(find 'swank-repl slime-required-modules))
	1403	(cl-find 'swank-repl slime-required-modules))
1374	1404	(die "slime-repl not loaded properly"))
1375	1405	(with-current-buffer (slime-repl-buffer)
1376	1406	(unless (and (string-match "^; +SLIME" (buffer-string))

1388	1418	(slime-setup '(slime-fancy)))
1389	1419	:takeoff `((call-interactively 'slime))
1390	1420	:landing `((unless (and (featurep 'slime-repl)
1391		(find 'swank-repl slime-required-modules))
	1421	(cl-find 'swank-repl slime-required-modules))
1392	1422	(die "slime-repl not loaded properly"))
1393	1423	(with-current-buffer (slime-repl-buffer)
1394	1424	(unless (and (string-match "^; +SLIME" (buffer-string))

1410	1440	(die "Expected SLIME to be fully loaded by now")))))
1411	1441
1412	1442	(defun slime-test-eval-now (string)
1413		(second (slime-eval `(swank:eval-and-grab-output ,string))))
	1443	(cl-second (slime-eval `(swank:eval-and-grab-output ,string))))
1414	1444
1415	1445	(def-slime-test (slime-recompile-all-xrefs (:fails-for "cmucl")) ()
1416	1446	"Test recompilation of all references within an xref buffer."

+38

-38

slime.el less more

2	2	;; URL: https://github.com/slime/slime
3	3	;; Package-Requires: ((cl-lib "0.5") (macrostep "0.9"))
4	4	;; Keywords: languages, lisp, slime
5		;; Version: 2.26.1
	5	;; Version: 2.27
6	6
7	7	;;;; License and Commentary
8	8

62	62	;; For emacs 23, look for bundled version
63	63	(require 'cl-lib "lib/cl-lib"))
64	64
65		(eval-when-compile (require 'cl)) ; defsetf, lexical-let
66
67	65	(eval-and-compile
68	66	(if (< emacs-major-version 23)
69	67	(error "Slime requires an Emacs version of 23, or above")))

77	75	(require 'arc-mode)
78	76	(require 'etags)
79	77	(require 'compile)
	78	(require 'gv)
80	79
81	80	(eval-when-compile
82	81	(require 'apropos)

672	671	(define-minor-mode slime-editing-mode
673	672	"Minor mode which makes slime-editing-map available.
674	673	\\{slime-editing-map}"
675		nil
676		nil
677		slime-editing-map)
	674	:init-value nil
	675	:lighter nil
	676	:keymap slime-editing-map)
678	677
679	678
680	679	;;;; Framework'ey bits

858	857	(list (previous-single-char-property-change end prop) end)))
859	858
860	859	(defun slime-curry (fun &rest args)
861		"Partially apply FUN to ARGS. The result is a new function.
862		This idiom is preferred over `lexical-let'."
	860	"Partially apply FUN to ARGS. The result is a new function."
863	861	`(lambda (&rest more) (apply ',fun (append ',args more))))
864	862
865	863	(defun slime-rcurry (fun &rest args)

920	918
921	919	(define-minor-mode slime-popup-buffer-mode
922	920	"Mode for displaying read only stuff"
923		nil nil nil
	921	:init-value nil
	922	:lighter nil
	923	:keymap nil
924	924	(setq buffer-read-only t))
925	925
926	926	(add-to-list 'minor-mode-alist

1776	1776	(defun ,varname (&optional process)
1777	1777	(slime-with-connection-buffer (process) ,real-var))
1778	1778	;; Setf
1779		(defsetf ,varname (&optional process) (store)
	1779	(gv-define-setter ,varname (store &optional process)
1780	1780	`(slime-with-connection-buffer (,process)
1781	1781	(setq (\, (quote (\, real-var))) (\, store))))
1782	1782	'(\, varname))))

2039	2039	versions cannot deal with that."
2040	2040	(declare (indent 2))
2041	2041	(let ((result (cl-gensym)))
2042		`(lexical-let ,(cl-loop for var in saved-vars
2043		collect (cl-etypecase var
2044		(symbol (list var var))
2045		(cons var)))
	2042	`(let ,(cl-loop for var in saved-vars
	2043	collect (cl-etypecase var
	2044	(symbol (list var var))
	2045	(cons var)))
2046	2046	(slime-dispatch-event
2047	2047	(list :emacs-rex ,sexp ,package ,thread
2048	2048	(lambda (,result)

3635	3635	"History list of expressions read from the minibuffer.")
3636	3636
3637	3637	(defun slime-minibuffer-setup-hook ()
3638		(cons (lexical-let ((package (slime-current-package))
3639		(connection (slime-connection)))
	3638	(cons (let ((package (slime-current-package))
	3639	(connection (slime-connection)))
3640	3640	(lambda ()
3641	3641	(setq slime-buffer-package package)
3642	3642	(setq slime-buffer-connection connection)

4160	4160	in Lisp when committed with \\[slime-edit-value-commit]."
4161	4161	(interactive
4162	4162	(list (slime-read-from-minibuffer "Edit value (evaluated): "
4163		(slime-sexp-at-point))))
	4163	(slime-sexp-at-point))))
4164	4164	(slime-eval-async `(swank:value-for-editing ,form-string)
4165		(lexical-let ((form-string form-string)
4166		(package (slime-current-package)))
	4165	(let ((form-string form-string)
	4166	(package (slime-current-package)))
4167	4167	(lambda (result)
4168	4168	(slime-edit-value-callback form-string result
4169	4169	package)))))

4174	4174
4175	4175	(define-minor-mode slime-edit-value-mode
4176	4176	"Mode for editing a Lisp value."
4177		nil
4178		" Edit-Value"
4179		'(("\C-c\C-c" . slime-edit-value-commit)))
	4177	:init-value nil
	4178	:lighter " Edit-Value"
	4179	:keymap '(("\C-c\C-c" . slime-edit-value-commit)))
4180	4180
4181	4181	(defun slime-edit-value-callback (form-string current-value package)
4182	4182	(let* ((name (generate-new-buffer-name (format "Edit %s" form-string)))

4201	4201	(if (null slime-edit-form-string)
4202	4202	(error "Not editing a value.")
4203	4203	(let ((value (buffer-substring-no-properties (point-min) (point-max))))
4204		(lexical-let ((buffer (current-buffer)))
	4204	(let ((buffer (current-buffer)))
4205	4205	(slime-eval-async `(swank:commit-edited-value ,slime-edit-form-string
4206	4206	,value)
4207	4207	(lambda (_)

4857	4857
4858	4858	(define-minor-mode slime-macroexpansion-minor-mode
4859	4859	"SLIME mode for macroexpansion"
4860		nil
4861		" Macroexpand"
4862		'(("g" . slime-macroexpand-again)))
	4860	:init-value nil
	4861	:lighter " Macroexpand"
	4862	:keymap '(("g" . slime-macroexpand-again)))
4863	4863
4864	4864	(cl-macrolet ((remap (from to)
4865	4865	`(dolist (mapping

4930	4930	(interactive)
4931	4931	(let* ((bounds (or (slime-bounds-of-sexp-at-point)
4932	4932	(user-error "No sexp at point"))))
4933		(lexical-let* ((start (copy-marker (car bounds)))
4934		(end (copy-marker (cdr bounds)))
4935		(point (point))
4936		(package (slime-current-package))
4937		(buffer (current-buffer)))
	4933	(let* ((start (copy-marker (car bounds)))
	4934	(end (copy-marker (cdr bounds)))
	4935	(point (point))
	4936	(buffer (current-buffer)))
4938	4937	(slime-eval-async
4939	4938	`(,expander ,(buffer-substring-no-properties start end))
4940	4939	(lambda (expansion)

5342	5341	(dolist (window (window-list))
5343	5342	(when (window-parameter window 'sldb-last-window)
5344	5343	(set-window-parameter window 'sldb-last-window nil)))
5345		(set-window-parameter (selected-window) 'sldb-last-window t))
	5344	(set-window-parameter window 'sldb-last-window t))
5346	5345
5347	5346	(defun sldb-exit (thread _level &optional stepping)
5348	5347	"Exit from the debug level LEVEL."

6073	6072	(interactive "P")
6074	6073	(slime-eval-async
6075	6074	`(swank:frame-source-location ,(sldb-frame-number-at-point))
6076		(lexical-let ((policy (slime-compute-policy raw-prefix-arg)))
	6075	(let ((policy (slime-compute-policy raw-prefix-arg)))
6077	6076	(lambda (source-location)
6078	6077	(slime-dcase source-location
6079	6078	((:error message)

6496	6495	2. If point is on an action then call that action.
6497	6496	3. If point is on a range-button fetch and insert the range."
6498	6497	(interactive)
6499		(let ((opener (lexical-let ((point (slime-inspector-position)))
	6498	(let ((opener (let ((point (slime-inspector-position)))
6500	6499	(lambda (parts)
6501	6500	(when parts
6502	6501	(slime-open-inspector parts point)))))

6646	6645	(defun slime-inspector-reinspect ()
6647	6646	(interactive)
6648	6647	(slime-eval-async `(swank:inspector-reinspect)
6649		(lexical-let ((point (slime-inspector-position)))
	6648	(let ((point (slime-inspector-position)))
6650	6649	(lambda (parts)
6651	6650	(slime-open-inspector parts point)))))
6652	6651
6653	6652	(defun slime-inspector-toggle-verbose ()
6654	6653	(interactive)
6655	6654	(slime-eval-async `(swank:inspector-toggle-verbose)
6656		(lexical-let ((point (slime-inspector-position)))
	6655	(let ((point (slime-inspector-position)))
6657	6656	(lambda (parts)
6658	6657	(slime-open-inspector parts point)))))
6659	6658

7441	7440	(:and #'cl-every)
7442	7441	(:or #'cl-some)
7443	7442	(:not
7444		(lexical-let ((feature-expression e))
	7443	(let ((feature-expression e))
7445	7444	(lambda (f l)
7446	7445	(cond
7447	7446	((slime-length= l 0) t)

7617	7616	(defun slime--compile-hotspots ()
7618	7617	(mapc (lambda (sym)
7619	7618	(cond ((fboundp sym)
7620		(unless (byte-code-function-p (symbol-function sym))
	7619	(unless (or (byte-code-function-p (symbol-function sym))
	7620	(subrp (symbol-function sym)))
7621	7621	(slime--byte-compile sym)))
7622	7622	(t (error "%S is not fbound" sym))))
7623	7623	'(slime-alistify

+4

-3

swank/abcl.lisp less more

475	475	(backtrace start end)))
476	476
477	477	;; Don't count on JSS being loaded, but if it is then there's some more stuff we can do
478		+#+#.(swank/backend:with-symbol 'invoke-restargs 'jss)
	478	#+#.(swank/backend:with-symbol 'invoke-restargs 'jss)
479	479	(defun jss-p ()
480	480	(and (member "JSS" modules :test 'string=) (intern "INVOKE-RESTARGS" "JSS")))
481	481
482		+#+#.(swank/backend:with-symbol 'invoke-restargs 'jss)
	482	#+#.(swank/backend:with-symbol 'invoke-restargs 'jss)
483	483	(defun matches-jss-call (form)
484	484	(flet ((gensymp (s) (and (symbolp s) (null (symbol-package s))))
485	485	(invokep (s) (and (symbolp s) (eq s (jss-p)))))

1004	1004	(when (atom what)
1005	1005	(setq what (list what sym)))
1006	1006	(list (definition-specifier what)
1007		(if (ext:pathname-jar-p path2)
	1007	(if (ext:pathname-jar-p (pathname path2))
1008	1008	`(:location
1009	1009	(:zip ,@(split-string (subseq path2 (length "jar:file:")) "!/"))
1010	1010	;; pos never seems right. Use function name.

1366	1366	`(" " (:label ,(string-downcase (string name))) ": " (:value ,value) (:newline))))
1367	1367	`("No slots available for inspection."))))
1368	1368
	1369	#+#.(swank/backend:with-symbol 'get-java-field 'jss)
1369	1370	(defmethod emacs-inspect ((object sys::structure-class))
1370	1371	(let* ((name (jss::get-java-field object "name" t))
1371	1372	(def (get name 'system::structure-definition)))

+16

-1

swank/allegro.lisp less more

106	106	;;;; Misc
107	107
108	108	(defimplementation arglist (symbol)
109		(handler-case (excl:arglist symbol)
	109	(handler-case
	110	(let ((lambda-expression (ignore-errors
	111	(function-lambda-expression
	112	(symbol-function symbol)))))
	113	;; LAMBDA-EXPRESSION, if available, has the default values of
	114	;; optional and keyword arguments of compiled functions while
	115	;; EXCL:ARGLIST doesn't.
	116	(if lambda-expression
	117	(second lambda-expression)
	118	(excl:arglist symbol)))
110	119	(simple-error () :not-available)))
111	120
112	121	(defimplementation macroexpand-all (form &optional env)

1083	1092
1084	1093	(defimplementation wrapped-p (spec indicator)
1085	1094	(getf (excl:fwrap-order (process-fspec-for-allegro spec)) indicator))
	1095
	1096	;;;; Packages
	1097
	1098	#+package-local-nicknames
	1099	(defimplementation package-local-nicknames (package)
	1100	(excl:package-local-nicknames package))

+6

-0

swank/ccl.lisp less more

588	588	(method (ccl:name-of object))
589	589	(t (list (ccl:definition-type-name type) (ccl:name-of object)))))
590	590
	591	;;; Packages
	592
	593	#+package-local-nicknames
	594	(defimplementation package-local-nicknames (package)
	595	(ccl:package-local-nicknames package))
	596
591	597	;;; Utilities
592	598
593	599	(defimplementation describe-symbol-for-emacs (symbol)

+33

-19

swank/clasp.lisp less more

62	62	:type :stream
63	63	:protocol :tcp)))
64	64	(setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
65		(sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
	65	(handler-bind
	66	((SB-BSD-SOCKETS:ADDRESS-IN-USE-ERROR (lambda (err)
	67	(declare (ignore err))
	68	(invoke-restart 'use-value))))
	69	(sb-bsd-sockets:socket-bind socket (resolve-hostname host) port))
66	70	(sb-bsd-sockets:socket-listen socket (or backlog 5))
67	71	socket))
68	72

165	169	(namestring (ext:getcwd)))
166	170
167	171	(defimplementation quit-lisp ()
168		(core:quit))
	172	(sys:quit))
169	173
170	174
171	175

223	227	(reader-error :read-error)
224	228	(error :error)))
225	229
	230	(defun %condition-location (origin)
	231	;; NOTE: If we're compiling in a buffer, the origin
	232	;; will already be set up with the offset correctly
	233	;; due to the :source-debug parameters from
	234	;; swank-compile-string (below).
	235	(make-file-location
	236	(sys:file-scope-pathname
	237	(sys:file-scope origin))
	238	(sys:source-pos-info-filepos origin)))
	239
226	240	(defun condition-location (origin)
227		(if (null origin)
228		(make-error-location "No error location available")
229		;; NOTE: If we're compiling in a buffer, the origin
230		;; will already be set up with the offset correctly
231		;; due to the :source-debug parameters from
232		;; swank-compile-string (below).
233		(make-file-location
234		(core:file-scope-pathname
235		(core:file-scope origin))
236		(core:source-pos-info-filepos origin))))
	241	(typecase origin
	242	(null (make-error-location "No error location available"))
	243	(cons (%condition-location (car origin)))
	244	(t (%condition-location origin))))
237	245
238	246	(defun signal-compiler-condition (condition origin)
239	247	(signal 'compiler-condition

316	324
317	325	(defimplementation arglist (name)
318	326	(multiple-value-bind (arglist foundp)
319		(core:function-lambda-list name) ;; Uses bc-split
	327	(sys:function-lambda-list name) ;; Uses bc-split
320	328	(if foundp arglist :not-available)))
321	329
322	330	(defimplementation function-name (f)

345	353	nil)
346	354	((macro-function (car form) environment)
347	355	(push form macro-forms))
348		((not (eq form (core:compiler-macroexpand-1 form environment)))
	356	((not (eq form (sys:compiler-macroexpand-1 form environment)))
349	357	(push form compiler-macro-forms))))
350	358	form)
351	359	form environment)

697	705	(slime-dbg "receive-if condition-variable-timedwait")
698	706	(mp:condition-variable-wait (mailbox.cvar mbox) mutex) ; timedwait 0.2
699	707	(slime-dbg "came out of condition-variable-timedwait")
700		(core:check-pending-interrupts)))))
	708	(sys:check-pending-interrupts)))))
701	709
702	710	) ; #+threads (progn ...
703	711
704	712
705		(defmethod emacs-inspect ((object core:cxx-object))
706		(let ((encoded (core:encode object)))
	713	(defmethod emacs-inspect ((object sys:cxx-object))
	714	(let ((encoded (sys:encode object)))
707	715	(loop for (key . value) in encoded
708	716	append (list (string key) ": " (list :value value) (list :newline)))))
709	717
710		(defmethod emacs-inspect ((object core:va-list))
711		(emacs-inspect (core:list-from-va-list object)))
	718	(defmethod emacs-inspect ((object sys:vaslist))
	719	(emacs-inspect (sys:list-from-vaslist object)))
	720
	721	;;; Packages
	722
	723	#+package-local-nicknames
	724	(defimplementation package-local-nicknames (package)
	725	(ext:package-local-nicknames package))

+9

-3

swank/clisp.lisp less more

250	250
251	251	;;;; Swank functions
252	252
	253	(defimplementation function-name (f)
	254	(check-type f function)
	255	(system::function-name f))
	256
253	257	(defimplementation arglist (fname)
254	258	(block nil
255	259	(or (ignore-errors
256		(let ((exp (function-lambda-expression fname)))
257		(and exp (return (second exp)))))
	260	(return (ext:arglist fname)))
	261	;; For traced functions this returns the entire encapsulating
	262	;; lambda.
258	263	(ignore-errors
259		(return (ext:arglist fname)))
	264	(let ((exp (function-lambda-expression fname)))
	265	(and exp (return (second exp)))))
260	266	:not-available)))
261	267
262	268	(defimplementation macroexpand-all (form &optional env)

+13

-1

swank/gray.lisp less more

26	26	stream-unread-char
27	27	stream-clear-input
28	28	stream-line-column
29		stream-read-char-no-hang))
	29	stream-read-char-no-hang
	30
	31	#+sbcl stream-file-position))
30	32	nil)
31	33
32	34	(defpackage swank/gray

128	130	(cond ((zerop column) nil)
129	131	(t (terpri stream) t))))
130	132
	133	#+sbcl
	134	(defmethod stream-file-position ((stream slime-output-stream) &optional position)
	135	(declare (ignore position))
	136	nil)
	137
131	138	(defclass slime-input-stream (fundamental-character-input-stream)
132	139	((input-fn :initarg :input-fn)
133	140	(buffer :initform "") (index :initform 0)

188	195	(when (< index (length buffer))
189	196	(prog1 (aref buffer index) (incf index)))))))
190	197
	198	#+sbcl
	199	(defmethod stream-file-position ((stream slime-input-stream) &optional position)
	200	(declare (ignore position))
	201	nil)
	202
191	203
192	204	;;;
193	205

+6

-0

swank/lispworks.lisp less more

1017	1017
1018	1018	(defimplementation make-weak-value-hash-table (&rest args)
1019	1019	(apply #'make-hash-table :weak-kind :value args))
	1020
	1021	;;;; Packages
	1022
	1023	#+package-local-nicknames
	1024	(defimplementation package-local-nicknames (package)
	1025	(hcl:package-local-nicknames package))

+4

-4

swank.lisp less more

2160	2160	(print-pretty t)
2161	2161	(print-right-margin 65)
2162	2162	(print-circle t)
2163		(print-length (or print-length limit))
2164		(print-level (or print-level limit))
	2163	(print-length (or print-length 64))
	2164	(print-level (or print-level 6))
2165	2165	(print-lines (or print-lines limit)))
2166	2166	(print-condition condition stream))
2167	2167	(serious-condition (c)

2283	2283	(invoke-restart (find 'abort sldb-restarts :key #'restart-name)))
2284	2284
2285	2285	(defslimefun sldb-continue ()
2286		(continue))
	2286	(invoke-restart (find 'continue sldb-restarts :key #'restart-name)))
2287	2287
2288	2288	(defun coerce-to-condition (datum args)
2289	2289	(etypecase datum

3640	3640	(let ((alist '()))
3641	3641	(flet ((consider (symbol)
3642	3642	(let ((indent (symbol-indentation symbol)))
3643		(when indent
	3643	(when (or indent (gethash symbol cache))
3644	3644	(unless (equal (gethash symbol cache) indent)
3645	3645	(setf (gethash symbol cache) indent)
3646	3646	(let ((pkgs (mapcar #'package-name