Changeset 722

Timestamp:

Mar 24, 2004, 5:07:25 PM (21 years ago)

Author:

Gary Byers

Message:

EVAL-SELECTION ui methods.

File:

• trunk/ccl/examples/cocoa-listener.lisp (modified) (3 diffs)

trunk/ccl/examples/cocoa-listener.lisp

@@ -253 +253 @@
           (setq name nick len nicklen))))))
 
-(defun cocoa-ide-note-package (package)
+(defmethod ui-object-note-package ((app ns:ns-application) package)
   (with-autorelease-pool
       (process-interrupt *cocoa-event-process*
@@ -270 +270 @@
                                           (make-string-input-stream string))))
     (enqueue-input-selection (cocoa-listener-process-input-stream process) selection)))
+
+
+(defun hemlock::evaluate-input-selection (selection)
+  (application-ui-operation *application* :eval-selection selection))
+                            
+(defmethod ui-object-choose-listener-for-selection ((app ns:ns-application)
+                                                    selection)
+  (declare (ignore selection))
+  (let* ((top-listener-document (send (find-class 'hemlock-listener-document)
+                                      'top-listener)))
+    (if top-listener-document
+      (let* ((buffer (hemlock-document-buffer top-listener-document)))
+        (if buffer
+          (let* ((proc (hi::buffer-process buffer)))
+            (if (typep proc 'cocoa-listener-process)
+              proc)))))))
+
+(defmethod ui-object-eval-selection ((app ns:ns-application)
+                                     selection)
+  (let* ((target-listener (ui-object-choose-listener-for-selection
+                           app selection)))
+    (if (typep target-listener 'cocoa-listener-process)
+      (enqueue-input-selection (cocoa-listener-process-input-stream
+                                target-listener)
+                               selection))))
   
 
@@ -275 +300 @@
                                    operation &rest args)
   (case operation
-    (:note-current-package (cocoa-ide-note-package (car args)))))
+    (:note-current-package (ui-object-note-package o (car args)))
+    (:eval-selection (ui-object-eval-selection o (car args)))))
+