;;; -*- 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 ;;; ------------------------------------------------------------------------------------- ;;; 05/10/89 DAN Fixed GET-INPUT-FOCUS to handle nil focus-windows. ;;; 03/90/89 DAN Patch 1.50; In CHANGE-KEYBOARD-CONTROL, modify the way auto repeat ;;; is turned on. ;;; 2/06/89 DAN/1DKM* Patch 1.6; Fixed GRAB-KEY to accept "any-key" key-code. ;;; 12/14/88 LGO Replace all catch/throw's with block/return-from's ;;; 10/21/88 WJB Prevent compiler warning - changed "ignore" to "stuff" in ;;; GET-KEYBOARD-MAPPING. ;;; 110/14*/88 LGO 1Fix time-stamp comparisions in *UNGRAB-KEYBOARD ;;; 9/210*/88 LGO Make GET-KEYBOARD-MAPPING return the right keysyms ;;; 9/12/88 LGO 1Use floor instead of / to avoid doing logior on a rational in *SET-MODIFIER-MAPPING ;;; 9/12/88 LGO Fix bad error checking in GRAB-KEY ;;; 9/09/88 LGO Make USER-PROCEED obsolete and remove calls from Change-Keyboard-Control ;;; 9/08/88 LGO Fixed QUERY-KEYMAP to send a correctly formated reply ;;; 9/06/88 LGO Fixed GRAB-KEYBOARD timestamp checking ;;; 6/7/88 DAN Added a fix for converting the numeric BOOL from 0/1 --> NIL/T in ;;; GRAB-KEY and GRAB-KEYBOARD. ;;; 5/23/88 DAN Added SET-MODIFIER-MAPPING and GET-MODIFIER-MAPPING. ;;; 5/19/88 DAN Added CHANGE-KEYBOARD-MAPPING1 *AND QUERY-KEYMAP. ;;; 5/17/88 DAN Added CHANGE-KEYBOARD-CONTROL AND GET-KEYBOARD-CONTROL. ;;; 5/5/88 DAN Added LISP code for GRAB/UNGRAB-KEYBOARD and GRAB/UNGRAB-KEY. ;;; 2/23/88 TWE Even more C code. ;;; 2/22/88 TWE Inserted C code for SET/GET-INPUT-FOCUS and GRAB/UNGRAB-KEYBOARD. ;;; 12/15/87 TWE Moved requests from the REQUESTS file. (defreq Set-Input-Focus ((revert-to (CARD8 Revert-To-Parent Revert-To-Pointer-Root Revert-To-None)) (focus (ONEOF WINDOW Universal-None Pointer-Root)) (time TIMESTAMP)) (set-input-focus state focus revert-to time)) (DEFUN SET-INPUT-FOCUS (client focusWin revert-to time) (DECLARE (TYPE STATE CLIENT) (type (or window card8) focusWin) (type time-stamp time) (type card8 revert-to) (VALUES INTEGER) (IGNORE CLIENT)) (LET* ((kbd (input-info.keyboard input-info)) (oldfocus (device.focus-window kbd)) (oldtime (device.focus-time kbd)) (Success True) mode) (SETQ time (Client-Time-to-Server-Time time)) ;1;*It is a match error to try to set the input focus to an ;1;*unviewable window. (COND ((AND (TYPEP focusWin 'window) (NOT (window.realized-p focusWin))) ;1;Return bad-match* (bad-match)) ((OR (PLUSP (compare-time-stamps time current-time)) (MINUSP (compare-time-stamps time oldtime))) ;1;Return Success* Success) 1 *;1;ELSE* (t ;1;First make sure focusWin is a window.* (SETQ focusWin (SELECTOR focusWin eql (Universal-None nil) (Pointer-Root Pointer-Root-Window) (otherwise focusWin))) (SETQ mode (IF (device.grab kbd) Notify-While-Grabbed Notify-Normal)) (Do-Focus-Events oldfocus focusWin mode) (SETF (device.focus-time kbd) time) (SETF (device.focus-revert kbd) revert-to) (SETF (device.focus-window kbd) focusWin) (COND ((OR (EQL focusWin Universal-None) (EQL focusWin Pointer-Root-Window)) (SETQ focus-Trace-Good 0)) (t (LET ((depth 0)) (SETQ depth (LOOP for win first focusWin then (window.parent win) while win do (INCF depth) finally (RETURN depth))) (WHEN (> depth focus-Trace-Size) (SETQ focus-Trace-Size (1+ depth)) (ADJUST-ARRAY focus-trace focus-trace-size)) (SETQ focus-trace-good depth) (LOOP for win first focusWin then (window.parent win) while win do (PROGN (SETF (AREF focus-trace (1- depth)) win) (DECF depth)))))) Success)))) (defreq Get-Input-Focus () (get-input-focus state)) (DEFUN GET-INPUT-FOCUS (client) (DECLARE (TYPE STATE CLIENT)) (LET* ((kbd (input-info.keyboard input-info)) (focus (device.focus-window kbd)) (reply-focus (SELECTOR focus eql (nil Universal-None) (Universal-None Universal-None) (Pointer-Root-Window Pointer-Root) (otherwise (window.id focus)))) (reply-revert-to (device.focus-revert kbd))) (format-reply (client) :byte reply-revert-to :long reply-focus))) ;1;;This is taken from *SETUP-KEYBOARD-KEYCLICK1 in BASSTR.LISP.* (DEFUN setup-keyboard-led (led &optional (state nil)) "2Change the on/off state of the specified led on the keyboard. STATE can be either T or NIL NIL - turn off the led. T - turn on the led.*" (CASE led (:caps (FORMAT t "turning on caps-led") (w:write-keyboard (IF (EQUAL state t) 'tv:caps-key-led-on 'tv:caps-key-led-off))) (:italic (w:write-keyboard (IF (EQUAL state t) 'tv:italic-key-led-on 'tv:italic-key-led-off))) (:bold (w:write-keyboard (IF (EQUAL state t) 'tv:bold-key-led-on 'tv:bold-key-led-off))) (:mode (w:write-keyboard (IF (EQUAL state t) 'tv:mode-key-led-on 'tv:mode-key-led-off))) (otherwise (ERROR "invalid led specified")))) ;1;;This is just a fun hack for now. REMOVE it later!* (si:make-obsolete user-proceed a-better-way) (DEFUN USER-PROCEED (MESSAGE &OPTIONAL (DOC-STRING NIL)) "Delay execution until the user is ready." (LET ((OLD-MOUSE-X TV:MOUSE-X) (OLD-MOUSE-Y TV:MOUSE-Y)) ;; Move the mouse out of the way. (TV:MOUSE-WARP (TV:SHEET-WIDTH TV:MOUSE-SHEET) 0) (PROG1 (LET* ((ITEM-LIST (IF DOC-STRING `(("No" :VALUE NIL :DOCUMENTATION ,DOC-STRING) ("Yes" :VALUE T :DOCUMENTATION ,DOC-STRING)) '(("No" :VALUE NIL) ("Yes" :VALUE T)))) (RETURN-VALUE (W:MENU-CHOOSE ITEM-LIST :LABEL MESSAGE :DEFAULT-ITEM (SECOND ITEM-LIST)))) ;; Set the mouse back to where it was. (SETQ TV:MOUSE-X OLD-MOUSE-X TV:MOUSE-Y OLD-MOUSE-Y) RETURN-VALUE)))) (defreq Change-Keyboard-Control ((value-mask (BITMASK All-Keyboard-Control-Masks)) (:long)) (LET* ((keybd (input-info.keyboard input-info)) (cntrl (device.keyboard-control keybd)) (DO-ALL #xFFFFFFFF) (led DO-ALL) (key DO-ALL)) (block match-error (process-values (value-mask longs long-offset) (val) (((KB-Key-Click-Percent (INT8 -1 100)) (IF (PLUSP val) (w:setup-keyboard-keyclick t) ;1;ELSE* (w:setup-keyboard-keyclick)) (SETF (keyboard-control.click cntrl) (CASE val (-1 default-keyboard-click) (t val)))) ((KB-Bell-Percent (INT8 -1 100)) (SETF (keyboard-control.bell cntrl) (case val (-1 default-bell) (t val)))) ((KB-Bell-Pitch (INT16 -1)) (SETF (keyboard-control.bell-pitch cntrl) (CASE val (-1 default-bell-pitch) (t val)))) ((KB-Bell-Duration (INT16 -1)) (SETF (keyboard-control.bell-duration cntrl) (CASE val (-1 default-bell-duration) (t val)))) ((KB-LED (INT16 1 32)) (SETQ led val) (UNLESS (LOGTEST value-mask KB-LED-Mode) (return-from match-error (bad-match)))) ((KB-LED-Mode (CARD8 LED-Off LED-On)) (case val (LED-OFF (IF (= led DO-ALL) (LOOP for indx from 0 to 31 do (SETF (AREF (keyboard-control.leds cntrl) indx) 0)) (SETF (keyboard-control.leds cntrl) (LOGAND (keyboard-control.leds cntrl) (LOGNOT (EXPT 2 (1- led))))))) (LED-ON (IF (= led DO-ALL) (LOOP for indx from 0 to 31 do (SETF (AREF (keyboard-control.leds cntrl) indx) 1)) (SETF (keyboard-control.leds cntrl) (LOGIOR (keyboard-control.leds cntrl) (EXPT 2 (1- led)))))))) ((KB-Key CARD8) (SETQ key val) (UNLESS (LOGTEST value-mask KB-Auto-Repeat-Mode) (return-from match-error (bad-match)))) ; ((KB-Auto-Repeat-Mode (CARD8 Auto-Repeat-Off Auto-Repeat-On Auto-Repeat-Default)) ; (SELECTOR val eql ; (Auto-Repeat-Off ; (IF (= key DO-ALL) ; (LOOP for indx from 0 below MAX-KEYS ; do (SETF (AREF (keyboard-control.auto-repeats cntrl) indx) 0)) ; (SETF (AREF (keyboard-control.auto-repeats cntrl) key) 0))) ; (Auto-Repeat-On ; (IF (= key DO-ALL) ; (LOOP for indx from 0 below MAX-KEYS ; do (SETF (AREF (keyboard-control.auto-repeats cntrl) indx) 1)) ; (SETF (AREF (keyboard-control.auto-repeats cntrl) key) 1))) ; (Auto-Repeat-Default ; (IF (= key DO-ALL) ; (LOOP for indx from 0 below MAX-KEYS ; do (SETF (AREF (keyboard-control.auto-repeats cntrl) indx) ; DEFAULT-AUTOREPEAT)) ; (SETF (AREF (keyboard-control.auto-repeats cntrl) key) DEFAULT-AUTOREPEAT)))))))) ((KB-Auto-Repeat-Mode (CARD8 Auto-Repeat-Off Auto-Repeat-On Auto-Repeat-Default)) (SELECTOR val eql (Auto-Repeat-Off (IF (= key DO-ALL) (SETF (keyboard-control.auto-repeat cntrl) 0) ;1OFF* (SETF (AREF (keyboard-control.auto-repeats cntrl) key) 0))) (Auto-Repeat-On (IF (= key DO-ALL) (SETF (keyboard-control.auto-repeat cntrl) 1) ;1ON* (SETF (AREF (keyboard-control.auto-repeats cntrl) key) 1))) (Auto-Repeat-Default (IF (= key DO-ALL) (SETF (keyboard-control.auto-repeats cntrl) (keyboard-control.auto-repeats DEFAULT-KEYBOARD-CONTROL)) (SETF (AREF (keyboard-control.auto-repeats cntrl) key) (AREF (keyboard-control.auto-repeats DEFAULT-KEYBOARD-CONTROL) key))))))))) (FUNCALL (device.keyboard-control-proc keybd) keybd cntrl))) (defreq Get-Keyboard-Control () (Get-Keyboard-Control state)) (DEFUN GET-KEYBOARD-CONTROL (STATE) (DECLARE (TYPE STATE STATE) (VALUES INTEGER)) (LET* ((keybd (input-info.keyboard input-info)) (cntrl (device.keyboard-control keybd)) (reply-length 5) (global-auto-repeat (keyboard-control.auto-repeat cntrl)) (key-click-percent (keyboard-control.click cntrl)) (bell-percent (keyboard-control.bell cntrl)) (bell-pitch (keyboard-control.bell-pitch cntrl)) (bell-duration (keyboard-control.bell-duration cntrl)) (led-mask (convert-vector-to-32b (keyboard-control.leds cntrl))) (auto-repeats (MAKE-ARRAY (CEILING max-keys 8) :ELEMENT-TYPE '(UNSIGNED-BYTE 8) :DISPLACED-TO (keyboard-control.auto-repeats cntrl))) (auto-repeats-length (LENGTH auto-repeats)) (pad-length (- 32 auto-repeats-length))) (simple-reply (state) :BYTE REPLY-RESPONSE :byte global-auto-repeat :WORD (STATE.SEQUENCE-ID state) :long reply-length :long led-mask :byte key-click-percent :byte bell-percent :word bell-pitch :word bell-duration :word 0) (SERVER-STRING-OUT state (RESPONSE.BYTES (STATE.RESPONSE state)) 20) (SERVER-STRING-OUT state auto-repeats (LENGTH auto-repeats)) (SERVER-STRING-OUT state (RESPONSE.BYTES (STATE.RESPONSE state)) (LOOP with indx = 0 for i from pad-length below 32 by 4 do (setq indx (simple-reply (state indx) :long 0)) finally (return indx))) (SERVER-PUSH STATE))) (defreq Change-Keyboard-Mapping ((keycode-count CARD8) (first-keycode KEYCODE) (keysyms-per-keycode CARD8) (:long)) (change-keyboard-mapping state first-keycode keysyms-per-keycode keycode-count long-offset longs)) (DEFUN CHANGE-KEYBOARD-MAPPING (CLIENT first-keycode keysyms-per-keycode num-keycodes offset data) (DECLARE (TYPE STATE CLIENT) (TYPE keycode first-keycode) (TYPE integer keysyms-per-keycode) (TYPE integer offset) (TYPE integer num-keycodes) ; (TYPE ? keysyms) (IGNORE client) (VALUES INTEGER)) (LET* ((keycodes (elements-to-list data (* num-keycodes keysyms-per-keycode) offset)) (keysyms (make-key-syms-record :map (MAKE-ARRAY max-keys :element-type 'integer :initial-element No-Symbol)))) (server-trace "~% keycodes= ~s 1st keycode= ~d keycode-count= ~d keysyms-per-keycode= ~d (LENGTH keycodes)= ~d" keycodes first-keycode num-keycodes keysyms-per-keycode (LENGTH keycodes)) (COND ((NOT (ZEROP (MOD (LENGTH keycodes) keysyms-per-keycode))) (bad-length)) ((> (1- (+ first-keycode num-keycodes)) (key-syms-record.max-key-code current-key-syms)) (bad-value first-keycode)) (t ;1;;ELSE* (SETF (key-syms-record.min-key-code keysyms) first-keycode) (SETF (key-syms-record.max-key-code keysyms) (1- (+ first-keycode num-keycodes))) (SETF (key-syms-record.map-width keysyms) keysyms-per-keycode) (LOOP for key-indx from 0 below (* keysyms-per-keycode num-keycodes) ; by keysyms-per-keycode for keycode in keycodes for map = (key-syms-record.map keysyms) do (SETF (AREF map key-indx) keycode)) ; do (LOOP for key-code-indx from 0 below keysyms-per-keycode ; do (SETF (AREF map (+ key-indx key-code-indx)) keycode))) (set-key-syms-map keysyms) (send-mapping-notify Mapping-Keyboard first-keycode num-keycodes) )))) ; (COUNT (floor num-keycodes keysyms-per-keycode))) ; (server-trace "~% keycodes= ~s 1st keycode= ~d keycode-count= ~d keysyms-per-keycode= ~d ; (LENGTH keycodes)= ~d" keycodes first-keycode num-keycodes ; keysyms-per-keycode (LENGTH keycodes)) ; (COND ((NOT (ZEROP (MOD (LENGTH keycodes) keysyms-per-keycode))) ; (bad-length)) ; ((> (1- (+ first-keycode count)) (key-syms-record.max-key-code current-key-syms)) ; (bad-value first-keycode)) ; (t ;1;;ELSE* ; (SETF (key-syms-record.min-key-code keysyms) first-keycode) ; (SETF (key-syms-record.max-key-code keysyms) (1- (+ first-keycode count))) ; (SETF (key-syms-record.map-width keysyms) keysyms-per-keycode) ; (LOOP for key-indx from 0 below (* keysyms-per-keycode count) by keysyms-per-keycode ; for keycode in keycodes ; for map = (key-syms-record.map keysyms) ; do (LOOP for key-code-indx from 0 below keysyms-per-keycode ; do (SETF (AREF map (+ key-indx key-code-indx)) keycode))) ; (set-key-syms-map keysyms) ; (send-mapping-notify Mapping-Keyboard first-keycode count) ; )))) ;;; Get Keyboard Mapping (defreq Get-Keyboard-Mapping ((stuff card8) (first-keycode KEYCODE) (keycode-count CARD8)) (get-keyboard-mapping state first-keycode keycode-count)) (zwei:define-indentation get-keysyms (1 1)) (DEFUN GET-KEYBOARD-MAPPING (state first-keycode keycode-count) (DECLARE (type KEYCODE first-keycode) (type CARD8 keycode-count) (TYPE STATE state)) (LET* ((keysyms-per-keycode (key-syms-record.map-width current-key-syms)) (reply-length (* keysyms-per-keycode keycode-count))) (server-trace "~%first-code = ~d, count= ~d, max = ~d" first-keycode keycode-count (key-syms-record.max-key-code current-key-syms)) (IF (> (+ first-keycode keycode-count -1) (key-syms-record.max-key-code current-key-syms)) (bad-value first-keycode) ;1;ELSE* (let ((key-indx (* (- first-keycode (key-syms-record.min-key-code current-key-syms)) keysyms-per-keycode)) (key-syms (key-syms-record.map current-key-syms)) (last-key-index 0)) (format-reply (state reply-length) :byte keysyms-per-keycode) (dotimes (i keycode-count) (dotimes (j keysyms-per-keycode) (setq last-key-index (simple-reply (state last-key-index) :long (AREF key-syms key-indx))) (incf key-indx))) (server-string-out state (response.bytes (state.response state)) last-key-index) (server-push state))))) ;;; rep.type = X_Reply; ;;; rep.sequenceNumber = client->sequence; ;;; rep.keySymsPerKeyCode = curKeySyms.mapWidth; ;;;/* length is a count of 4 byte quantities and KeySyms are 4 bytes */ ;;; rep.length = (curKeySyms.mapWidth * stuff->count); ;;; WriteReplyToClient(client, sizeof(xGetKeyboardMappingReply), &rep); ;;; client->pSwapReplyFunc = CopySwap32Write; ;;; WriteSwappedDataToClient( ;;; client, ;;; curKeySyms.mapWidth * stuff->count * sizeof(KeySym), ;;; &curKeySyms.map[stuff->firstKeyCode - curKeySyms.minKeyCode]); ;;; return client->noClientException; ;;;} (defreq Set-Modifier-Mapping ((keycodes-per-modifier CARD8) (:byte)) (set-modifier-mapping state keycodes-per-modifier length byte-offset bytes)) (DEFUN SET-MODIFIER-MAPPING (STATE keycodes-per-modifier length offset data) (DECLARE (TYPE STATE STATE) (TYPE integer keycodes-per-modifier) (TYPE integer length) (TYPE integer offset) (VALUES INTEGER)) (block bad-exit (LET* ((input-map-len (* 8 keycodes-per-modifier)) (input-map (MAKE-ARRAY input-map-len :element-type 'integer :initial-element No-Symbol)) ;;; (input-map (MAKE-ARRAY input-map-len :type 'art-q :initial-element No-Symbol ;;; :displaced-to data :displaced-index-offset offset)) (reply-length 0) reply-success) ; (server-trace "~%In SET-MODIFIER-MAPPING: keycodes-per-modifier= ~d length= ~d offset= ~d ; input-map-len= ~d" keycodes-per-modifier length offset input-map-len) (WHEN (NOT (= LENGTH (* 8 keycodes-per-modifier))) (return-from bad-exit (bad-length))) ;1;Transfer the keycodes into input-map.* (LOOP for data-indx from offset below (+ length offset) for map-indx from 0 below input-map-len do (SETF (AREF input-map map-indx) (AREF data data-indx))) 1 *;1;Now enforce the restriction that "all of the non-zero keycodes must be in the range specified by* ;1;min-keycode and max-keycode in the connection setup (else a Value error)"* (LOOP for key being the array-elements of input-map from 0 below input-map-len do (IF (AND (PLUSP key) (NOT (<= (key-syms-record.min-key-code current-key-syms) key (key-syms-record.max-key-code current-key-syms)))) (return-from bad-exit (bad-value key)))) (SETQ reply-success Mapping-Success) ;1;;Now enforce the restriction that none of the old or new modifier keys may be down while we* ;1;;change the mapping, and that the DDX layer likes the choice.* (IF (OR (NOT (all-modifier-keys-are-up modifier-key-map (* 8 MAX-KEYS-PER-MODIFIER))) (NOT (all-modifier-keys-are-up input-map input-map-len))) (SETQ reply-success Mapping-Busy) ;1;ELSE* (PROGN (LOOP for i from 0 below input-map-len for input-map-val = (AREF input-map i) when (AND input-map-val (NOT (legal-modifier input-map-val))) RETURN (SETQ reply-success Mapping-Failed)))) (format-reply (state) :byte reply-success :long reply-length) (server-push state) (WHEN (= reply-success Mapping-Success) 1 *;1;Now build the keyboard's modifier bitmap from the list of keycodes.* ;;; (SETQ modifier-key-map (make-key-syms-record :map (MAKE-ARRAY input-map-len ;;; :element-type 'integer ;;; :displaced-to input-map))) (SETQ modifier-key-map input-map) (SETQ max-keys-per-modifier keycodes-per-modifier) (LET* ((keybd (input-info.keyboard input-info)) (mod-map (device.modifier-map keybd))) (LOOP for i from 0 below MAP-LENGTH do (SETF (AREF mod-map i) 0)) (LOOP for i from 0 below input-map-len for ipval = (AREF input-map i) when ipval do (SETF (AREF mod-map ipval) (LOGIOR (AREF mod-map ipval) (* 2 (floor i max-keys-per-modifier))))) (set-keyboard-state-masks keybd)) (send-mapping-notify Mapping-Modifier 0 0)) ) ) ) (defreq Get-Modifier-Mapping () (get-modifier-mapping state)) (DEFUN GET-MODIFIER-MAPPING (STATE) (DECLARE (TYPE STATE STATE) (VALUES INTEGER)) (LET ((num-key-per-mod max-keys-per-modifier) ;1;length counts 4 byte quantities - there are 8 modifiers 1 byte big* (rep-length (* 2 max-keys-per-modifier))) (format-reply (state rep-length) :byte num-key-per-mod) (SERVER-PUSH STATE) (SERVER-STRING-OUT state modifier-key-map (* 8 max-keys-per-modifier)) (SERVER-PUSH STATE))) (defreq Grab-Keyboard ((owner-events BOOL) (grab-window WINDOW) (time TIMESTAMP) (pointer-mode (CARD8 Grab-Mode-Sync Grab-Mode-Async)) (keyboard-mode (CARD8 Grab-Mode-Sync Grab-Mode-Async))) (SETQ OWNER-EVENTS (= OWNER-EVENTS TRUE)) (grab-keyboard state grab-window owner-events pointer-mode keyboard-mode time)) (DEFUN GRAB-KEYBOARD (client grab-win owner-events pointer-mode kbd-mode time) (DECLARE (TYPE STATE CLIENT) (type window grab-win) (type boolean owner-events) (type integer pointer-mode) (type integer kbd-mode) (type card32 time) (VALUES INTEGER)) (LET* ((reply-status Status-Success) (kbd (input-info.keyboard input-info)) (grab (device.grab kbd)) (sync (device.sync kbd)) (sync-other (sync.other sync)) (sync-frozen (sync.frozen sync)) (sync-state (sync.state sync))) (SETQ time (client-time-to-server-time time)) (COND ((AND grab (NOT (EQ client (grab-record.client grab)))) (SETQ reply-status Status-Already-Grabbed)) ((NOT (window.realized-p grab-win)) (SETQ reply-status Status-Not-Viewable)) ((OR (minusp (compare-time-stamps current-time time)) ;1; after current time?* (minusp (compare-time-stamps time (device.grab-time kbd)))) ;1; before last time?* (SETQ reply-status Status-Invalid-Time)) ((AND sync-frozen (OR (AND sync-other (NOT (EQ client (grab-record.client sync-other)))) (AND (>= sync-state FROZEN) (NOT (EQ client (grab-record.client grab)))))) (SETQ reply-status Status-Frozen)) (t (LET ((tempGrab (MAKE-GRAB-RECORD))) (SETF (grab-record.window tempGrab) grab-win) (SETF (grab-record.client tempGrab) client) (SETF (grab-record.owner-events tempGrab) owner-events) (SETF (grab-record.pointer-mode tempGrab) pointer-mode) (SETF (grab-record.keyboard-mode tempGrab) kbd-mode) (SETF (grab-record.event-mask tempGrab) (LOGIOR Key-Press-Mask Key-Release-Mask)) (SETF (grab-record.device tempGrab) kbd) (ACTIVATE-KEYBOARD-GRAB kbd tempGrab time FALSE)) (SETQ reply-status Status-Success))) (FORMAT-reply (client) :byte reply-status) Status-Success)) (defreq Ungrab-Keyboard ((time TIMESTAMP)) (UNGRAB-KEYBOARD state time)) (DEFUN UNGRAB-KEYBOARD (CLIENT time) (DECLARE (TYPE STATE CLIENT) (type CARD32 time) (VALUES INTEGER)) (LET* ((kbd (input-info.keyboard input-info)) (grab (device.grab kbd))) (SETQ time (CLIENT-TIME-TO-SERVER-TIME time)) ;1;No effect if time is earlier than last-kbd-grab time or is later than current server time.* (when (AND (not (minusp (compare-time-stamps current-time time))) (not (minusp (compare-time-stamps time (device.grab-time kbd)))) grab (EQ (grab-record.client grab) client)) (deactivate-keyboard-grab kbd)))) (defreq Grab-Key ((owner-events BOOL) (grab-window WINDOW) (modifiers (MASKBITS All-Key-Modifier-Masks)) (key CARD8) (pointer-mode (CARD8 Grab-Mode-Sync Grab-Mode-Async)) (keyboard-mode (CARD8 Grab-Mode-Sync Grab-Mode-Async))) (SETQ OWNER-EVENTS (= OWNER-EVENTS TRUE)) (grab-key state key modifiers grab-window owner-events pointer-mode keyboard-mode)) (DEFUN GRAB-KEY (CLIENT key-code modifiers window owner-events pointer-mode kbd-mode) (DECLARE (TYPE STATE CLIENT) (TYPE window window) (TYPE integer key-code) (TYPE unsigned-integer modifiers) (TYPE integer pointer-mode) (TYPE integer kbd-mode) (TYPE boolean owner-events) (VALUES integer)) (LET ((max-key-code (key-syms-record.max-key-code current-key-syms)) (min-key-code (key-syms-record.min-key-code current-key-syms)) (kbd (input-info.keyboard input-info)) (badacc nil) temp-grab) (COND ((AND (NOT (= key-code any-key)) ;1don't error for "any-key" key-code -dkm* (NOT (<= min-key-code key-code max-key-code))) (bad-value key-code)) 1 *(t ;1;ELSE* (SETQ temp-grab (create-grab client kbd window (LOGAND Key-Press-Mask Key-Release-Mask) owner-events kbd-mode pointer-mode modifiers key-code)) (LOOP for grab first (window.PASSIVE-GRABS window) then (grab-record.next grab) while grab do (IF (grab-matches-second temp-grab grab) (IF (NOT (EQ client (grab-record.client grab))) (PROGN (delete-grab temp-grab) (SETQ badacc t))))) (COND (badacc (bad-access)) (t (delete-passive-grab-from-list temp-grab) (add-passive-grab-to-window-list temp-grab))))))) (defreq Ungrab-Key ((key CARD8) (grab-window WINDOW) (modifiers (MASKBITS All-Key-Modifier-Masks))) (ungrab-key state key modifiers grab-window)) (DEFUN UNGRAB-KEY (CLIENT key-code modifiers window) (DECLARE (TYPE STATE CLIENT) (TYPE window window) (TYPE integer key-code) (TYPE unsigned-integer modifiers) (VALUES INTEGER)) (LET* ((kbd (input-info.keyboard input-info)) (keybd-grab (MAKE-GRAB-RECORD :client client :device kbd :window window :modifiers-detail (make-detail-rec :exact modifiers :mask universal-none) :detail (make-detail-rec :exact key-code :mask universal-none))) ) (delete-passive-grab-from-list keybd-grab))) (defreq Query-Keymap () (query-keymap state)) (DEFUN QUERY-KEYMAP (STATE) (DECLARE (TYPE STATE STATE) (VALUES INTEGER)) (LET* ((keybd (input-info.keyboard input-info)) (down (device.down keybd)) (reply-vector (MAKE-ARRAY (ceiling MAX-PHYSICAL-KEYS 8) :ELEMENT-TYPE '(unsigned-byte 8) :displaced-to down)) (reply-length 2)) (let ((index (simple-reply (state) :BYTE REPLY-RESPONSE :WORD (STATE.SEQUENCE-ID state) :LONG reply-length ))) (SERVER-STRING-OUT STATE (RESPONSE.BYTES (STATE.RESPONSE STATE)) INDEX)) (SERVER-STRING-OUT state reply-vector (LENGTH reply-vector)) (SERVER-PUSH STATE))) (DEFUN legal-modifier (key) (DECLARE (IGNORE key)) true) (DEFUN CONVERT-VECTOR-TO-32B (VECT) "2Smash a 32-bit vector into a CARD32.*" (LET ((temp-array (MAKE-ARRAY 1 :element-type 'card32 :displaced-to vect))) (AREF temp-array 0)))