Context Navigation

source: trunk/ccl/cocoa-ide/cocoa-listener.lisp @ 7829

Visit:

Last change on this file since 7829 was 7829, checked in by rme, 13 years ago
Remove stray backquote.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 24.7 KB

Line
1	;;;--Mode: LISP; Package: GUI --
2	;;;
3	;;; Copyright (C) 2007 Clozure Associates
4
5	(in-package "GUI")
6
7	(def-cocoa-default listener-input-font :font #'(lambda ()
8	(#/fontWithName:size:
9	ns:ns-font
10	#@"Monaco" 10.0))
11	"Default font for listener input")
12	(def-cocoa-default listener-output-font :font #'(lambda ()
13	(#/fontWithName:size:
14	ns:ns-font
15	#@"Monaco" 10.0))
16	"Default font for listener output")
17
18	(def-cocoa-default listener-rows :int 16 "Initial height of listener windows, in characters")
19	(def-cocoa-default listener-columns :int 80 "Initial height of listener windows, in characters")
20
21	(def-cocoa-default hi::listener-output-style :int 1 "Text style index for listener output")
22
23	(def-cocoa-default hi::listener-input-style :int 0 "Text style index for listener output")
24
25	(def-cocoa-default listener-background-color :color '(1.0 1.0 1.0 1.0) "Listener default background color")
26
27	(def-cocoa-default read-only-listener :bool t "Do not allow editing old listener output")
28
29	;;; Setup the server end of a pty pair.
30	(defun setup-server-pty (pty)
31	(set-tty-raw pty)
32	pty)
33
34	;;; Setup the client end of a pty pair.
35	(defun setup-client-pty (pty)
36	;; Since the same (Unix) process will be reading from and writing
37	;; to the pty, it's critical that we make the pty non-blocking.
38	;; Has this been true for the last few years (native threads) ?
39	;(fd-set-flag pty #$O_NONBLOCK)
40	(set-tty-raw pty)
41	#+no
42	(disable-tty-local-modes pty (logior #$ECHO #$ECHOCTL #$ISIG))
43	#+no
44	(disable-tty-output-modes pty #$ONLCR)
45	pty)
46
47
48	(defloadvar cocoa-listener-count 0)
49
50	(defclass cocoa-listener-process (process)
51	((input-stream :reader cocoa-listener-process-input-stream)
52	(output-stream :reader cocoa-listener-process-output-stream)
53	(input-peer-stream :reader cocoa-listener-process-input-peer-stream)
54	(backtrace-contexts :initform nil
55	:accessor cocoa-listener-process-backtrace-contexts)
56	(window :reader cocoa-listener-process-window)
57	(buffer :initform nil :reader cocoa-listener-process-buffer)))
58
59
60	(defun new-cocoa-listener-process (procname input-fd output-fd peer-fd window buffer)
61	(let* ((input-stream (ccl::make-selection-input-stream
62	input-fd
63	:peer-fd peer-fd
64	:elements-per-buffer (#_fpathconf
65	input-fd
66	#$_PC_MAX_INPUT)
67	:encoding :utf-8))
68	(output-stream (ccl::make-fd-stream output-fd :direction :output
69	:sharing :lock
70	:elements-per-buffer
71	(#_fpathconf
72	output-fd
73	#$_PC_MAX_INPUT)
74	:encoding :utf-8))
75	(peer-stream (ccl::make-fd-stream peer-fd :direction :output
76	:sharing :lock
77	:elements-per-buffer
78	(#_fpathconf
79	peer-fd
80	#$_PC_MAX_INPUT)
81	:encoding :utf-8))
82	(proc
83	(ccl::make-mcl-listener-process
84	procname
85	input-stream
86	output-stream
87	#'(lambda ()
88	(let* ((buf (find current-process hi:buffer-list
89	:key #'hi::buffer-process))
90	(doc (if buf (hi::buffer-document buf))))
91	(when doc
92	(setf (hi::buffer-process buf) nil)
93	(#/performSelectorOnMainThread:withObject:waitUntilDone:
94	doc
95	(@selector #/close)
96	+null-ptr+
97	nil))))
98	:initial-function
99	#'(lambda ()
100	(setq ccl::listener-autorelease-pool (create-autorelease-pool))
101	(ccl::listener-function))
102	:class 'cocoa-listener-process)))
103	(setf (slot-value proc 'input-stream) input-stream)
104	(setf (slot-value proc 'output-stream) output-stream)
105	(setf (slot-value proc 'input-peer-stream) peer-stream)
106	(setf (slot-value proc 'window) window)
107	(setf (slot-value proc 'buffer) buffer)
108	proc))
109
110
111	(defclass hemlock-listener-frame (hemlock-frame)
112	()
113	(:metaclass ns:+ns-object))
114	(declaim (special hemlock-listener-frame))
115
116
117	(defclass hemlock-listener-window-controller (hemlock-editor-window-controller)
118	((filehandle :foreign-type :id) ;Filehandle for I/O
119	(clientfd :foreign-type :int) ;Client (listener)'s side of pty
120	(nextra :foreign-type :int) ;count of untranslated bytes remaining
121	(translatebuf :foreign-type :address) ;buffer for utf8 translation
122	(bufsize :foreign-type :int) ;size of translatebuf
123	)
124	(:metaclass ns:+ns-object)
125	)
126	(declaim (special hemlock-listener-window-controller))
127
128	;;; Listener documents are never (or always) ediited. Don't cause their
129	;;; close boxes to be highlighted.
130	(objc:defmethod (#/setDocumentEdited: :void)
131	((self hemlock-listener-window-controller) (edited :<BOOL>))
132	(declare (ignorable edited)))
133
134
135	(objc:defmethod #/initWithWindow: ((self hemlock-listener-window-controller) w)
136	(let* ((new (call-next-method w)))
137	(unless (%null-ptr-p new)
138	(multiple-value-bind (server client) (ignore-errors (open-pty-pair))
139	(when server
140	(let* ((fh (make-instance
141	'ns:ns-file-handle
142	:with-file-descriptor (setup-server-pty server)
143	:close-on-dealloc t)))
144	(setf (slot-value new 'filehandle) fh)
145	(setf (slot-value new 'clientfd) (setup-client-pty client))
146	(let* ((bufsize #$BUFSIZ)
147	(buffer (#_malloc bufsize)))
148	(setf (slot-value new 'translatebuf) buffer
149	(slot-value new 'bufsize) bufsize
150	(slot-value new 'nextra) 0))
151	(#/addObserver:selector:name:object:
152	(#/defaultCenter ns:ns-notification-center)
153	new
154	(@selector #/gotData:)
155	#&NSFileHandleReadCompletionNotification
156	fh)
157	(#/readInBackgroundAndNotify fh)))))
158	new))
159
160	(objc:defmethod (#/gotData: :void) ((self hemlock-listener-window-controller)
161	notification)
162	(with-slots (filehandle nextra translatebuf bufsize) self
163	(let* ((data (#/objectForKey: (#/userInfo notification)
164	#&NSFileHandleNotificationDataItem))
165	(document (#/document self))
166	(encoding (load-time-value (get-character-encoding :utf-8)))
167	(data-length (#/length data))
168	(buffer (hemlock-document-buffer document))
169	(n nextra)
170	(cursize bufsize)
171	(need (+ n data-length))
172	(xlate translatebuf)
173	(fh filehandle))
174	(when (> need cursize)
175	(let* ((new (#_malloc need)))
176	(dotimes (i n) (setf (%get-unsigned-byte new i)
177	(%get-unsigned-byte xlate i)))
178	(#_free xlate)
179	(setq xlate new translatebuf new bufsize need)))
180	#+debug (#_NSLog #@"got %d bytes of data" :int data-length)
181	(with-macptrs ((target (%inc-ptr xlate n)))
182	(#/getBytes:range: data target (ns:make-ns-range 0 data-length)))
183	(let* ((total (+ n data-length)))
184	(multiple-value-bind (nchars noctets-used)
185	(funcall (ccl::character-encoding-length-of-memory-encoding-function encoding)
186	xlate
187	total
188	0)
189	(let* ((string (make-string nchars)))
190	(funcall (ccl::character-encoding-memory-decode-function encoding)
191	xlate
192	noctets-used
193	0
194	string)
195	(unless (zerop (setq n (- total noctets-used)))
196	;; By definition, the number of untranslated octets
197	;; can't be more than 3.
198	(dotimes (i n)
199	(setf (%get-unsigned-byte xlate i)
200	(%get-unsigned-byte xlate (+ noctets-used i)))))
201	(setq nextra n)
202	(hi::enqueue-buffer-operation
203	buffer
204	#'(lambda ()
205	(unwind-protect
206	(progn
207	(hi::buffer-document-begin-editing buffer)
208	(hemlock::append-buffer-output buffer string))
209	(hi::buffer-document-end-editing buffer))))
210	(#/readInBackgroundAndNotify fh)))))))
211
212
213
214	(objc:defmethod (#/dealloc :void) ((self hemlock-listener-window-controller))
215	(#/removeObserver: (#/defaultCenter ns:ns-notification-center) self)
216	(call-next-method))
217
218	(objc:defmethod #/windowTitleForDocumentDisplayName: ((self hemlock-listener-window-controller) name)
219	(let* ((doc (#/document self)))
220	(if (or (%null-ptr-p doc)
221	(not (%null-ptr-p (#/fileURL doc))))
222	(call-next-method name)
223	(let* ((buffer (hemlock-document-buffer doc))
224	(bufname (if buffer (hi::buffer-name buffer))))
225	(if bufname
226	(%make-nsstring bufname)
227	(call-next-method name))))))
228
229
230	;;; The HemlockListenerDocument class.
231
232
233	(defclass hemlock-listener-document (hemlock-editor-document)
234	()
235	(:metaclass ns:+ns-object))
236	(declaim (special hemlock-listener-document))
237
238	(defmethod update-buffer-package ((doc hemlock-listener-document) buffer)
239	(declare (ignore buffer)))
240
241	(defmethod hi::document-encoding-name ((doc hemlock-listener-document))
242	"UTF-8")
243
244	(defmethod user-input-style ((doc hemlock-listener-document))
245	hi::listener-input-style)
246
247	(defmethod textview-background-color ((doc hemlock-listener-document))
248	listener-background-color)
249
250
251	(defun hemlock::listener-document-send-string (document string)
252	(let* ((buffer (hemlock-document-buffer document))
253	(process (if buffer (hi::buffer-process buffer))))
254	(if process
255	(hi::send-string-to-listener-process process string))))
256
257
258	(objc:defmethod #/topListener ((self +hemlock-listener-document))
259	(let* ((all-documents (#/orderedDocuments NSApp)))
260	(dotimes (i (#/count all-documents) +null-ptr+)
261	(let* ((doc (#/objectAtIndex: all-documents i)))
262	(when (eql (#/class doc) self)
263	(return doc))))))
264
265	(defun symbol-value-in-top-listener-process (symbol)
266	(let* ((listenerdoc (#/topListener hemlock-listener-document))
267	(buffer (unless (%null-ptr-p listenerdoc)
268	(hemlock-document-buffer listenerdoc)))
269	(process (if buffer (hi::buffer-process buffer))))
270	(if process
271	(ignore-errors (symbol-value-in-process symbol process))
272	(values nil t))))
273
274	(defun hi::top-listener-output-stream ()
275	(let* ((doc (#/topListener hemlock-listener-document)))
276	(unless (%null-ptr-p doc)
277	(let* ((buffer (hemlock-document-buffer doc))
278	(process (if buffer (hi::buffer-process buffer))))
279	(when (typep process 'cocoa-listener-process)
280	(cocoa-listener-process-output-stream process))))))
281
282
283
284	(objc:defmethod (#/isDocumentEdited :<BOOL>) ((self hemlock-listener-document))
285	nil)
286
287
288
289	(objc:defmethod #/init ((self hemlock-listener-document))
290	(let* ((doc (call-next-method)))
291	(unless (%null-ptr-p doc)
292	(let* ((listener-name (if (eql 1 (incf cocoa-listener-count))
293	"Listener"
294	(format nil
295	"Listener-~d" cocoa-listener-count)))
296	(buffer (hemlock-document-buffer doc)))
297	(setf (hi::buffer-pathname buffer) nil
298	(hi::buffer-minor-mode buffer "Listener") t
299	(hi::buffer-name buffer) listener-name)
300	(hi::sub-set-buffer-modeline-fields buffer hemlock::listener-modeline-fields)))
301	doc))
302
303	(def-cocoa-default initial-listener-x-pos :float -100.0f0 "X position of upper-left corner of initial listener")
304
305	(def-cocoa-default initial-listener-y-pos :float 100.0f0 "Y position of upper-left corner of initial listener")
306
307	(defloadvar next-listener-x-pos nil) ; set after defaults initialized
308	(defloadvar next-listener-y-pos nil) ; likewise
309
310	(objc:defmethod (#/close :void) ((self hemlock-listener-document))
311	(if (zerop (decf cocoa-listener-count))
312	(setq next-listener-x-pos nil
313	next-listener-y-pos nil))
314	(call-next-method))
315
316	(objc:defmethod (#/makeWindowControllers :void) ((self hemlock-listener-document))
317	(let* ((textstorage (slot-value self 'textstorage))
318	(window (%hemlock-frame-for-textstorage
319	hemlock-listener-frame
320	textstorage
321	listener-columns
322	listener-rows
323	t
324	(textview-background-color self)
325	(user-input-style self)))
326	(listener-styles (#/arrayWithObjects: ns:ns-mutable-array
327	(rme-create-text-attributes
328	:font listener-input-font)
329	(rme-create-text-attributes
330	:font listener-output-font)
331	+null-ptr+))
332	(controller (make-instance
333	'hemlock-listener-window-controller
334	:with-window window))
335	(listener-name (hi::buffer-name (hemlock-document-buffer self))))
336	(with-slots (styles) textstorage
337	;; We probably should be more disciplined about
338	;; Cocoa memory management. Having retain/release in
339	;; random places all over the code is going to get
340	;; unwieldy.
341	(#/release styles)
342	(setf styles (#/retain listener-styles)))
343	;; Disabling background layout on listeners is an attempt to work
344	;; around a bug. The bug's probably gone ...
345	(let* ((layout-managers (#/layoutManagers textstorage)))
346	(dotimes (i (#/count layout-managers))
347	(let* ((layout (#/objectAtIndex: layout-managers i)))
348	(#/setBackgroundLayoutEnabled: layout nil))))
349	(#/setDelegate: (text-pane-text-view (slot-value window 'pane)) self)
350	(#/addWindowController: self controller)
351	(#/release controller)
352	(ns:with-ns-point (current-point
353	(or next-listener-x-pos
354	(x-pos-for-window window initial-listener-x-pos))
355	(or next-listener-y-pos
356	(y-pos-for-window window initial-listener-y-pos)))
357	(let* ((new-point (#/cascadeTopLeftFromPoint: window current-point)))
358	(setf next-listener-x-pos (ns:ns-point-x new-point)
359	next-listener-y-pos (ns:ns-point-y new-point))))
360	(setf (hi::buffer-process (hemlock-document-buffer self))
361	(let* ((tty (slot-value controller 'clientfd))
362	(peer-tty (#/fileDescriptor (slot-value controller 'filehandle))))
363	(new-cocoa-listener-process listener-name tty tty peer-tty window (hemlock-document-buffer self))))
364	controller))
365
366	(objc:defmethod (#/textView:shouldChangeTextInRange:replacementString: :<BOOL>)
367	((self hemlock-listener-document)
368	tv
369	(range :<NSR>ange)
370	string)
371	(declare (ignore tv string))
372	(let* ((range-start (ns:ns-range-location range))
373	(range-end (+ range-start (ns:ns-range-length range)))
374	(buffer (hemlock-document-buffer self))
375	(protected-region (hi::buffer-protected-region buffer)))
376	(if protected-region
377	(let* ((prot-start (mark-absolute-position (hi::region-start protected-region)))
378	(prot-end (mark-absolute-position (hi::region-end protected-region))))
379	(not (or (and (>= range-start prot-start)
380	(< range-start prot-end))
381	(and (>= range-end prot-start)
382	(< range-end prot-end)))))
383	t)))
384
385
386	;;; Action methods
387	(objc:defmethod (#/interrupt: :void) ((self hemlock-listener-document) sender)
388	(declare (ignore sender))
389	(let* ((buffer (hemlock-document-buffer self))
390	(process (if buffer (hi::buffer-process buffer))))
391	(when (typep process 'cocoa-listener-process)
392	(ccl::force-break-in-listener process))))
393
394
395
396	(objc:defmethod (#/exitBreak: :void) ((self hemlock-listener-document) sender)
397	(declare (ignore sender))
398	(let* ((buffer (hemlock-document-buffer self))
399	(process (if buffer (hi::buffer-process buffer))))
400	(when (typep process 'cocoa-listener-process)
401	(process-interrupt process #'abort-break))))
402
403	(defmethod listener-backtrace-context ((proc cocoa-listener-process))
404	(car (cocoa-listener-process-backtrace-contexts proc)))
405
406	(objc:defmethod (#/backtrace: :void) ((self hemlock-listener-document) sender)
407	(let* ((buffer (hemlock-document-buffer self))
408	(process (if buffer (hi::buffer-process buffer))))
409	(when (typep process 'cocoa-listener-process)
410	(let* ((context (listener-backtrace-context process)))
411	(when context
412	(#/showWindow: (backtrace-controller-for-context context) sender))))))
413
414	(defun restarts-controller-for-context (context)
415	(or (car (ccl::bt.restarts context))
416	(setf (car (ccl::bt.restarts context))
417	(let* ((tcr (ccl::bt.tcr context))
418	(tsp-range (inspector::make-tsp-stack-range tcr context))
419	(vsp-range (inspector::make-vsp-stack-range tcr context))
420	(csp-range (inspector::make-csp-stack-range tcr context))
421	(process (context-process context)))
422	(make-instance 'sequence-window-controller
423	:sequence (cdr (ccl::bt.restarts context))
424	:result-callback #'(lambda (r)
425	(process-interrupt
426	process
427	#'invoke-restart-interactively
428	r))
429	:display #'(lambda (item stream)
430	(let* ((ccl::aux-vsp-ranges vsp-range)
431	(ccl::aux-tsp-ranges tsp-range)
432	(ccl::aux-csp-ranges csp-range))
433	(princ item stream)))
434	:title (format nil "Restarts for ~a(~d), break level ~d"
435	(process-name process)
436	(process-serial-number process)
437	(ccl::bt.break-level context)))))))
438
439	(objc:defmethod (#/restarts: :void) ((self hemlock-listener-document) sender)
440	(let* ((buffer (hemlock-document-buffer self))
441	(process (if buffer (hi::buffer-process buffer))))
442	(when (typep process 'cocoa-listener-process)
443	(let* ((context (listener-backtrace-context process)))
444	(when context
445	(#/showWindow: (restarts-controller-for-context context) sender))))))
446
447	(objc:defmethod (#/continue: :void) ((self hemlock-listener-document) sender)
448	(declare (ignore sender))
449	(let* ((buffer (hemlock-document-buffer self))
450	(process (if buffer (hi::buffer-process buffer))))
451	(when (typep process 'cocoa-listener-process)
452	(let* ((context (listener-backtrace-context process)))
453	(when context
454	(process-interrupt process #'invoke-restart-interactively 'continue))))))
455
456
457
458
459
460
461	;;; Menu item action validation. It'd be nice if we could distribute this a
462	;;; bit better, so that this method didn't have to change whenever a new
463	;;; action was implemented in this class. For now, we have to do so.
464
465	(defmethod document-validate-menu-item ((doc hemlock-listener-document) item)
466	;; Return two values: the first is true if the second is definitive.
467	;; So far, all actions demand that there be an underlying process, so
468	;; check for that first.
469	(let* ((buffer (hemlock-document-buffer doc))
470	(process (if buffer (hi::buffer-process buffer))))
471	(if (typep process 'cocoa-listener-process)
472	(let* ((action (#/action item)))
473	(cond
474	((or (eql action (@selector #/revertDocumentToSaved:))
475	(eql action (@selector #/saveDocument:))
476	(eql action (@selector #/saveDocumentAs:)))
477	(values t nil))
478	((eql action (@selector #/interrupt:)) (values t t))
479	((eql action (@selector #/continue:))
480	(let* ((context (listener-backtrace-context process)))
481	(values
482	t
483	(and context
484	(find 'continue (cdr (ccl::bt.restarts context))
485	:key #'restart-name)))))
486	((or (eql action (@selector #/backtrace:))
487	(eql action (@selector #/exitBreak:))
488	(eql action (@selector #/restarts:)))
489	(values t
490	(not (null (listener-backtrace-context process)))))))
491	(values nil nil))))
492
493	(objc:defmethod (#/validateMenuItem: :<BOOL>)
494	((self hemlock-listener-document) item)
495	(multiple-value-bind (have-opinion opinion)
496	(document-validate-menu-item self item)
497	(if have-opinion
498	opinion
499	(call-next-method item))))
500
501	(defun shortest-package-name (package)
502	(let* ((name (package-name package))
503	(len (length name)))
504	(dolist (nick (package-nicknames package) name)
505	(let* ((nicklen (length nick)))
506	(if (< nicklen len)
507	(setq name nick len nicklen))))))
508
509	(defmethod ui-object-note-package ((app ns:ns-application) package)
510	(with-autorelease-pool
511	(process-interrupt cocoa-event-process
512	#'(lambda (proc name)
513	(dolist (buf hi::buffer-list)
514	(when (eq proc (hi::buffer-process buf))
515	(setf (hi::variable-value 'hemlock::current-package :buffer buf) name))))
516	current-process
517	(shortest-package-name package))))
518
519	;;; This is basically used to provide INPUT to the listener process, by
520	;;; writing to an fd which is conntected to that process's standard
521	;;; input.
522	(defmethod hi::send-string-to-listener-process ((process cocoa-listener-process)
523	string &key path package)
524	(let* ((stream (cocoa-listener-process-input-peer-stream process)))
525	(labels ((out-raw-char (ch)
526	(write-char ch stream))
527	(out-ch (ch)
528	(when (or (eql ch #\^v)
529	(eql ch #\^p)
530	(eql ch #\newline)
531	(eql ch #\^q)
532	(eql ch #\^d))
533	(out-raw-char #\^q))
534	(out-raw-char ch))
535	(out-string (s)
536	(dotimes (i (length s))
537	(out-ch (char s i)))))
538	(out-raw-char #\^p)
539	(when package (out-string package))
540	(out-raw-char #\newline)
541	(out-raw-char #\^v)
542	(when path (out-string path))
543	(out-raw-char #\newline)
544	(out-string string)
545	(out-raw-char #\^d)
546	(force-output stream))))
547
548
549	(defun hemlock::evaluate-input-selection (selection)
550	(ccl::application-ui-operation application :eval-selection selection))
551
552	(defmethod ui-object-choose-listener-for-selection ((app ns:ns-application)
553	selection)
554	(declare (ignore selection))
555	(#/performSelectorOnMainThread:withObject:waitUntilDone:
556	(#/delegate NSApp) (@selector #/ensureListener:) +null-ptr+ #$YES)
557	(let* ((top-listener-document (#/topListener hemlock-listener-document)))
558	(if top-listener-document
559	(let* ((buffer (hemlock-document-buffer top-listener-document)))
560	(if buffer
561	(let* ((proc (hi::buffer-process buffer)))
562	(if (typep proc 'cocoa-listener-process)
563	proc)))))))
564
565	(defmethod ui-object-eval-selection ((app ns:ns-application)
566	selection)
567	(let* ((target-listener (ui-object-choose-listener-for-selection
568	app selection)))
569	(if (typep target-listener 'cocoa-listener-process)
570	(destructuring-bind (package path string) selection
571	(hi::send-string-to-listener-process target-listener string :package package :path path)))))
572
573	(defmethod ui-object-load-buffer ((app ns:ns-application) selection)
574	(let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
575	(if (typep target-listener 'cocoa-listener-process)
576	(destructuring-bind (package path) selection
577	(let ((string (format nil "(load ~S)" path)))
578	(hi::send-string-to-listener-process target-listener string :package package :path path))))))
579
580	(defmethod ui-object-compile-buffer ((app ns:ns-application) selection)
581	(let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
582	(if (typep target-listener 'cocoa-listener-process)
583	(destructuring-bind (package path) selection
584	(let ((string (format nil "(compile-file ~S)" path)))
585	(hi::send-string-to-listener-process target-listener string :package package :path path))))))
586
587	(defmethod ui-object-compile-and-load-buffer ((app ns:ns-application) selection)
588	(let* ((target-listener (ui-object-choose-listener-for-selection app nil)))
589	(if (typep target-listener 'cocoa-listener-process)
590	(destructuring-bind (package path) selection
591	(let ((string (format nil "(progn (compile-file ~S)(load ~S))"
592	path
593	(make-pathname :directory (pathname-directory path)
594	:name (pathname-name path)
595	:type (pathname-type path)))))
596	(hi::send-string-to-listener-process target-listener string :package package :path path))))))
597
598
599

Note: See TracBrowser for help on using the repository browser.

Download in other formats: