;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(MEDFNB hl12B hl12bi) -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved. ;;; Change history: ;;; ;;; Date Author Description ;;; ------------------------------------------------------------------------------------- ;;; 03/14/89 WJB Patch 1.43; Allow protocol violation in Grab-Pointer for event-mask ;;; if *mit-compatibility* is on. Fixes xterm's Ctrl-Middle menu. ;;; 02/22/89 WJB Patch 1.19: Lock cursor in UNGRAB-POINTER to prevent mouse turds. ;;; 02/02/89 WJB Patch 1.5: avoid cursor lock condition in GRAB-POINTER. ;;; 12/121*/88 1LGO* 1Fix reply length in GET-POINTER-MAPPING.* ;;; 12/09/88 DAN Fixed CHANGE-ACTIVE-POINTER-GRAB to exit if pointer not grabbed. ;;; 11/17/88 WJB WARP-POINTER was using the supplied X value for both X and Y. ;;; 9/28/88 DAN Fixed GRAB-POINTER to correctly determine if pointer is FROZEN. ;;; 9/28/88 LGO Use correct keyboard-mode data-type in GRAB-POINTER ;;; 9/27/88 DAN Fixed a bug in GRAB-POINTER. ;;; 9/12/88 LGO Fixed many bugs in GRAB-BUTTON ;;; 9/09/88 LGO Make SET-POINTER-MAPPING and GET-POINTER-MAPPING work ;;; 9/08/88 LGO Fix GET-MOTION-EVENTS to call READ-HISTORY-EVENT-RANGE correctly ;;; 9/08/88 LGO Fix GET-MOTION-EVENTS to convert client-time to server-time ;;; 5/12/88 TWE Translated all of the other C functions to Lisp. ;;; 5/11/88 TWE Wrote WARP-POINTER. ;;; 2/23/88 TWE Even more C code. ;;; 2/22/88 TWE Inserted more C code for other requests. ;;; 2/18/88 TWE Inserted the C code which implements warp-pointer. ;;; 12/15/87 TWE Moved requests from the REQUESTS file. (DEFREQ WARP-POINTER ((SRC-WINDOW (ONEOF WINDOW)) (DST-WINDOW (ONEOF WINDOW)) (SRC-X INT16) (SRC-Y INT16) (SRC-WIDTH CARD16) (SRC-HEIGHT CARD16) (DST-X INT16) (DST-Y INT16)) (WHEN (eql SRC-WINDOW 0) (SETQ SRC-WINDOW NIL)) (WHEN (eql DST-WINDOW 0) (SETQ DST-WINDOW NIL)) (WARP-POINTER STATE SRC-WINDOW DST-WINDOW SRC-X SRC-Y SRC-WIDTH SRC-HEIGHT DST-X DST-Y)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN POINT-IN-WINDOW-IS-VISIBLE (WINDOW X Y) (DECLARE (TYPE WINDOW WINDOW) (TYPE INTEGER X Y)) ; In root (LET ((OCCLUSION-STACK (WINDOW.OCCLUSION-STACK WINDOW)) (ABS-X (WINDOW.ABSOLUTE-X-CORNER WINDOW)) (ABS-Y (WINDOW.ABSOLUTE-Y-CORNER WINDOW))) (COND ((NOT (WINDOW.REALIZED-P WINDOW)) NIL) ((NULL OCCLUSION-STACK) ;; Not visible at all. NIL) ((AND (EQ OCCLUSION-STACK T) (<= ABS-X X (+ ABS-X (WINDOW.OUTSIDE-WIDTH WINDOW))) (<= ABS-Y Y (+ ABS-Y (WINDOW.OUTSIDE-HEIGHT WINDOW)))) ;; The window is not obscured and the point is inside the window. T) (T ;; The window is partially obscured. Look at each box to ;; see if it is inside one of them. (DOLIST (BOX OCCLUSION-STACK NIL) (WHEN (INSIDE-P BOX X Y) (RETURN T))))))) (DEFUN WARP-POINTER (STATE SOURCE-WINDOW DESTINATION-WINDOW SOURCE-X SOURCE-Y SOURCE-WIDTH SOURCE-HEIGHT DESTINATION-X DESTINATION-Y) (DECLARE (TYPE STATE STATE) (TYPE INTEGER SOURCE-X SOURCE-Y SOURCE-WIDTH SOURCE-HEIGHT DESTINATION-X DESTINATION-Y) (TYPE (OR NULL WINDOW) SOURCE-WINDOW DESTINATION-WINDOW) (IGNORE STATE)) (SERVER-TRACE "~%ENTERING WARP-POINTER") (LET (WINDOW-X WINDOW-Y NEW-SCREEN X Y) (COND ((AND SOURCE-WINDOW (SETQ WINDOW-X (WINDOW.ABSOLUTE-INSIDE-X SOURCE-WINDOW) WINDOW-Y (WINDOW.ABSOLUTE-INSIDE-Y SOURCE-WINDOW)) (OR (< (HOT-SPOT.X (SPRITE.HOT SPRITE)) (+ WINDOW-X SOURCE-X)) (< (HOT-SPOT.Y (SPRITE.HOT SPRITE)) (+ WINDOW-Y SOURCE-Y)) (AND (NOT (ZEROP SOURCE-WIDTH)) (< (+ WINDOW-X SOURCE-X SOURCE-WIDTH) (HOT-SPOT.X (SPRITE.HOT SPRITE)))) (AND (NOT (ZEROP SOURCE-HEIGHT)) (< (+ WINDOW-Y SOURCE-Y SOURCE-WIDTH) (HOT-SPOT.Y (SPRITE.HOT SPRITE)))) (NOT (POINT-IN-WINDOW-IS-VISIBLE SOURCE-WINDOW (HOT-SPOT.X (SPRITE.HOT SPRITE)) (HOT-SPOT.Y (SPRITE.HOT SPRITE)))))) (SERVER-TRACE "~%IN WARP-POINTER, nothing to do.") ;; All done. T) (T (COND (DESTINATION-WINDOW (SETQ X (+ (WINDOW.ABSOLUTE-INSIDE-X DESTINATION-WINDOW) DESTINATION-X) Y (+ (WINDOW.ABSOLUTE-INSIDE-Y DESTINATION-WINDOW) DESTINATION-Y) NEW-SCREEN (SCREEN-FOR-WINDOW DESTINATION-WINDOW))) (T (SETQ X (+ (HOT-SPOT.X (SPRITE.HOT SPRITE)) DESTINATION-X) Y (+ (HOT-SPOT.Y (SPRITE.HOT SPRITE)) DESTINATION-Y) NEW-SCREEN CURRENT-SCREEN))) (IF (MINUSP X) (SETQ X 0) ;;ELSE (IF (>= X (SCREEN.WIDTH NEW-SCREEN)) (SETQ X (1- (SCREEN.WIDTH NEW-SCREEN))))) (IF (MINUSP Y) (SETQ Y 0) ;;ELSE (IF (>= Y (SCREEN.HEIGHT NEW-SCREEN)) (SETQ Y (1- (SCREEN.HEIGHT NEW-SCREEN))))) (SERVER-TRACE "~%IN WARP-POINTER, moving to (~D,~D)" X Y) (IF (EQ NEW-SCREEN CURRENT-SCREEN) ;; Send a pointer motion event to PROCESS-POINTER-EVENT, just as the ;; device dependent driver does when the hardware moves the pointer. (PROGN (EXPLORER-SET-CURSOR-POSITION NEW-SCREEN X Y T) (EXPLORER-RESTORE-CURSOR)) ;;ELSE (LET ((GRAB (DEVICE.GRAB (INPUT-INFO.POINTER INPUT-INFO)))) (IF (OR (NULL GRAB) (NOT (GRAB-RECORD.CONFINE-TO GRAB))) (NEW-CURRENT-SCREEN NEW-SCREEN X Y))))))) (SERVER-TRACE "~%EXITING WARP-POINTER")) (DEFREQ CHANGE-POINTER-CONTROL ((ACCEL-NUM (INT16 -1)) (ACCEL-DEN (INT16 -1)) (THRESHOLD (INT16 -1)) (DO-ACCEL BOOL) (DO-THRESH BOOL)) (SETQ DO-ACCEL (= DO-ACCEL TRUE) DO-THRESH (= DO-THRESH TRUE)) (CHANGE-POINTER-CONTROL STATE ACCEL-NUM ACCEL-DEN THRESHOLD DO-ACCEL DO-THRESH)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN CHANGE-POINTER-CONTROL (STATE ACCEL-NUM ACCEL-DEN THRESHOLD DO-ACCEL DO-THRESH) (DECLARE (TYPE STATE STATE) (TYPE INTEGER ACCEL-NUM ACCEL-DEN THRESHOLD) (TYPE BOOLEAN DO-ACCEL DO-THRESH) (IGNORE STATE)) (LET* ((MOUSE (INPUT-INFO.POINTER INPUT-INFO)) (CONTROL (DEVICE.POINTER-CONTROL MOUSE))) (WHEN DO-ACCEL (SETF (POINTER-CONTROL.NUMERATOR CONTROL) (IF (= ACCEL-NUM -1) (POINTER-CONTROL.NUMERATOR DEFAULT-POINTER-CONTROL) ;;ELSE ACCEL-NUM)) (SETF (POINTER-CONTROL.DENOMINATOR CONTROL) (IF (= ACCEL-DEN -1) (POINTER-CONTROL.NUMERATOR DEFAULT-POINTER-CONTROL) ;;ELSE ACCEL-DEN))) (WHEN DO-THRESH (SETF (POINTER-CONTROL.THRESHOLD CONTROL) (IF (= THRESHOLD -1) (POINTER-CONTROL.NUMERATOR DEFAULT-POINTER-CONTROL) ;;ELSE THRESHOLD))) (FUNCALL (DEVICE.CONTROL-PROC MOUSE) MOUSE CONTROL))) (DEFREQ GET-POINTER-CONTROL () (GET-POINTER-CONTROL STATE)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN GET-POINTER-CONTROL (STATE) (DECLARE (TYPE STATE STATE)) (LET* ((MOUSE (INPUT-INFO.POINTER INPUT-INFO)) (CONTROL (DEVICE.POINTER-CONTROL MOUSE))) (FORMAT-REPLY (STATE) :WORD (POINTER-CONTROL.NUMERATOR CONTROL) :WORD (POINTER-CONTROL.DENOMINATOR CONTROL) :WORD (POINTER-CONTROL.THRESHOLD CONTROL)) (SERVER-PUSH STATE))) (DEFREQ SET-POINTER-MAPPING ((NBYTES CARD8) (:BYTE NBYTES)) (SET-POINTER-MAPPING STATE NBYTES BYTES BYTE-OFFSET)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN SET-POINTER-MAPPING (STATE BYTE-COUNT BYTES BYTE-OFFSET) (DECLARE (TYPE STATE STATE) (TYPE INTEGER BYTE-COUNT) (TYPE ARRAY BYTES)) (LET ((MOUSE (INPUT-INFO.POINTER INPUT-INFO)) (REPLY-SUCCESS MAPPING-SUCCESS) TEMP) (COND ((NOT (= BYTE-COUNT (DEVICE.MAP-LENGTH MOUSE))) (BAD-VALUE BYTE-COUNT)) ((SETQ TEMP (BAD-DEVICE-MAP BYTES BYTE-OFFSET BYTE-COUNT 1 255)) (BAD-VALUE TEMP)) (T (LOOP WITH MAP = (DEVICE.MAP MOUSE) ;1; Note: map starts with index one (not zero).* FOR INDEX FROM 0 BELOW BYTE-COUNT WHEN (AND (NOT (= (AREF MAP (1+ INDEX)) (AREF BYTES (+ BYTE-OFFSET INDEX)))) (plusp (AREF (DEVICE.DOWN MOUSE) (1+ INDEX)))) DO (PROGN (SETQ REPLY-SUCCESS MAPPING-BUSY) (FORMAT-REPLY (STATE) :BYTE REPLY-SUCCESS) (SERVER-PUSH STATE) (RETURN NIL)) FINALLY (PROGN ;; Update the map. (DOTIMES (MAP-INDEX BYTE-COUNT) (SETF (AREF MAP (1+ map-index)) (AREF BYTES (+ BYTE-OFFSET MAP-INDEX)))) (SET-POINTER-STATE-MASKS MOUSE) (FORMAT-REPLY (STATE) :BYTE REPLY-SUCCESS) (SERVER-PUSH STATE) (SEND-MAPPING-NOTIFY MAPPING-POINTER 0 0))))))) (DEFREQ GET-POINTER-MAPPING () (LET* ((MOUSE (INPUT-INFO.POINTER INPUT-INFO)) (BYTE-COUNT (DEVICE.MAP-LENGTH MOUSE)) (MAP (DEVICE.MAP MOUSE))) ;1; Note: map starts with index one (not zero).* (FORMAT-REPLY (STATE (CEILING BYTE-COUNT 4)) :BYTE BYTE-COUNT) (SERVER-PUSH STATE) (DOTIMES (INDEX BYTE-COUNT) (SIMPLE-REPLY (STATE INDEX) :BYTE (AREF MAP (1+ INDEX)))) (SERVER-STRING-OUT STATE (RESPONSE.BYTES (STATE.RESPONSE STATE)) BYTE-COUNT) (SERVER-REPLY-PAD BYTE-COUNT STATE))) (DEFREQ GRAB-BUTTON ((OWNER-EVENTS BOOL) (GRAB-WINDOW WINDOW) (EVENT-MASK (MASKBITS ALL-POINTER-EVENT-MASKS)) (POINTER-MODE (CARD8 GRAB-MODE-SYNC GRAB-MODE-ASYNC)) (KEYBOARD-MODE (CARD8 GRAB-MODE-SYNC GRAB-MODE-ASYNC)) (CONFINE-TO (ONEOF WINDOW)) (CURSOR (ONEOF CURSOR)) (BUTTON CARD8) (MODIFIERS (MASKBITS ALL-KEY-MODIFIER-MASKS))) (SETQ OWNER-EVENTS (= OWNER-EVENTS TRUE)) (WHEN (eql CONFINE-TO 0) (SETQ CONFINE-TO NIL)) (WHEN (eql CURSOR 0) (SETQ CURSOR NIL)) (GRAB-BUTTON STATE OWNER-EVENTS grab-window EVENT-MASK POINTER-MODE keyboard-mode CONFINE-TO CURSOR BUTTON MODIFIERS)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN GRAB-BUTTON (STATE OWNER-EVENTS GRAB-WINDOW EVENT-MASK POINTER-MODE KEYBOARD-MODE CONFINE-TO CURSOR BUTTON MODIFIERS) (DECLARE (TYPE STATE STATE) (TYPE BOOLEAN OWNER-EVENTS) (TYPE WINDOW GRAB-WINDOW) (TYPE INTEGER EVENT-MASK POINTER-MODE KEYBOARD-MODE BUTTON MODIFIERS) (TYPE (OR NULL WINDOW) CONFINE-TO) (TYPE (OR NULL CURSOR-RECORD) CURSOR)) (LET ((TEMPORARY-GRAB (make-grab-record :client STATE :device (INPUT-INFO.POINTER INPUT-INFO) :window GRAB-WINDOW :event-mask (LOGIOR EVENT-MASK BUTTON-PRESS-MASK BUTTON-RELEASE-MASK) :owner-events OWNER-EVENTS :keyboard-mode KEYBOARD-MODE :pointer-mode POINTER-MODE :modifiers-detail (MAKE-DETAIL-REC :EXACT MODIFIERS :MASK UNIVERSAL-NONE) :detail (MAKE-DETAIL-REC :EXACT BUTTON :MASK UNIVERSAL-NONE) :confine-to confine-to :cursor cursor))) (LOOP FOR GRAB FIRST (WINDOW.PASSIVE-GRABS GRAB-WINDOW) THEN (GRAB-RECORD.NEXT GRAB) WHILE GRAB WHEN (AND (GRAB-MATCHES-SECOND TEMPORARY-GRAB GRAB) (NOT (EQ STATE (GRAB-RECORD.CLIENT GRAB)))) DO (PROGN (DELETE-GRAB TEMPORARY-GRAB) (BAD-ACCESS) (RETURN NIL)) FINALLY (PROGN (DELETE-PASSIVE-GRAB-FROM-LIST TEMPORARY-GRAB) (ADD-PASSIVE-GRAB-TO-WINDOW-LIST TEMPORARY-GRAB))))) (DEFREQ UNGRAB-BUTTON ((BUTTON CARD8) (GRAB-WINDOW WINDOW) (MODIFIERS (MASKBITS ALL-KEY-MODIFIER-MASKS))) (UNGRAB-BUTTON STATE BUTTON GRAB-WINDOW MODIFIERS)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN UNGRAB-BUTTON (STATE BUTTON GRAB-WINDOW MODIFIERS) (DECLARE (TYPE STATE STATE) (TYPE WINDOW GRAB-WINDOW) (TYPE INTEGER MODIFIERS)) (DELETE-PASSIVE-GRAB-FROM-LIST (MAKE-GRAB-RECORD :CLIENT STATE :DEVICE (INPUT-INFO.POINTER INPUT-INFO) :WINDOW GRAB-WINDOW :MODIFIERS-DETAIL (MAKE-DETAIL-REC :EXACT MODIFIERS :MASK UNIVERSAL-NONE) :DETAIL (MAKE-DETAIL-REC :EXACT BUTTON :MASK UNIVERSAL-NONE)))) (DEFREQ GRAB-POINTER ((OWNER-EVENTS BOOL) (GRAB-WINDOW WINDOW) ;; This violation is allowed in order to get xterm's Ctrl-Middle click menu to work. ;; When the client is fixed the original line should be reinstated. (EVENT-MASK (MASKBITS (IF *MIT-COMPATIBILITY* ALL-EVENT-MASKS ALL-POINTER-EVENT-MASKS))) ;;(EVENT-MASK (MASKBITS ALL-POINTER-EVENT-MASKS)) (POINTER-MODE (CARD8 GRAB-MODE-SYNC GRAB-MODE-ASYNC)) (KEYBOARD-MODE (CARD8 GRAB-MODE-SYNC GRAB-MODE-ASYNC)) (CONFINE-TO (ONEOF WINDOW)) (CURSOR (ONEOF CURSOR)) (TIME TIMESTAMP)) (SETQ OWNER-EVENTS (= OWNER-EVENTS TRUE)) (WHEN (eql CONFINE-TO 0) (SETQ CONFINE-TO NIL)) (WHEN (eql CURSOR 0) (SETQ CURSOR NIL)) (WITH-CURSOR-LOCKED (:SERVER) (GRAB-POINTER STATE OWNER-EVENTS GRAB-WINDOW EVENT-MASK POINTER-MODE KEYBOARD-MODE CONFINE-TO CURSOR TIME))) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN GRAB-POINTER (STATE OWNER-EVENTS GRAB-WINDOW EVENT-MASK POINTER-MODE KEYBOARD-MODE CONFINE-TO CURSOR TIME) (DECLARE (TYPE STATE STATE) (TYPE BOOLEAN OWNER-EVENTS) (TYPE WINDOW GRAB-WINDOW) (TYPE INTEGER EVENT-MASK POINTER-MODE KEYBOARD-MODE) (TYPE (OR NULL WINDOW) CONFINE-TO) (TYPE (OR NULL CURSOR-RECORD) CURSOR) (TYPE TIME-STAMP TIME)) ;; At this point, some sort of reply is guaranteed. (SETQ TIME (CLIENT-TIME-TO-SERVER-TIME TIME)) (LET* ((POINTER (INPUT-INFO.POINTER INPUT-INFO)) (GRAB (DEVICE.GRAB POINTER)) (sync (device.sync pointer)) (sync-other (sync.other sync)) (sync-frozen (sync.frozen sync)) (sync-state (sync.state sync)) (REPLY-STATUS (COND ((AND GRAB (NOT (EQ (GRAB-RECORD.CLIENT GRAB) STATE))) STATUS-ALREADY-GRABBED) ; ((OR (NOT (WINDOW.REALIZED-P GRAB-WINDOW)) ; (AND confine-to ; (NOT (AND (window.realize-p confine-to) ; (screen.region-not-empty (drawable-screen confine-to)) ; (window-border-size confine-to) ((NOT (WINDOW.REALIZED-P GRAB-WINDOW)) STATUS-NOT-VIEWABLE) ((AND sync-frozen (OR (AND sync-other (NOT (EQ (grab-record.client sync-other) STATE))) (AND (>= sync-state FROZEN) (NOT (EQ (GRAB-RECORD.CLIENT grab) STATE))))) STATUS-FROZEN) ((OR (PLUSP (COMPARE-TIME-STAMPS TIME CURRENT-TIME)) (AND (DEVICE.GRAB POINTER) (MINUSP (COMPARE-TIME-STAMPS TIME (DEVICE.GRAB-TIME POINTER))))) STATUS-INVALID-TIME) (T (WHEN (AND GRAB (GRAB-RECORD.CONFINE-TO GRAB) (NULL CONFINE-TO)) (NEW-CURSOR-CONFINES 0 (SCREEN.WIDTH CURRENT-SCREEN) 0 (SCREEN.HEIGHT CURRENT-SCREEN))) (LET ((TEMP-GRAB (MAKE-GRAB-RECORD :CURSOR CURSOR :CLIENT STATE :OWNER-EVENTS OWNER-EVENTS :EVENT-MASK EVENT-MASK :CONFINE-TO CONFINE-TO :WINDOW GRAB-WINDOW :KEYBOARD-MODE KEYBOARD-MODE :POINTER-MODE POINTER-MODE :DEVICE (INPUT-INFO.POINTER INPUT-INFO)))) (ACTIVATE-POINTER-GRAB (INPUT-INFO.POINTER INPUT-INFO) TEMP-GRAB TIME NIL)) STATUS-SUCCESS)))) (FORMAT-REPLY (STATE) :BYTE REPLY-STATUS) (SERVER-PUSH STATE) (WHEN CURSOR (CHANGE-TO-CURSOR CURSOR)))) (DEFREQ UNGRAB-POINTER ((TIME TIMESTAMP)) (WITH-CURSOR-LOCKED (:SERVER) (UNGRAB-POINTER STATE TIME))) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN UNGRAB-POINTER (STATE TIME) (DECLARE (TYPE STATE STATE) (TYPE TIME-STAMP TIME)) (SETQ TIME (CLIENT-TIME-TO-SERVER-TIME TIME)) (LET* ((DEVICE (INPUT-INFO.POINTER INPUT-INFO)) (GRAB (DEVICE.GRAB DEVICE))) (WHEN (AND (NOT (PLUSP (COMPARE-TIME-STAMPS TIME CURRENT-TIME))) (NOT (MINUSP (COMPARE-TIME-STAMPS TIME (DEVICE.GRAB-TIME DEVICE)))) GRAB (EQ (GRAB-RECORD.CLIENT GRAB) STATE)) (DEACTIVATE-POINTER-GRAB DEVICE)))) (DEFREQ CHANGE-ACTIVE-POINTER-GRAB ((CURSOR (ONEOF CURSOR)) (TIME TIMESTAMP) (EVENT-MASK (MASKBITS ALL-POINTER-EVENT-MASKS))) (WHEN (eql CURSOR 0) (SETQ CURSOR NIL)) (CHANGE-ACTIVE-POINTER-GRAB STATE CURSOR TIME EVENT-MASK)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN CHANGE-ACTIVE-POINTER-GRAB (STATE CURSOR TIME EVENT-MASK) (DECLARE (TYPE STATE STATE) (TYPE (OR NULL CURSOR-RECORD) CURSOR) (TYPE TIME-STAMP TIME) (TYPE INTEGER EVENT-MASK) (IGNORE STATE)) (LET* ((DEVICE (INPUT-INFO.POINTER INPUT-INFO)) (GRAB (DEVICE.GRAB DEVICE))) (SETQ TIME (CLIENT-TIME-TO-SERVER-TIME TIME)) (COND ((OR (PLUSP (COMPARE-TIME-STAMPS TIME CURRENT-TIME)) (MINUSP (COMPARE-TIME-STAMPS TIME (DEVICE.GRAB-TIME DEVICE))) ;1;Do nothing unless the pointer is actively grabbed by the client.* (NULL grab)) ;; Done. T) (T (SETF (GRAB-RECORD.CURSOR GRAB) CURSOR) (POST-NEW-CURSOR) (SETF (GRAB-RECORD.EVENT-MASK GRAB) EVENT-MASK))))) (DEFREQ GET-MOTION-EVENTS ((WINDOW WINDOW) (START TIMESTAMP) (STOP TIMESTAMP)) (GET-MOTION-EVENTS STATE WINDOW START STOP)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN MAYBE-STOP-HINT (CLIENT) (DECLARE (TYPE STATE CLIENT) (VALUES INTEGER)) (LET ((GRAB (DEVICE.GRAB (INPUT-INFO.POINTER INPUT-INFO)))) (WHEN (OR (AND GRAB (EQ CLIENT (GRAB-RECORD.CLIENT GRAB)) (NOT (ZEROP (LOGAND POINTER-MOTION-HINT-MASK (GRAB-RECORD.EVENT-MASK GRAB))))) (AND (NULL GRAB) (NOT (ZEROP (LOGAND POINTER-MOTION-HINT-MASK (EVENT-MASK-FOR-CLIENT MOTION-HINT-WINDOW CLIENT)))))) (SETQ MOTION-HINT-WINDOW NIL)))) (DEFUN READ-HISTORY-EVENT-RANGE (DEVICE START-TIME STOP-TIME) ;; The start/stop times are given in milliseconds, which are expressed as 32-bit integers. ;; This means that if the events are within a 49.71027 day span then this function will work. ;; Most likely this is true. (Note: (/ (/ (/ (/ (expt 2 32) 1000.0) 60) 60) 24.) = 49.71027). (LET ((HISTORY (READ-HISTORY-EVENTS (GET-EVENT-QUEUE-HISTORY (DEVICE.EVENTS DEVICE)))) (CONSTRAINED-HISTORY NIL)) (IF (< START-TIME STOP-TIME) ;; This is the ordinary case. (LOOP FOR HISTORY-ELT IN HISTORY FOR TIME = (NTH 0 HISTORY-ELT) WHILE (<= START-TIME TIME) DO (WHEN (<= START-TIME TIME STOP-TIME) ;; We use push to get them in the right order. (PUSH HISTORY-ELT CONSTRAINED-HISTORY))) ;;ELSE ;; We spanned a month boundary. START-TIME is near the end of one month and ;; STOP-TIME is near the beginning of the following month. (LOOP WITH NEXT-MONTH-P = T WITH AFTER-STOP-TIME = T FOR HISTORY-ELT IN HISTORY FOR PUSH-IT = NIL FOR TIME = (NTH 0 HISTORY-ELT) DO (PROGN (COND ((AND AFTER-STOP-TIME NEXT-MONTH-P (> TIME STOP-TIME)) ;; We are after stop-time. Ignore this. ) ((AND AFTER-STOP-TIME NEXT-MONTH-P (<= TIME STOP-TIME)) (SETQ AFTER-STOP-TIME NIL) ;; We have a time which is near the beginning of this month. (SETQ PUSH-IT T)) ((AND NEXT-MONTH-P (<= TIME STOP-TIME)) ;; We have a time which is near the beginning of this month. (SETQ PUSH-IT T)) (NEXT-MONTH-P ;; We have a time which may be near the end of the previous month. (SETQ NEXT-MONTH-P NIL) (IF (<= START-TIME TIME) (SETQ PUSH-IT T))) ((AND (NULL NEXT-MONTH-P) (<= START-TIME TIME)) ;; We have a time which is near the end of the previous month. (SETQ PUSH-IT T)) (T ;; We havea time which is in the previous month, but it ;; is before START-TIME. (RETURN NIL))) (WHEN PUSH-IT (PUSH HISTORY-ELT CONSTRAINED-HISTORY))))) CONSTRAINED-HISTORY)) (DEFUN GET-MOTION-EVENTS (STATE WINDOW START-TIME STOP-TIME) (DECLARE (TYPE STATE STATE) (TYPE TIME-STAMP START-TIME STOP-TIME)) (setq start-time (client-time-to-server-time start-time) stop-time (client-time-to-server-time stop-time)) (COND ((PLUSP (COMPARE-TIME-STAMPS START-TIME STOP-TIME)) ;; Start > Stop -- done. NIL) ((PLUSP (COMPARE-TIME-STAMPS START-TIME CURRENT-TIME)) ;; Start > now -- done. NIL) (T (WHEN (PLUSP (COMPARE-TIME-STAMPS STOP-TIME CURRENT-TIME)) (SETQ STOP-TIME CURRENT-TIME)) (LET* ((MOUSE (INPUT-INFO.POINTER INPUT-INFO)) (TIME-COORDS (LOOP with coords = (READ-HISTORY-EVENT-RANGE MOUSE (TIME-STAMP.MILLISECONDS START-TIME) (TIME-STAMP.MILLISECONDS STOP-TIME)) WITH MIN-X = (WINDOW.ABSOLUTE-X-CORNER WINDOW) WITH MIN-Y = (WINDOW.ABSOLUTE-Y-CORNER WINDOW) WITH MAX-X = (+ MIN-X (WINDOW.OUTSIDE-WIDTH WINDOW)) WITH MAX-Y = (+ MIN-Y (WINDOW.OUTSIDE-HEIGHT WINDOW)) WITH WIN-X-ORIGIN = (WINDOW.ABSOLUTE-INSIDE-X WINDOW) WITH WIN-Y-ORIGIN = (WINDOW.ABSOLUTE-INSIDE-Y WINDOW) FOR INDEX upFROM 0 FOR (TIME X Y) IN COORDS WHEN (AND (<= MIN-X X) (< X MAX-X) (<= MIN-Y Y) (< Y MAX-Y)) COLLECT `(,TIME ,(- X WIN-X-ORIGIN) ,(- Y WIN-Y-ORIGIN))))) (FORMAT-REPLY (STATE (* 2 (LENGTH TIME-COORDS))) :LONG (LENGTH TIME-COORDS)) (SERVER-PUSH STATE) (LOOP FOR INDEX FROM 0 BY 8 FOR (TIME X Y) IN TIME-COORDS DO (SIMPLE-REPLY (STATE INDEX) :LONG TIME :WORD X :WORD Y)) (SERVER-STRING-OUT STATE (RESPONSE.BYTES (STATE.RESPONSE STATE)) (* 8 (LENGTH TIME-COORDS))) (SERVER-PUSH STATE))))) (DEFREQ QUERY-POINTER ((WINDOW WINDOW)) (QUERY-POINTER STATE WINDOW)) ;;; The following was translated from the C code in /server/dix/events.c (DEFUN QUERY-POINTER (STATE WINDOW) (DECLARE (TYPE STATE STATE) (TYPE WINDOW WINDOW)) (WHEN MOTION-HINT-WINDOW (MAYBE-STOP-HINT STATE)) (LET* (REPLY-X REPLY-Y (REPLY-CHILD NIL) (REPLY-SAME-SCREEN (IF (EQ CURRENT-SCREEN (SCREEN-FOR-WINDOW WINDOW)) (PROGN (SETQ REPLY-X (- (HOT-SPOT.X (SPRITE.HOT SPRITE)) (WINDOW.ABSOLUTE-INSIDE-X WINDOW)) REPLY-Y (- (HOT-SPOT.Y (SPRITE.HOT SPRITE)) (WINDOW.ABSOLUTE-INSIDE-Y WINDOW))) (LOOP FOR PARENT FIRST (SPRITE.WINDOW SPRITE) THEN (WINDOW.PARENT PARENT) WHILE PARENT WHEN (EQ (WINDOW.PARENT PARENT) WINDOW) DO (SETQ REPLY-CHILD PARENT)) T) ;;ELSE (PROGN (SETQ REPLY-X 0 REPLY-Y 0) NIL)))) (FORMAT-REPLY (STATE) :BYTE (IF REPLY-SAME-SCREEN TRUE FALSE) :LONG (WINDOW.ID (ROOT)) :LONG (IF REPLY-CHILD (WINDOW.ID REPLY-CHILD) UNIVERSAL-NONE) :WORD (HOT-SPOT.X (SPRITE.HOT SPRITE)) :WORD (HOT-SPOT.Y (SPRITE.HOT SPRITE)) :WORD REPLY-X :WORD REPLY-Y :WORD KEY-BUTTON-STATE) (SERVER-PUSH STATE)))