187 lines
5.8 KiB
Scheme
187 lines
5.8 KiB
Scheme
; Norbert Freudemann
|
|
|
|
;; grab-pointer grabs control of a pointer for your client only.
|
|
;; It returns on of the symbols:
|
|
;; (success not-viewable already-grabbed frozen invalide-time)
|
|
;; See XGrabPointer.
|
|
|
|
(define-enumerated-type grab-status :grab-status
|
|
grab-status? grab-states grab-status-name grab-status-index
|
|
(success already-grabbed invalid-time not-viewable frozen))
|
|
|
|
(define (integer->grab-status i)
|
|
(vector-ref grab-states i))
|
|
|
|
(define (grab-pointer window owner? events ptr-sync? kbd-sync?
|
|
confine-to cursor time)
|
|
(integer->grab-status
|
|
(%grab-pointer (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
owner?
|
|
(event-mask->integer events)
|
|
ptr-sync? kbd-sync?
|
|
(window-Xwindow confine-to)
|
|
(cursor-Xcursor cursor)
|
|
time)))
|
|
|
|
(import-lambda-definition %grab-pointer (Xdisplay Xwindow owner? events
|
|
ptr-sync? kbd-sync?
|
|
Xconfine-to Xcursor time)
|
|
"scx_Grab_Pointer")
|
|
|
|
;; ungrab-pointer releases the pointer. See XUngrabPointer.
|
|
|
|
(define (ungrab-pointer display time)
|
|
(%ungrab-pointer (display-Xdisplay display)
|
|
time))
|
|
|
|
(import-lambda-definition %ungrab-pointer (Xdisplay time)
|
|
"scx_Ungrab_Pointer")
|
|
|
|
|
|
;; grab-button performs a grab-pointer depending on a corresponding
|
|
;; button press event. See XGrabButton.
|
|
|
|
(define (grab-button window button mod owner? events ptr-sync? kbd-sync?
|
|
confine-to cursor)
|
|
(%grab-button (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(button->integer button) ;; any-button
|
|
(state-set->integer mod)
|
|
owner?
|
|
(event-mask->integer events)
|
|
ptr-sync? kbd-sync?
|
|
(window-Xwindow confine-to)
|
|
(cursor-Xcursor cursor)))
|
|
|
|
(import-lambda-definition %grab-button (Xdisplay Xwindow button
|
|
mods ownerp events
|
|
ptr-sync? kbd-sync?
|
|
Xconfine-to Xcursor)
|
|
"scx_Grab_Button")
|
|
|
|
;; ungrab-button releases the passive grab, performed by
|
|
;; grab-button. See XUngrabButton.
|
|
|
|
(define (ungrab-button window button modifiers)
|
|
(%ungrab-button (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
(button->integer button)
|
|
(state-set->integer modifiers)))
|
|
|
|
(import-lambda-definition %ungrab-button (Xdisplay Xwindow
|
|
button modifiers)
|
|
"scx_Ungrab_Button")
|
|
|
|
;; change-active-pointer-grab changes the specified dynamic parameters
|
|
;; if the pointer is actively grabbed by the client (by grab-pointer,
|
|
;; not by grab-button). See XChangeActivePointerGrab.
|
|
|
|
(define (change-active-pointer-grab display events cursor time)
|
|
(%change-active-p-g (display-Xdisplay display)
|
|
(event-mask->integer events)
|
|
(cursor-Xcursor cursor)
|
|
time))
|
|
|
|
(import-lambda-definition %change-active-p-g (Xdislay events
|
|
cursor time)
|
|
"scx_Change_Active_Pointer_Grab")
|
|
|
|
;; grab-keyboard actively grabs control of the keyboard and generates
|
|
;; FocusIn and FocusOut events. Further key events are reported only
|
|
;; to the grabbing client.
|
|
;; ungrab-keyboard releases the keyboard and any queued events if this
|
|
;; client has it actively grabbed from either grab-keyboard or
|
|
;; grab-Key. See XGrabKeyboard and XUngrabKeyboard.
|
|
|
|
(define (grab-keyboard window owner? ptr-sync? kbd-sync? time)
|
|
(integer->grab-status
|
|
(%grab-keyboard (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
owner? ptr-sync? kbd-sync? time)))
|
|
|
|
(import-lambda-definition %grab-keyboard (Xdisplay Xwindow
|
|
owner? ptr-sync? kbd-sync?
|
|
time)
|
|
"scx_Grab_Keyboard")
|
|
|
|
(define (ungrab-keyboard display time)
|
|
(%ungrab-keyboard (display-Xdisplay display)
|
|
time))
|
|
|
|
|
|
(import-lambda-definition %ungrab-keyboard (Xdisplay time)
|
|
"scx_Ungrab_Keyboard")
|
|
|
|
;; The grab-key function establishes a passive grab on the
|
|
;; keyboard. In the future, the keyboard is actively
|
|
;; grabbed.
|
|
;; ungrab-key releases this passive grab. See XGrabKey and XUngrabKey.
|
|
|
|
(define (grab-key window key mod owner? ptr-sync? kbd-sync?)
|
|
(%grab-key (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
key
|
|
(state-set->integer mod)
|
|
owner? ptr-sync? kbd-sync? (symbol? key)))
|
|
|
|
(import-lambda-definition %grab-key (Xdisplay xwindow key mod
|
|
owner ptr-sync? kbd-sync? flag)
|
|
"scx_Grab_Key")
|
|
|
|
(define (ungrab-key window key mod)
|
|
(%ungrab-key (display-Xdisplay (window-display window))
|
|
(window-Xwindow window)
|
|
key
|
|
(state-set->integer mod)
|
|
(symbol? key)))
|
|
|
|
(import-lambda-definition %ungrab-key (Xdisplay Xwindow key mod
|
|
flag)
|
|
"scx_Ungrab_Key")
|
|
|
|
;; allow-events function releases some queued events if the client has
|
|
;; caused a device to freeze. See XAllowEvents.
|
|
|
|
(define-enumerated-type allow-event :allow-event
|
|
allow-event? allow-events allow-event-name allow-event-index
|
|
(async-pointer sync-pointer replay-pointer async-keyboard
|
|
sync-keyboard replay-keyboard async-both sync-both))
|
|
|
|
(define (allow-event->integer v)
|
|
(allow-event-index v))
|
|
|
|
(define (allow-events display mode time)
|
|
(%allow-events (display-Xdisplay display)
|
|
(allow-event->integer mode)
|
|
time))
|
|
|
|
(import-lambda-definition %allow-events (Xdisplay mode time)
|
|
"scx_Allow_Events")
|
|
|
|
;; grab-server disables processing of requests and close downs on all
|
|
;; other connections than the one this request arrived on. You should
|
|
;; not grab the X server any more than is absolutely necessary. See
|
|
;; XGrabServer.
|
|
|
|
(define (grab-server display)
|
|
(%grab-server (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %grab-server (Xdisplay)
|
|
"scx_Grab_Server")
|
|
|
|
;; ungrab-server restarts processing of requests and close downs on
|
|
;; other connections. You should avoid grabbing the X server as much
|
|
;; as possible. See XUngrabServer.
|
|
|
|
(define (ungrab-server display)
|
|
(%ungrab-server (display-Xdisplay display)))
|
|
|
|
(import-lambda-definition %ungrab-server (Xdisplay)
|
|
"scx_Ungrab_Server")
|
|
|
|
|
|
;; with-server-grabbed not implemented (yet).
|
|
|
|
;;(define-syntax (with-server-grabbed display . body-forms))
|