[mcclim-cvs] CVS update: mcclim/stream-output.lisp mcclim/gadgets.lisp

[Rudi Schlatte]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv20252

Modified Files:
	stream-output.lisp gadgets.lisp 
Log Message:
Draw hollow or filled cursor in text-field gadget, depending on
whether the gadget is armed or not.

Date: Wed Oct 12 16:22:28 2005
Author: rschlatte

Index: mcclim/stream-output.lisp
diff -u mcclim/stream-output.lisp:1.56 mcclim/stream-output.lisp:1.57
--- mcclim/stream-output.lisp:1.56	Sat Aug 13 16:28:20 2005
+++ mcclim/stream-output.lisp	Wed Oct 12 16:22:27 2005
@@ -78,6 +78,9 @@
    (x :initform 0 :initarg :x-position)
    (y :initform 0 :initarg :y-position)
    (width :initform 8)
+   (appearance :type (member :solid :hollow) 
+               :initarg :appearance :initform :hollow
+               :accessor cursor-appearance)
    ;; XXX what does "cursor is active" mean?
    ;; It means that the sheet (stream) updates the cursor, though
    ;; currently the cursor appears to be always updated after stream
@@ -142,7 +145,8 @@
 	(draw-rectangle* (sheet-medium (cursor-sheet cursor))
 			 x y
 			 (+ x width) (+ y height)
-			 :filled t
+			 :filled (ecase (cursor-appearance cursor)
+                                   (:solid t) (:hollow nil))
 			 :ink +flipping-ink+)))))
 
 (defmethod display-cursor ((cursor cursor-mixin) state)
@@ -154,7 +158,8 @@
 	(:draw (draw-rectangle* (sheet-medium (cursor-sheet cursor))
 				x y
 				(+ x width) (+ y height)
-				:filled t
+				:filled (ecase (cursor-appearance cursor)
+                                   (:solid t) (:hollow nil))
 				:ink +foreground-ink+
 				))       
         (:erase
@@ -168,7 +173,8 @@
                 (draw-rectangle* (sheet-medium (cursor-sheet cursor))
                                  x y
                                  (+ x width) (+ y height)
-                                 :filled t
+                                 :filled (ecase (cursor-appearance cursor)
+                                   (:solid t) (:hollow nil))
                                  :ink +background-ink+))))))
 
 ;;; Standard-Text-Cursor class


Index: mcclim/gadgets.lisp
diff -u mcclim/gadgets.lisp:1.90 mcclim/gadgets.lisp:1.91
--- mcclim/gadgets.lisp:1.90	Mon May 23 14:43:34 2005
+++ mcclim/gadgets.lisp	Wed Oct 12 16:22:27 2005
@@ -2634,13 +2634,20 @@
   (declare (ignore client id))
   (let ((port (port gadget)))    
     (setf (previous-focus gadget) (port-keyboard-input-focus port))
-    (setf (port-keyboard-input-focus port) gadget)))
+    (setf (port-keyboard-input-focus port) gadget))
+  (let ((cursor (cursor (area gadget))))
+    (letf (((cursor-state cursor) nil))
+      (setf (cursor-appearance cursor) :solid))))
 
 (defmethod disarmed-callback :after ((gadget text-field-pane) client id)
   (declare (ignore client id))
   (let ((port (port gadget)))
     (setf (port-keyboard-input-focus port) (previous-focus gadget))
-    (setf (previous-focus gadget) nil)))
+    (setf (previous-focus gadget) nil))
+  (let ((cursor (cursor (area gadget))))
+    (letf (((cursor-state cursor) nil))
+      (setf (cursor-appearance cursor) :hollow))))
+
 
 (defmethod handle-event ((gadget text-field-pane) (event key-press-event))
   (let ((gesture (convert-to-gesture event))