[mcclim-cvs] CVS mcclim/Drei

[ahefner]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory cl-net:/tmp/cvs-serv19226/Drei

Modified Files:
	drei-clim.lisp input-editor.lisp 
Log Message:
Handle selection-notify-events in the text gadget and input editor.
For communicating with the input editor, signal and handle a 
selection-notify condition from the lower level event handler (I can't
think of a better approach to communicating across the layers). Disable
the old default of pasting by synthesizing keypress events, but make it
available via paste-as-keypress-mixin.



--- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp	2008/10/23 20:47:57	1.46
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp	2009/06/03 20:33:16	1.47
@@ -292,6 +292,15 @@
 gesture is, for example, one that is not simply a click on a
 modifier key."))
 
+(defun propagate-changed-value (drei)
+  (when (modified-p (view drei))
+    (when (gadget-value-changed-callback drei)
+      (value-changed-callback drei
+                              (gadget-client drei)
+                              (gadget-id drei)
+                              (gadget-value drei)))
+    (setf (modified-p (view drei)) nil)))
+
 (defmethod handle-gesture ((drei drei-gadget-pane) gesture)
   (let ((*command-processor* drei)
         (*abort-gestures* *esa-abort-gestures*)
@@ -303,13 +312,7 @@
         (abort-gesture ()
           (display-message "Aborted")))
       (display-drei drei :redisplay-minibuffer t)
-      (when (modified-p (view drei))
-        (when (gadget-value-changed-callback drei)
-          (value-changed-callback drei
-                                  (gadget-client drei)
-                                  (gadget-id drei)
-                                  (gadget-value drei)))
-        (setf (modified-p (view drei)) nil)))))
+      (propagate-changed-value drei))))
 
 ;;; This is the method that functions as the entry point for all Drei
 ;;; gadget logic.
@@ -321,6 +324,16 @@
           (with-bound-drei-special-variables (gadget :prompt (format nil "~A " (gesture-name gesture)))
             (handle-gesture gadget gesture)))))))
 
+(defmethod handle-event ((gadget drei-gadget-pane)
+                         (event clim-backend:selection-notify-event))
+  ;; Cargo-culted from above:
+  (unless (and (currently-processing-p gadget) (directly-processing-p gadget))
+    (letf (((currently-processing-p gadget) t))
+      (insert-sequence (point (view gadget)) 
+                       (clim-backend:get-selection-from-event (port gadget) event))
+      (display-drei gadget :redisplay-minibuffer t)
+      (propagate-changed-value gadget))))
+
 (defmethod handle-event :before 
     ((gadget drei-gadget-pane) (event pointer-button-press-event))
   (let ((previous (stream-set-input-focus gadget)))
--- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2008/06/29 23:36:27	1.49
+++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp	2009/06/03 20:33:16	1.50
@@ -586,6 +586,13 @@
                                                       finally (return 0))
                                                 t t)
                  (handler-case (process-gestures-or-command drei)
+                   (climi::selection-notify (c)
+                     (let* ((event (climi::event-of c))
+                            (sheet (event-sheet event))
+                            (port  (port sheet)))
+                       (when (eq *standard-input* sheet)
+                         (insert-sequence (point (view drei))
+                                          (clim-backend:get-selection-from-event port event)))))
                    (unbound-gesture-sequence (c)
                      (display-message "~A is unbound" (gesture-name (gestures c))))
                    (abort-gesture (c)