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

Last change on this file since 7579 was 7579, checked in by rme, 13 years ago

De-kludge defining font defaults a little bit.

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