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))