[mcclim-devel] [PATCH] hollow cursors for unfocused text-fields

[Rudi Schlatte]

Hi,

Another one I'm not quite sure of ...  displaying of hollow/filled  
cursor upon mouse enter/exit seems to work ok, and it's nice to see  
where a keystroke will end up ...  The only drawback is that the user  
can't change cursor visibility in :armed-callback / :disarmed- 
callback functions.

Nevertheless, I think I'll check this in after a few days if there  
are no objections.

Cheers,

Rudi


Index: gadgets.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/gadgets.lisp,v
retrieving revision 1.90
diff -u -r1.90 gadgets.lisp
--- gadgets.lisp    23 May 2005 12:43:34 -0000    1.90
+++ gadgets.lisp    24 Sep 2005 14:27:03 -0000
@@ -2642,6 +2642,33 @@
      (setf (port-keyboard-input-focus port) (previous-focus gadget))
      (setf (previous-focus gadget) nil)))
+
+;;; also, hack the full/hollow cursor displaying -- don't leave
+;;; artifacts when the value of the gadget is called during arm/disarm
+;;; events (otherwise, a hollow cursor is "erased" with a full one and
+;;; vice versa).
+;;; BUG (rudi 2005-09-24): this code overwrites changes to cursor
+;;; visibility within a user-supplied armed-callback /
+;;; disarmed-callback, though ...
+
+(defmethod handle-event :around ((pane text-field-pane)
+                                 (event pointer-enter-event))
+  (let* ((area (area pane))
+         (cursor-p (cursor-visibility area)))
+    (when cursor-p (setf (cursor-visibility area) nil))
+    (call-next-method)
+    (when (and cursor-p (not (cursor-visibility area)))
+      (setf (cursor-visibility area) cursor-p))))
+
+(defmethod handle-event :around ((pane text-field-pane)
+                                 (event pointer-exit-event))
+  (let* ((area (area pane))
+         (cursor-p (cursor-visibility area)))
+    (when cursor-p (setf (cursor-visibility area) nil))
+    (call-next-method)
+    (when (and cursor-p (not (cursor-visibility area)))
+      (setf (cursor-visibility area) cursor-p))))
+
(defmethod handle-event ((gadget text-field-pane) (event key-press- 
event))
    (let ((gesture (convert-to-gesture event))
      (*activation-gestures* (activation-gestures gadget)))
Index: stream-output.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/stream-output.lisp,v
retrieving revision 1.56
diff -u -r1.56 stream-output.lisp
--- stream-output.lisp    13 Aug 2005 14:28:20 -0000    1.56
+++ stream-output.lisp    24 Sep 2005 14:27:07 -0000
@@ -142,7 +142,7 @@
      (draw-rectangle* (sheet-medium (cursor-sheet cursor))
               x y
               (+ x width) (+ y height)
-             :filled t
+             :filled (slot-value (cursor-sheet cursor) 'armed)
               :ink +flipping-ink+)))))
(defmethod display-cursor ((cursor cursor-mixin) state)
@@ -154,7 +154,7 @@
      (:draw (draw-rectangle* (sheet-medium (cursor-sheet cursor))
                  x y
                  (+ x width) (+ y height)
-                :filled t
+                :filled (slot-value (cursor-sheet cursor) 'armed)
                  :ink +foreground-ink+
                  ))
          (:erase
@@ -168,7 +168,7 @@
                  (draw-rectangle* (sheet-medium (cursor-sheet cursor))
                                   x y
                                   (+ x width) (+ y height)
-                                 :filled t
+                                 :filled (slot-value (cursor-sheet  
cursor) 'armed)
                                   :ink +background-ink+))))))
;;; Standard-Text-Cursor class

-------------- next part --------------
A non-text attachment was scrubbed...
Name: PGP.sig
Type: application/pgp-signature
Size: 186 bytes
Desc: This is a digitally signed message part
URL: <https://mailman.common-lisp.net/pipermail/mcclim-devel/attachments/20050924/8b5201b7/attachment.sig>