scx/scheme/xlib/grab.scm

; 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-mode kbd-mode
		      confine-to cursor time)
  (integer->grab-status
   (%grab-pointer (display-Xdisplay (window-display window))
		  (window-Xwindow window)
		  owner? 
		  (event-mask->integer events)
		  (grab-mode->integer ptr-mode)
		  (grab-mode->integer kbd-mode)
		  (window-Xwindow confine-to)
		  (cursor-Xcursor cursor)
		  time)))

(import-lambda-definition %grab-pointer (Xdisplay Xwindow owner? events
					 ptr-mode kbd-mode
					 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-enumerated-type grab-mode :grab-mode
  grab-mode? grab-modes grab-mode-name grab-mode-index
  (sync async))

(define (grab-mode->integer m)
  (grab-mode-index m))

(define (interger->grab-mode i)
  (vector-ref grab-modes i))

(define (grab-button window button mod owner? events ptr-mode kbd-mode
		     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)
		(grab-mode->integer ptr-mode)
		(grab-mode->integer kbd-mode)
		(window-Xwindow confine-to)
		(cursor-Xcursor cursor)))

(import-lambda-definition %grab-button (Xdisplay Xwindow button
						 mods ownerp events
						 ptr-mode kbd-mode
						 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-mode kbd-mode time)
  (integer->grab-status
   (%grab-keyboard (display-Xdisplay (window-display window))
		   (window-Xwindow window)
		   owner?
		   (grab-mode->integer ptr-mode)
		   (grab-mode->integer kbd-mode)
		   time)))

(import-lambda-definition %grab-keyboard (Xdisplay Xwindow
						   owner? ptr-mode kbd-mode
						   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-mode kbd-mode)
  (%grab-key (display-Xdisplay (window-display window))
	     (window-Xwindow window)
	     key
	     (state-set->integer mod)
	     owner?
	     (grab-mode->integer ptr-mode)
	     (grab-mode->integer kbd-mode)
	     (symbol? key)))

(import-lambda-definition %grab-key (Xdisplay xwindow key mod
				     owner ptr-mode kbd-mode 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))