Skip to content
Newer
Older
100644 780 lines (642 sloc) 26.2 KB
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
1 ;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;* "; -*-
f912c9c New file.
Helmut Eller authored
2 ;;;
3 ;;; swank-allegro.lisp --- Allegro CL specific code for SLIME.
4 ;;;
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored
5 ;;; Created 2003
f912c9c New file.
Helmut Eller authored
6 ;;;
7 ;;; This code has been placed in the Public Domain. All warranties
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
8 ;;; are disclaimed.
f912c9c New file.
Helmut Eller authored
9 ;;;
10
8052a9e Minor modifications.
Helmut Eller authored
11 (in-package :swank-backend)
12
f912c9c New file.
Helmut Eller authored
13 (eval-when (:compile-toplevel :load-toplevel :execute)
14 (require :sock)
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
15 (require :process))
aa65d6e Implemented.
Luke Gorrie authored
16
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
17 (import-from :excl *gray-stream-symbols* :swank-backend)
f912c9c New file.
Helmut Eller authored
18
f759e67 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored
19 ;;; swank-mop
20
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored
21 ;; maybe better change MOP to ACLMOP ?
22 ;; CLOS also works in ACL5. --he
23 (import-swank-mop-symbols :clos '(:slot-definition-documentation))
ff1fa86 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored
24
25 (defun swank-mop:slot-definition-documentation (slot)
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
26 (documentation slot t))
f759e67 2004-09-13 Marco Baringer <mb@bese.it>
Marco Baringer authored
27
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
28
fab0b31 Add multiprocessing support.
Helmut Eller authored
29 ;;;; TCP Server
f912c9c New file.
Helmut Eller authored
30
8052a9e Minor modifications.
Helmut Eller authored
31 (defimplementation preferred-communication-style ()
32 :spawn)
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored
33
39861f4 (create-socket): Take interface as argument.
Helmut Eller authored
34 (defimplementation create-socket (host port)
35 (socket:make-socket :connect :passive :local-port port
36 :local-host host :reuse-address t))
bba6c65 (format-condition-for-emacs): Replaced with debugger-condition-for-em…
Helmut Eller authored
37
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
38 (defimplementation local-port (socket)
7b493c0 (create-socket, local-port, close-socket, accept-connection)
Helmut Eller authored
39 (socket:local-port socket))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
40
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
41 (defimplementation close-socket (socket)
7b493c0 (create-socket, local-port, close-socket, accept-connection)
Helmut Eller authored
42 (close socket))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
43
d4ac7e7 * Improve the robustness of connection establishment.
Douglas Crosher authored
44 (defimplementation accept-connection (socket &key external-format buffering
45 timeout)
46 (declare (ignore buffering timeout))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
47 (let ((ef (or external-format :iso-latin-1-unix))
48 (s (socket:accept-connection socket :wait t)))
49 (set-external-format s ef)
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored
50 s))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
51
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
52 (defun find-external-format (coding-system)
53 #+(version>= 6)
2bbbb17 (find-external-format): Fix typo.
Helmut Eller authored
54 (let* ((name (ecase coding-system
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored
55 (:iso-latin-1-unix :latin1)
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
56 (:utf-8-unix :utf8)
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
57 (:emacs-mule-unix :emacs-mule))))
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
58 (excl:crlf-base-ef (excl:find-external-format name :try-variant t)))
59 #-(version>= 6)
60 (ecase coding-system
61 (:iso-latin-1-unix :default)))
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
62
63 (defun set-external-format (stream external-format)
2bbbb17 (find-external-format): Fix typo.
Helmut Eller authored
64 (setf (stream-external-format stream)
65 (find-external-format external-format)))
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored
66
58bc7fb (format-sldb-condition, condition-references): Add workarounds for
Helmut Eller authored
67 (defimplementation format-sldb-condition (c)
68 (princ-to-string c))
69
70 (defimplementation condition-references (c)
2b0dd28 (frame-var-value): New backend function.
Helmut Eller authored
71 (declare (ignore c))
58bc7fb (format-sldb-condition, condition-references): Add workarounds for
Helmut Eller authored
72 '())
73
2b0dd28 (frame-var-value): New backend function.
Helmut Eller authored
74 (defimplementation call-with-syntax-hooks (fn)
75 (funcall fn))
76
6fa3b33 (arglist-string): Refactor common code to swank.lisp.
Helmut Eller authored
77 ;;;; Unix signals
78
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
79 (defimplementation call-without-interrupts (fn)
6fa3b33 (arglist-string): Refactor common code to swank.lisp.
Helmut Eller authored
80 (excl:without-interrupts (funcall fn)))
81
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
82 (defimplementation getpid ()
fab0b31 Add multiprocessing support.
Helmut Eller authored
83 (excl::getpid))
84
6827452 (lisp-implementation-type-name): Implement it.
Helmut Eller authored
85 (defimplementation lisp-implementation-type-name ()
86 "allegro")
87
38b61c2 Allegro specific version of set-default-directory
Peter Seibel authored
88 (defimplementation set-default-directory (directory)
b408600 (set-default-directory): Fix for pathnames without a trailing slash.
Matthias Koeppe authored
89 (let* ((dir (namestring (truename (merge-pathnames directory)))))
90 (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
91 dir))
38b61c2 Allegro specific version of set-default-directory
Peter Seibel authored
92
167a03c (default-directory, call-with-syntax-hooks): Add implementations as
Helmut Eller authored
93 (defimplementation default-directory ()
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
94 (namestring (excl:current-directory)))
167a03c (default-directory, call-with-syntax-hooks): Add implementations as
Helmut Eller authored
95
fab0b31 Add multiprocessing support.
Helmut Eller authored
96 ;;;; Misc
f912c9c New file.
Helmut Eller authored
97
8052a9e Minor modifications.
Helmut Eller authored
98 (defimplementation arglist (symbol)
d589600 (arglist): Return :not-available if arglist lookup fails with an
Luke Gorrie authored
99 (handler-case (excl:arglist symbol)
100 (simple-error () :not-available)))
8052a9e Minor modifications.
Helmut Eller authored
101
102 (defimplementation macroexpand-all (form)
103 (excl::walk form))
f912c9c New file.
Helmut Eller authored
104
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
105 (defimplementation describe-symbol-for-emacs (symbol)
f912c9c New file.
Helmut Eller authored
106 (let ((result '()))
107 (flet ((doc (kind &optional (sym symbol))
108 (or (documentation sym kind) :not-documented))
109 (maybe-push (property value)
110 (when value
111 (setf result (list* property value result)))))
112 (maybe-push
113 :variable (when (boundp symbol)
114 (doc 'variable)))
115 (maybe-push
116 :function (if (fboundp symbol)
117 (doc 'function)))
118 (maybe-push
119 :class (if (find-class symbol nil)
120 (doc 'class)))
121 result)))
122
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
123 (defimplementation describe-definition (symbol namespace)
124 (ecase namespace
125 (:variable
126 (describe symbol))
127 ((:function :generic-function)
128 (describe (symbol-function symbol)))
129 (:class
130 (describe (find-class symbol)))))
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
131
c153745 (make-stream-interactive): Set interactive-stream-p slot on the stream
Luke Gorrie authored
132 (defimplementation make-stream-interactive (stream)
133 (setf (interactive-stream-p stream) t))
134
fab0b31 Add multiprocessing support.
Helmut Eller authored
135 ;;;; Debugger
136
f912c9c New file.
Helmut Eller authored
137 (defvar *sldb-topframe*)
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
138
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
139 (defimplementation call-with-debugging-environment (debugger-loop-fn)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
140 (let ((*sldb-topframe* (find-topframe))
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
141 (excl::*break-hook* nil))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
142 (funcall debugger-loop-fn)))
f912c9c New file.
Helmut Eller authored
143
424cc92 (sldb-break-at-start): Implement.
Matthias Koeppe authored
144 (defimplementation sldb-break-at-start (fname)
145 ;; :print-before is kind of mis-used but we just want to stuff our break form
146 ;; somewhere. This does not work for setf, :before and :after methods, which
147 ;; need special syntax in the trace call, see ACL's doc/debugging.htm chapter 10.
148 (eval `(trace (,fname
149 :print-before
150 ((break "Function start breakpoint of ~A" ',fname)))))
151 `(:ok ,(format nil "Set breakpoint at start of ~S" fname)))
152
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
153 (defun find-topframe ()
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
154 (let ((skip-frames 3))
155 (do ((f (excl::int-newest-frame) (next-frame f))
156 (i 0 (1+ i)))
157 ((= i skip-frames) f))))
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
158
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored
159 (defun next-frame (frame)
160 (let ((next (excl::int-next-older-frame frame)))
161 (cond ((not next) nil)
162 ((debugger:frame-visible-p next) next)
163 (t (next-frame next)))))
164
f912c9c New file.
Helmut Eller authored
165 (defun nth-frame (index)
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored
166 (do ((frame *sldb-topframe* (next-frame frame))
f912c9c New file.
Helmut Eller authored
167 (i index (1- i)))
168 ((zerop i) frame)))
169
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
170 (defimplementation compute-backtrace (start end)
f912c9c New file.
Helmut Eller authored
171 (let ((end (or end most-positive-fixnum)))
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored
172 (loop for f = (nth-frame start) then (next-frame f)
f912c9c New file.
Helmut Eller authored
173 for i from start below end
174 while f
3dc039d (nth-frame): Skip frames where frame-visible-p is false.
Helmut Eller authored
175 collect f)))
f912c9c New file.
Helmut Eller authored
176
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
177 (defimplementation print-frame (frame stream)
178 (debugger:output-frame stream frame :moderate))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
179
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
180 (defimplementation frame-locals (index)
f912c9c New file.
Helmut Eller authored
181 (let ((frame (nth-frame index)))
182 (loop for i from 0 below (debugger:frame-number-vars frame)
de3dd96 See ChangeLog entry 2004-03-05 Marco Baringer
Marco Baringer authored
183 collect (list :name (debugger:frame-var-name frame i)
f912c9c New file.
Helmut Eller authored
184 :id 0
de3dd96 See ChangeLog entry 2004-03-05 Marco Baringer
Marco Baringer authored
185 :value (debugger:frame-var-value frame i)))))
f912c9c New file.
Helmut Eller authored
186
2b0dd28 (frame-var-value): New backend function.
Helmut Eller authored
187 (defimplementation frame-var-value (frame var)
188 (let ((frame (nth-frame frame)))
189 (debugger:frame-var-value frame var)))
190
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
191 (defimplementation frame-catch-tags (index)
f912c9c New file.
Helmut Eller authored
192 (declare (ignore index))
193 nil)
194
8052a9e Minor modifications.
Helmut Eller authored
195 (defimplementation disassemble-frame (index)
196 (disassemble (debugger:frame-function (nth-frame index))))
197
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
198 (defimplementation frame-source-location-for-emacs (index)
33236b4 From Matthew Danish:
Luke Gorrie authored
199 (let* ((frame (nth-frame index))
200 (expr (debugger:frame-expression frame))
201 (fspec (first expr)))
202 (second (first (fspec-definition-locations fspec)))))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
203
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
204 (defimplementation eval-in-frame (form frame-number)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
205 (let ((frame (nth-frame frame-number)))
206 ;; let-bind lexical variables
207 (let ((vars (loop for i below (debugger:frame-number-vars frame)
208 for name = (debugger:frame-var-name frame i)
209 if (symbolp name)
210 collect `(,name ',(debugger:frame-var-value frame i)))))
211 (debugger:eval-form-in-context
212 `(let* ,vars ,form)
213 (debugger:environment-of-frame frame)))))
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
214
4303a24 (return-from-frame, restart-name): Implement interface (partly).
Helmut Eller authored
215 (defimplementation return-from-frame (frame-number form)
216 (let ((frame (nth-frame frame-number)))
217 (multiple-value-call #'debugger:frame-return
218 frame (debugger:eval-form-in-context
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
219 form
220 (debugger:environment-of-frame frame)))))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored
221
4303a24 (return-from-frame, restart-name): Implement interface (partly).
Helmut Eller authored
222 (defimplementation restart-frame (frame-number)
223 (let ((frame (nth-frame frame-number)))
18204be (restart-frame): Simplify it a little.
Helmut Eller authored
224 (cond ((debugger:frame-retryable-p frame)
225 (apply #'debugger:frame-retry frame (debugger:frame-function frame)
226 (cdr (debugger:frame-expression frame))))
227 (t "Frame is not retryable"))))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored
228
fab0b31 Add multiprocessing support.
Helmut Eller authored
229 ;;;; Compiler hooks
230
f912c9c New file.
Helmut Eller authored
231 (defvar *buffer-name* nil)
232 (defvar *buffer-start-position*)
233 (defvar *buffer-string*)
aa65d6e Implemented.
Luke Gorrie authored
234 (defvar *compile-filename* nil)
f912c9c New file.
Helmut Eller authored
235
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
236 (defun compiler-note-p (object)
237 (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
238
239 (defun compiler-undefined-functions-called-warning-p (object)
2bbbb17 (find-external-format): Fix typo.
Helmut Eller authored
240 #+(version>= 6)
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
241 (typep object 'excl:compiler-undefined-functions-called-warning))
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored
242
243 (deftype compiler-note ()
244 `(satisfies compiler-note-p))
245
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
246 (defun signal-compiler-condition (&rest args)
247 (signal (apply #'make-condition 'compiler-condition args)))
248
f912c9c New file.
Helmut Eller authored
249 (defun handle-compiler-warning (condition)
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
250 (declare (optimize (debug 3) (speed 0) (space 0)))
251 (cond ((and (not *buffer-name*)
252 (compiler-undefined-functions-called-warning-p condition))
253 (handle-undefined-functions-warning condition))
254 (t
255 (signal-compiler-condition
256 :original-condition condition
257 :severity (etypecase condition
258 (warning :warning)
259 (compiler-note :note))
260 :message (format nil "~A" condition)
261 :location (location-for-warning condition)))))
262
263 (defun location-for-warning (condition)
f912c9c New file.
Helmut Eller authored
264 (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
358236a (handle-compiler-warning): Handle undefined-functions warnings by
Helmut Eller authored
265 (cond (*buffer-name*
266 (make-location
267 (list :buffer *buffer-name*)
268 (list :position *buffer-start-position*)))
269 (loc
270 (destructuring-bind (file . pos) loc
271 (make-location
272 (list :file (namestring (truename file)))
273 (list :position (1+ pos)))))
274 (t
275 (list :error "No error location available.")))))
276
277 (defun handle-undefined-functions-warning (condition)
278 (let ((fargs (slot-value condition 'excl::format-arguments)))
9f80540 (handle-undefined-functions-warning): Prevent breakage if the
Helmut Eller authored
279 (loop for (fname . pos-file) in (car fargs) do
280 (loop for (pos file) in pos-file do
281 (signal-compiler-condition
282 :original-condition condition
283 :severity :warning
284 :message (format nil "Undefined function referenced: ~S"
285 fname)
286 :location (make-location (list :file file)
287 (list :position (1+ pos))))))))
f912c9c New file.
Helmut Eller authored
288
aa65d6e Implemented.
Luke Gorrie authored
289 (defimplementation call-with-compilation-hooks (function)
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored
290 (handler-bind ((warning #'handle-compiler-warning)
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
291 ;;(compiler-note #'handle-compiler-warning)
292 )
aa65d6e Implemented.
Luke Gorrie authored
293 (funcall function)))
294
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
295 (defimplementation swank-compile-file (filename load-p
296 &optional external-format)
aa65d6e Implemented.
Luke Gorrie authored
297 (with-compilation-hooks ()
521e923 (swank-compile-file): New optional argument `external-format'.
Helmut Eller authored
298 (let ((*buffer-name* nil)
299 (*compile-filename* filename)
300 (ef (if external-format
301 (find-external-format external-format)
302 :default)))
303 (compile-file *compile-filename* :load-after-compile load-p
304 :external-format ef))))
f912c9c New file.
Helmut Eller authored
305
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
306 (defun call-with-temp-file (fn)
307 (let ((tmpname (system:make-temp-file-name)))
308 (unwind-protect
309 (with-open-file (file tmpname :direction :output :if-exists :error)
310 (funcall fn file tmpname))
311 (delete-file tmpname))))
312
313 (defun compile-from-temp-file (string)
314 (call-with-temp-file
315 (lambda (stream filename)
316 (write-string string stream)
317 (finish-output stream)
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored
318 (let ((binary-filename
319 (excl:without-redefinition-warnings
320 ;; Suppress Allegro's redefinition warnings; they are
321 ;; pointless when we are compiling via a temporary
322 ;; file.
323 (compile-file filename :load-after-compile t))))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
324 (when binary-filename
325 (delete-file binary-filename))))))
326
79c38c6 Adding directory argument to swank-compile-string.
Peter Seibel authored
327 (defimplementation swank-compile-string (string &key buffer position directory)
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
328 ;; We store the source buffer in excl::*source-pathname* as a string
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored
329 ;; of the form <buffername>;<start-offset>. Quite ugly encoding, but
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
330 ;; the fasl file is corrupted if we use some other datatype.
aa65d6e Implemented.
Luke Gorrie authored
331 (with-compilation-hooks ()
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
332 (let ((*buffer-name* buffer)
f912c9c New file.
Helmut Eller authored
333 (*buffer-start-position* position)
79c38c6 Adding directory argument to swank-compile-string.
Peter Seibel authored
334 (*buffer-string* string)
335 (*default-pathname-defaults*
336 (if directory (merge-pathnames (pathname directory))
337 *default-pathname-defaults*)))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
338 (compile-from-temp-file
339 (format nil "~S ~S~%~A"
340 `(in-package ,(package-name *package*))
341 `(eval-when (:compile-toplevel :load-toplevel)
342 (setq excl::*source-pathname*
6d27ed7 (find-fspec-location): Catch errors in excl:source-file.
Helmut Eller authored
343 ',(format nil "~A;~D" buffer position)))
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
344 string)))))
f912c9c New file.
Helmut Eller authored
345
fab0b31 Add multiprocessing support.
Helmut Eller authored
346 ;;;; Definition Finding
347
56d2e6d (fspec-primary-name): New function.
Helmut Eller authored
348 (defun fspec-primary-name (fspec)
349 (etypecase fspec
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
350 (symbol fspec)
351 (list (fspec-primary-name (second fspec)))))
352
353 ;; If Emacs uses DOS-style eol conventions, \n\r are considered as a
354 ;; single character, but file-position counts them as two. Here we do
355 ;; our own conversion.
356 (defun count-cr (file pos)
357 (let* ((bufsize 256)
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored
358 (type '(unsigned-byte 8))
359 (buf (make-array bufsize :element-type type))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
360 (cr-count 0))
984c411 (accept-connection): Accept :external-format as argument.
Helmut Eller authored
361 (with-open-file (stream file :direction :input :element-type type)
362 (loop for bytes-read = (read-sequence buf stream) do
363 (incf cr-count (count (char-code #\return) buf
364 :end (min pos bytes-read)))
365 (decf pos bytes-read)
366 (when (<= pos 0)
367 (return cr-count))))))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
368
7544734 (find-definition-in-file)
Matthias Koeppe authored
369 (defun find-definition-in-file (fspec type file top-level)
370 (let* ((part
371 (or (scm::find-definition-in-definition-group
372 fspec type (scm:section-file :file file)
373 :top-level top-level)
374 (scm::find-definition-in-definition-group
375 (fspec-primary-name fspec)
376 type (scm:section-file :file file)
377 :top-level top-level)))
378 (start (and part
379 (scm::source-part-start part)))
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored
380 (pos (if start
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
381 (list :position (1+ (- start (count-cr file start))))
382 (list :function-name (string (fspec-primary-name fspec))))))
383 (make-location (list :file (namestring (truename file)))
384 pos)))
2ab1edd (find-fspec-location): excl:source-file can return stuff like
Helmut Eller authored
385
386 (defun find-definition-in-buffer (filename)
387 (let ((pos (position #\; filename :from-end t)))
388 (make-location
389 (list :buffer (subseq filename 0 pos))
390 (list :position (parse-integer (subseq filename (1+ pos)))))))
391
7544734 (find-definition-in-file)
Matthias Koeppe authored
392 (defun find-fspec-location (fspec type file top-level)
393 (etypecase file
394 (pathname
395 (find-definition-in-file fspec type file top-level))
396 ((member :top-level)
397 (list :error (format nil "Defined at toplevel: ~A"
398 (fspec->string fspec))))
399 (string
400 (find-definition-in-buffer file))))
4902bdb (find-fspec-location): Include the type of the definition in the
Luke Gorrie authored
401
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored
402 (defun fspec->string (fspec)
4902bdb (find-fspec-location): Include the type of the definition in the
Luke Gorrie authored
403 (etypecase fspec
36f4daf (swank-compile-string): Use #\; instead of #\: to separate the
Helmut Eller authored
404 (symbol (let ((*package* (find-package :keyword)))
405 (prin1-to-string fspec)))
406 (list (format nil "(~A ~A)"
407 (prin1-to-string (first fspec))
408 (let ((*package* (find-package :keyword)))
409 (prin1-to-string (second fspec)))))))
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
410
437f909 Remove stupid conflicts.
Helmut Eller authored
411 (defun fspec-definition-locations (fspec)
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored
412 (cond
413 ((and (listp fspec)
414 (eql (car fspec) :top-level-form))
415 (destructuring-bind (top-level-form file position) fspec
416 (list
417 (list (list nil fspec)
418 (make-location (list :buffer file)
d51dbc0 (fspec-definition-locations): Improve handling of (:internal ... n)
Helmut Eller authored
419 (list :position position t))))))
420 ((and (listp fspec) (eq (car fspec) :internal))
421 (destructuring-bind (_internal next _n) fspec
422 (fspec-definition-locations next)))
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored
423 (t
424 (let ((defs (excl::find-source-file fspec)))
425 (if (null defs)
426 (list
427 (list (list nil fspec)
428 (list :error
429 (format nil "Unknown source location for ~A"
430 (fspec->string fspec)))))
7544734 (find-definition-in-file)
Matthias Koeppe authored
431 (loop for (fspec type file top-level) in defs
b909530 (fspec-definition-locations): Handle
Matthias Koeppe authored
432 collect (list (list type fspec)
433 (find-fspec-location fspec type file top-level))))))))
8052a9e Minor modifications.
Helmut Eller authored
434
435 (defimplementation find-definitions (symbol)
436 (fspec-definition-locations symbol))
fab0b31 Add multiprocessing support.
Helmut Eller authored
437
c2d3f88 Implement changed backend interface and remove references to front en…
Helmut Eller authored
438 ;;;; XREF
f912c9c New file.
Helmut Eller authored
439
8052a9e Minor modifications.
Helmut Eller authored
440 (defmacro defxref (name relation name1 name2)
441 `(defimplementation ,name (x)
442 (xref-result (xref:get-relation ,relation ,name1 ,name2))))
443
444 (defxref who-calls :calls :wild x)
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
445 (defxref calls-who :calls x :wild)
8052a9e Minor modifications.
Helmut Eller authored
446 (defxref who-references :uses :wild x)
447 (defxref who-binds :binds :wild x)
448 (defxref who-macroexpands :macro-calls :wild x)
449 (defxref who-sets :sets :wild x)
450
451 (defun xref-result (fspecs)
452 (loop for fspec in fspecs
453 append (fspec-definition-locations fspec)))
c9ef56e (create-swank-server): Add support for BACKGROUND and CLOSE argument.
Helmut Eller authored
454
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
455 ;; list-callers implemented by groveling through all fbound symbols.
456 ;; Only symbols are considered. Functions in the constant pool are
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
457 ;; searched recursively. Closure environments are ignored at the
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
458 ;; moment (constants in methods are therefore not found).
459
460 (defun map-function-constants (function fn depth)
461 "Call FN with the elements of FUNCTION's constant pool."
462 (do ((i 0 (1+ i))
463 (max (excl::function-constant-count function)))
464 ((= i max))
465 (let ((c (excl::function-constant function i)))
466 (cond ((and (functionp c)
467 (not (eq c function))
468 (plusp depth))
469 (map-function-constants c fn (1- depth)))
470 (t
471 (funcall fn c))))))
472
ca9bb1b (set-external-format): New function. Use LF as eol mark.
Helmut Eller authored
473 (defun in-constants-p (fun symbol)
474 (map-function-constants fun
475 (lambda (c)
476 (when (eq c symbol)
477 (return-from in-constants-p t)))
478 3))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
479
1a07e24 (swank-compile-string): Use a temporary file and set
Helmut Eller authored
480 (defun function-callers (name)
481 (let ((callers '()))
482 (do-all-symbols (sym)
483 (when (fboundp sym)
484 (let ((fn (fdefinition sym)))
485 (when (in-constants-p fn name)
486 (push sym callers)))))
487 callers))
488
489 (defimplementation list-callers (name)
490 (xref-result (function-callers name)))
491
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
492 (defimplementation list-callees (name)
493 (let ((result '()))
494 (map-function-constants (fdefinition name)
495 (lambda (c)
496 (when (fboundp c)
497 (push c result)))
498 2)
499 (xref-result result)))
500
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored
501 ;;;; Profiling
502
be83e05 Profiling functions on Allegro (except for profile-package). From
Helmut Eller authored
503 ;; Per-function profiling based on description in
504 ;; http://www.franz.com/support/documentation/8.0/doc/runtime-analyzer.htm#data-collection-control-2
505
506 (defvar *profiled-functions* ())
507 (defvar *profile-depth* 0)
508
509 (defmacro with-redirected-y-or-n-p (&body body)
510 ;; If the profiler is restarted when the data from the previous
511 ;; session is not reported yet, the user is warned via Y-OR-N-P.
512 ;; As the CL:Y-OR-N-P question is (for some reason) not directly
513 ;; sent to the Slime user, the function CL:Y-OR-N-P is temporarily
514 ;; overruled.
515 `(let* ((pkg (find-package "common-lisp"))
516 (saved-pdl (excl::package-definition-lock pkg))
517 (saved-ynp (symbol-function 'cl:y-or-n-p)))
518
519 (setf (excl::package-definition-lock pkg) nil
520 (symbol-function 'cl:y-or-n-p) (symbol-function
521 (find-symbol "y-or-n-p-in-emacs"
522 "swank")))
523 (unwind-protect
524 (progn ,@body)
525
526 (setf (symbol-function 'cl:y-or-n-p) saved-ynp
527 (excl::package-definition-lock pkg) saved-pdl))))
528
529 (defun start-acl-profiler ()
530 (with-redirected-y-or-n-p
531 (prof:start-profiler :type :time :count t
532 :start-sampling-p nil :verbose nil)))
533 (defun acl-profiler-active-p ()
534 (not (eq (prof:profiler-status :verbose nil) :inactive)))
535
536 (defun stop-acl-profiler ()
537 (prof:stop-profiler :verbose nil))
538
539 (excl:def-fwrapper profile-fwrapper (&rest args)
540 ;; Ensures sampling is done during the execution of the function,
541 ;; taking into account recursion.
542 (declare (ignore args))
543 (cond ((zerop *profile-depth*)
544 (let ((*profile-depth* (1+ *profile-depth*)))
545 (prof:start-sampling)
546 (unwind-protect (excl:call-next-fwrapper)
547 (prof:stop-sampling))))
548 (t
549 (excl:call-next-fwrapper))))
550
551 (defimplementation profile (fname)
552 (unless (acl-profiler-active-p)
553 (start-acl-profiler))
554 (excl:fwrap fname 'profile-fwrapper 'profile-fwrapper)
555 (push fname *profiled-functions*))
556
557 (defimplementation profiled-functions ()
558 *profiled-functions*)
559
560 (defimplementation unprofile (fname)
561 (excl:funwrap fname 'profile-fwrapper)
562 (setq *profiled-functions* (remove fname *profiled-functions*)))
563
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored
564 (defimplementation profile-report ()
be83e05 Profiling functions on Allegro (except for profile-package). From
Helmut Eller authored
565 (prof:show-flat-profile :verbose nil)
566 (when *profiled-functions*
567 (start-acl-profiler)))
568
569 (defimplementation profile-reset ()
570 (when (acl-profiler-active-p)
571 (stop-acl-profiler)
572 (start-acl-profiler))
573 "Reset profiling counters.")
d5c9af3 they are pointless when we are compiling via a temporary file.
Matthias Koeppe authored
574
aeada84 (thread-alive-p): Add default implementation.
Helmut Eller authored
575 ;;;; Inspecting
576
0ce7bc2 2004-09-14 Marco Baringer <mb@bese.it>
Marco Baringer authored
577 (defclass acl-inspector (inspector)
578 ())
579
580 (defimplementation make-default-inspector ()
581 (make-instance 'acl-inspector))
582
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
583 (defmethod inspect-for-emacs ((f function) inspector)
584 inspector
0ce7bc2 2004-09-14 Marco Baringer <mb@bese.it>
Marco Baringer authored
585 (values "A function."
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
586 (append
587 (label-value-line "Name" (function-name f))
588 `("Formals" ,(princ-to-string (arglist f)) (:newline))
589 (let ((doc (documentation (excl::external-fn_symdef f) 'function)))
590 (when doc
591 `("Documentation:" (:newline) ,doc))))))
592
593 (defmethod inspect-for-emacs ((o t) (inspector acl-inspector))
594 inspector
595 (values "A value." (allegro-inspect o)))
596
597 (defmethod inspect-for-emacs ((o function) (inspector acl-inspector))
598 inspector
599 (values "A function." (allegro-inspect o)))
600
dc71b6e (inspect-for-emacs): Use the backend specific method to inspect
Helmut Eller authored
601 (defmethod inspect-for-emacs ((o standard-object) (inspector acl-inspector))
602 inspector
1daebc6 (inspect-for-emacs): Fix typo.
Marco Baringer authored
603 (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
dc71b6e (inspect-for-emacs): Use the backend specific method to inspect
Helmut Eller authored
604
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
605 (defun allegro-inspect (o)
606 (loop for (d dd) on (inspect::inspect-ctl o)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
607 append (frob-allegro-field-def o d)
608 until (eq d dd)))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
609
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
610 (defun frob-allegro-field-def (object def)
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
611 (with-struct (inspect::field-def- name type access) def
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
612 (ecase type
d502794 (find-external-format): Translate :utf-8-unix to :utf8, which Allegro
Helmut Eller authored
613 ((:unsigned-word :unsigned-byte :unsigned-natural
614 :unsigned-long :unsigned-half-long
615 :unsigned-3byte)
971c7b4 (eval-in-frame): Allegro's eval-form-in-context does nothing special
Helmut Eller authored
616 (label-value-line name (inspect::component-ref-v object access type)))
617 ((:lisp :value)
618 (label-value-line name (inspect::component-ref object access)))
619 (:indirect
620 (destructuring-bind (prefix count ref set) access
621 (declare (ignore set prefix))
622 (loop for i below (funcall count object)
623 append (label-value-line (format nil "~A-~D" name i)
624 (funcall ref object i))))))))
5bb5d51 (swank-mop:slot-definition-documentation): ACL 7 says documentation
Helmut Eller authored
625
aeada84 (thread-alive-p): Add default implementation.
Helmut Eller authored
626 ;;;; Multithreading
fab0b31 Add multiprocessing support.
Helmut Eller authored
627
344b94e (initialize-multiprocessing): Update for new api.
Marco Baringer authored
628 (defimplementation initialize-multiprocessing (continuation)
629 (mp:start-scheduler)
630 (funcall continuation))
fab0b31 Add multiprocessing support.
Helmut Eller authored
631
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
632 (defimplementation spawn (fn &key name)
68dd370 Removed fwrapper-based code for inheriting "swankiness" to newly
Luke Gorrie authored
633 (mp:process-run-function name fn))
fab0b31 Add multiprocessing support.
Helmut Eller authored
634
12da821 (thread-id, find-thread): New backend function.
Helmut Eller authored
635 (defvar *id-lock* (mp:make-process-lock :name "id lock"))
636 (defvar *thread-id-counter* 0)
637
638 (defimplementation thread-id (thread)
639 (mp:with-process-lock (*id-lock*)
640 (or (getf (mp:process-property-list thread) 'id)
641 (setf (getf (mp:process-property-list thread) 'id)
642 (incf *thread-id-counter*)))))
643
644 (defimplementation find-thread (id)
645 (find id mp:*all-processes*
646 :key (lambda (p) (getf (mp:process-property-list p) 'id))))
647
64ff730 Update for modified thread interface.
Helmut Eller authored
648 (defimplementation thread-name (thread)
649 (mp:process-name thread))
fab0b31 Add multiprocessing support.
Helmut Eller authored
650
64ff730 Update for modified thread interface.
Helmut Eller authored
651 (defimplementation thread-status (thread)
652 (format nil "~A ~D" (mp:process-whostate thread)
653 (mp:process-priority thread)))
fab0b31 Add multiprocessing support.
Helmut Eller authored
654
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
655 (defimplementation make-lock (&key name)
fab0b31 Add multiprocessing support.
Helmut Eller authored
656 (mp:make-process-lock :name name))
657
72f16c0 Replace defmethod with defimplementation.
Helmut Eller authored
658 (defimplementation call-with-lock-held (lock function)
fab0b31 Add multiprocessing support.
Helmut Eller authored
659 (mp:with-process-lock (lock) (funcall function)))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored
660
661 (defimplementation current-thread ()
662 mp:*current-process*)
663
664 (defimplementation all-threads ()
64ff730 Update for modified thread interface.
Helmut Eller authored
665 (copy-list mp:*all-processes*))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored
666
667 (defimplementation interrupt-thread (thread fn)
668 (mp:process-interrupt thread fn))
669
52dc1fc (kill-thread): Implemented.
Helmut Eller authored
670 (defimplementation kill-thread (thread)
671 (mp:process-kill thread))
672
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored
673 (defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
674
675 (defstruct (mailbox (:conc-name mailbox.))
676 (mutex (mp:make-process-lock :name "process mailbox"))
677 (queue '() :type list))
678
679 (defun mailbox (thread)
680 "Return THREAD's mailbox."
681 (mp:with-process-lock (*mailbox-lock*)
682 (or (getf (mp:process-property-list thread) 'mailbox)
683 (setf (getf (mp:process-property-list thread) 'mailbox)
684 (make-mailbox)))))
685
686 (defimplementation send (thread message)
687 (let* ((mbox (mailbox thread))
688 (mutex (mailbox.mutex mbox)))
cbaae0c (send): Wait a bit if there are already many message in the mailbox.
Helmut Eller authored
689 (mp:process-wait-with-timeout
690 "yielding before sending" 0.1
691 (lambda ()
692 (mp:with-process-lock (mutex)
95e3c25 (send): Fix misplaced parens. (From Bill Clementson)
Helmut Eller authored
693 (< (length (mailbox.queue mbox)) 10))))
92d6085 Use signal driven IO for CMUCL and SBCL. Use one thread per request
Helmut Eller authored
694 (mp:with-process-lock (mutex)
695 (setf (mailbox.queue mbox)
696 (nconc (mailbox.queue mbox) (list message))))))
697
698 (defimplementation receive ()
699 (let* ((mbox (mailbox mp:*current-process*))
700 (mutex (mailbox.mutex mbox)))
701 (mp:process-wait "receive" #'mailbox.queue mbox)
702 (mp:with-process-lock (mutex)
703 (pop (mailbox.queue mbox)))))
9decabc See ChangeLog entry 2004-04-06 Marco Baringer
Marco Baringer authored
704
705 (defimplementation quit-lisp ()
706 (excl:exit 0 :quiet t))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
707
18204be (restart-frame): Simplify it a little.
Helmut Eller authored
708
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
709 ;;Trace implementations
710 ;;In Allegro 7.0, we have:
711 ;; (trace <name>)
712 ;; (trace ((method <name> <qualifier>? (<specializer>+))))
713 ;; (trace ((labels <name> <label-name>)))
714 ;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
715 ;; <name> can be a normal name or a (setf name)
716
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
717 (defimplementation toggle-trace (spec)
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored
718 (ecase (car spec)
719 ((setf)
720 (toggle-trace-aux spec))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
721 (:defgeneric (toggle-trace-generic-function-methods (second spec)))
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
722 ((setf :defmethod :labels :flet)
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
723 (toggle-trace-aux (process-fspec-for-allegro spec)))
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored
724 (:call
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
725 (destructuring-bind (caller callee) (cdr spec)
726 (toggle-trace-aux callee
727 :inside (list (process-fspec-for-allegro caller)))))))
728
729 (defun tracedp (fspec)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
730 (member fspec (eval '(trace)) :test #'equal))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
731
732 (defun toggle-trace-aux (fspec &rest args)
733 (cond ((tracedp fspec)
734 (eval `(untrace ,fspec))
735 (format nil "~S is now untraced." fspec))
736 (t
737 (eval `(trace (,fspec ,@args)))
738 (format nil "~S is now traced." fspec))))
739
740 (defun toggle-trace-generic-function-methods (name)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
741 (let ((methods (mop:generic-function-methods (fdefinition name))))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
742 (cond ((tracedp name)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
743 (eval `(untrace ,name))
744 (dolist (method methods (format nil "~S is now untraced." name))
745 (excl:funtrace (mop:method-function method))))
746 (t
b846225 (toggle-trace): Fix from Antonio Menezes Leitao.
Luke Gorrie authored
747 (eval `(trace (,name)))
c9f86e2 (toggle-trace): Update tracing code for new interface.
Helmut Eller authored
748 (dolist (method methods (format nil "~S is now traced." name))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
749 (excl:ftrace (mop:method-function method)))))))
750
751 (defun process-fspec-for-allegro (fspec)
752 (cond ((consp fspec)
753 (ecase (first fspec)
73e84b5 (process-fspec-for-allegro, toggle-trace): Handle setf functions.
Helmut Eller authored
754 ((setf) fspec)
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
755 ((:defun :defgeneric) (second fspec))
756 ((:defmethod) `(method ,@(rest fspec)))
18204be (restart-frame): Simplify it a little.
Helmut Eller authored
757 ((:labels) `(labels ,(process-fspec-for-allegro (second fspec))
758 ,(third fspec)))
759 ((:flet) `(flet ,(process-fspec-for-allegro (second fspec))
760 ,(third fspec)))))
80d90a0 (toggle-trace-generic-function-methods,
Marco Baringer authored
761 (t
762 fspec)))
b7ebf32 * swank-allegro.lisp (make-weak-key-hash-table): Use ACL's weak
Helmut Eller authored
763
764
765 ;;;; Weak hashtables
766
767 (defimplementation make-weak-key-hash-table (&rest args)
768 (apply #'make-hash-table :weak-keys t args))
769
770 (defimplementation make-weak-value-hash-table (&rest args)
771 (apply #'make-hash-table :values :weak args))
cfdb2c4 (character-completion-set): Implement it.
Matthias Koeppe authored
772
773
774 ;;;; Character names
775
776 (defimplementation character-completion-set (prefix matchp)
777 (loop for name being the hash-keys of excl::*name-to-char-table*
778 when (funcall matchp prefix name)
779 collect (string-capitalize name)))
Something went wrong with that request. Please try again.