[mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp
Duncan Rose
drose at common-lisp.net
Sun Jun 5 19:52:56 UTC 2005
Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input
In directory common-lisp.net:/tmp/cvs-serv29931/beagle/input
Modified Files:
events.lisp
Log Message:
Some code rearrangement whilst investigating some event handling strangeness
(events are added to the queue for 'drop down' menus, but dispatch event
is not executed whilst the 'unmanaged' window is on screen).
Added the first native pane type for scroller panes. Still a bunch of stuff
to do on this (need to create 'native' scroll-pane type too so scroll bars
are drawn the right way around (:vertical on RHS), and they don't yet
behave like you'd expect).
Date: Sun Jun 5 21:52:55 2005
Author: drose
Index: mcclim/Backends/beagle/input/events.lisp
diff -u mcclim/Backends/beagle/input/events.lisp:1.7 mcclim/Backends/beagle/input/events.lisp:1.8
--- mcclim/Backends/beagle/input/events.lisp:1.7 Fri Jun 3 23:33:09 2005
+++ mcclim/Backends/beagle/input/events.lisp Sun Jun 5 21:52:55 2005
@@ -28,7 +28,7 @@
#||
-$Id: events.lisp,v 1.7 2005/06/03 21:33:09 drose Exp $
+$Id: events.lisp,v 1.8 2005/06/05 19:52:55 drose Exp $
Events in Cocoa
---------------
@@ -126,6 +126,7 @@
;;; beagle-event|notification-to-clim-event method differs
;;; between them.
+
(defmethod add-event-to-queue (mirror event)
"Adds an event to the dynamically scoped *mcclim-event-queue* queue, after
conversion from a Cocoa event MACPTR to a CLIM event. This method signals
@@ -136,6 +137,13 @@
*mcclim-event-queue*))
(let ((clim-event (beagle-event-to-clim-event mirror event)))
(unless (not clim-event)
+ ;; This provides way too much information...
+ #+nil
+ (unless (or (typep event 'pointer-enter-event)
+ (typep event 'pointer-exit-event))
+ (format *trace-output* "Adding event to queue: ")
+ (describe-object clim-event *trace-output*)
+ (terpri *trace-output*))
(setf *mcclim-event-queue* (nconc *mcclim-event-queue* (list clim-event)))
(ccl:signal-semaphore (beagle-port-event-semaphore *beagle-port*)))))
@@ -271,8 +279,6 @@
;;; detail members for X11 enter and exit events.
;;;
-;; I'm not sure this is the best way with dealing with the timestamp...
-
(defun notification-type (notification)
"Enumerates all the Cocoa notifications Beagle takes an interest in. These
are all NSWindow delegate notifications."
@@ -363,7 +369,8 @@
(setf *-current-pointer-button-state*- state))
-(defun make-mouse-up-down-event (event-type button location-in-view-point location-in-screen-point
+(defun make-mouse-up-down-event (event-type button location-in-view-point
+ location-in-screen-point
mirror event)
(make-instance (if (eq :mouse-up event-type)
'pointer-button-release-event
@@ -382,6 +389,7 @@
;; coordinates. Can do this with
;; [window convertBaseToScreen:location-in-window].x or .y.
;; They probably need coercing too :-(
+
:x (pref location-in-view-point :<NSP>oint.x)
:y (pref location-in-view-point :<NSP>oint.y)
:graft-x (pref location-in-screen-point :<NSP>oint.x)
@@ -391,7 +399,8 @@
:timestamp (get-internal-real-time)))
-(defun make-mouse-enter-exit-event (event-type location-in-view-point location-in-screen-point
+(defun make-mouse-enter-exit-event (event-type location-in-view-point
+ location-in-screen-point
mirror event)
(make-instance (if (eq :mouse-enter event-type)
'pointer-enter-event
@@ -407,7 +416,8 @@
:timestamp (get-internal-real-time)))
-(defun make-pointer-motion-event (button location-in-view-point location-in-screen-point
+(defun make-pointer-motion-event (button location-in-view-point
+ location-in-screen-point
mirror event)
(make-instance 'pointer-motion-event
:pointer 0
@@ -428,6 +438,7 @@
;; :y to be relative to the MIRROR in which the events occur.
;; :x (pref location-in-screen-point :<NSP>oint.x)
;; :y (pref location-in-screen-point :<NSP>oint.y)
+
:x (pref location-in-view-point :<NSP>oint.x)
:y (pref location-in-view-point :<NSP>oint.y)
;; Even though graft-x, graft-y is *not in the spec* we need to populate
@@ -508,6 +519,7 @@
;; We ignore this, and always pass up or down and let
;; CLIM set the amount. Could do better with scroll wheel
;; events, CLIM also ignores X and Z deltas...
+
:button (if (plusp (send event 'delta-y))
(progn
(set-hacky-button-state +pointer-wheel-up+)
@@ -598,20 +610,20 @@
(cond
((or (eq :mouse-up event-type) (eq :mouse-down event-type))
(with-native-view-and-screen-locations (event window mirror)
- (make-mouse-up-down-event event-type
- button
- locn-in-view-pt
- locn-in-screen-pt
- mirror
- event)))
+ (make-mouse-up-down-event event-type
+ button
+ locn-in-view-pt
+ locn-in-screen-pt
+ mirror
+ event)))
((eq :mouse-moved event-type)
(with-native-view-and-screen-locations (event window mirror)
- (make-pointer-motion-event button
- locn-in-view-pt
- locn-in-screen-pt
- mirror
- event)))
+ (make-pointer-motion-event button
+ locn-in-view-pt
+ locn-in-screen-pt
+ mirror
+ event)))
((or (eq :mouse-enter event-type) (eq :mouse-exit event-type))
#+nil
@@ -620,15 +632,15 @@
(format *debug-io* "Got ~a event on sheet ~a~%"
event-type view-sheet)))
(with-native-view-and-screen-locations (event window mirror)
- ;; This event does not provide button state, but we can use
- ;; *-current-pointer-button-state-* to populate button state
- ;; in the CLIM event. Obviously, we do not need to update this value
- ;; (*-current-pointer-button-state-*) for enter / exit events...
- (make-mouse-enter-exit-event event-type
- locn-in-view-pt
- locn-in-screen-pt
- mirror
- event)))
+ ;; This event does not provide button state, but we can use
+ ;; *-current-pointer-button-state-* to populate button state
+ ;; in the CLIM event. Obviously, we do not need to update this value
+ ;; (*-current-pointer-button-state-*) for enter / exit events...
+ (make-mouse-enter-exit-event event-type
+ locn-in-view-pt
+ locn-in-screen-pt
+ mirror
+ event)))
((eq :scroll-wheel event-type)
(make-scroll-wheel-event event
@@ -685,8 +697,6 @@
:timestamp (get-internal-real-time)))))))
-;;; This is really, really horribly written. Hopefully it will just be
-;;; temporary.
(defun current-mods-map-to-key (current-modifier-state)
(declare (special *-current-event-modifier-state-*))
;; Are there modifiers in 'current-modifier-state' that don't exist in
@@ -699,6 +709,7 @@
;;#$NSCommandKeyMask +meta-key+
;;#$NSAlternateKeyMask +super-key+
;;#$NSAlphaShiftKeyMask +hyper-key+
+
(cond ((null *-current-event-modifier-state-*)
'(key-release-event nil))
((and (> (logand *-current-event-modifier-state-* +shift-key+) 0)
@@ -748,6 +759,8 @@
;; Again, make use of Cocoa methods for querying the pointer position. See above ::FIXME::
(defmethod pointer-position ((pointer beagle-pointer))
+;; Could make use of something like the following
+;; (send (@class ns:ns-event) 'mouse-location)
(warn "pointer-position: implement me")
nil)
@@ -776,12 +789,10 @@
(unless (eq (beagle-port-key-focus port) focus)
(let ((mirror (sheet-mirror focus)))
(if (null mirror)
- (format *trace-output* "Attempt to set keyboard focus on sheet ~a which has no mirror!~%"
- focus)
+ (warn "Attempt to set keyboard focus on sheet ~a which has no mirror!" focus)
(let ((window (send mirror 'window)))
(if (eql window (%null-ptr))
- (format *trace-output* "Attempt to set keyboard focus on sheet ~a with no NSWindow!~%"
- focus)
+ (warn "Attempt to set keyboard focus on sheet ~a with no NSWindow!" focus)
(progn
(setf (beagle-port-key-focus port) focus)
(unless (send window 'is-key-window)
@@ -843,16 +854,12 @@
(call-next-method)))
(defun characters-to-key-name (ns-string-characters-in)
-;;; (format *terminal-io* "Processing ~S~%" ns-string-characters-in)
-;;; (format *terminal-io* "Got string with length ~A~%" (send ns-string-characters-in 'length))
-;;; (format *terminal-io* "character(0) = ~A~%"
-;;; (char-code (send ns-string-characters-in :character-at-index 0)))
(if (<= (send ns-string-characters-in :character-at-index 0) 255)
(numeric-keysym-to-character (send ns-string-characters-in :character-at-index 0))
(progn
(let ((key-name (lookup-keysym (send ns-string-characters-in :character-at-index 0))))
- ;; If key-name is nil after all that, see if we can look up a mapping from those supported in
- ;; Cocoa...
+ ;; If key-name is nil after all that, see if we can look up a mapping from those
+ ;; supported in Cocoa...
(cond
((null key-name)
(let ((clim-key
More information about the Mcclim-cvs
mailing list