Commits

Anonymous committed 815c110

Initial import of xlib sources

Comments (0)

Files changed (21)

+2004-02-15  Zajcev Evgeny  <zevlg@yandex.ru>
+
+	* xlib-xlib.el (XNextEvent): New function to grab next X event.
+
+	* xlib-xr.el (events): X-Events-stop error introduced to stop
+	events handling.
+
+	* xlib-xwin.el (Geom-Rect): Converters from X-Rect to X-Geom and
+	back added.
+
+	* ext/xlib-xinerama.el (fix): Tiny fixes.
+
+2004-01-23 Zajcev Evgeny <zevlg@yandex.ru>
+
+	* ext/xlib-xpm.el (Module): Removed from here, moved to utils.
+
+2004-01-21 Zajcev Evgeny <zevlg@yandex.ru>
+
+	* ChangeLog (Revision): ChangeLog for xlib in new XWEM layout
+	created.
+	
+;; $Id$
+# Makefile for xlib lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+
+# XEmacs is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.00
+AUTHOR_VERSION = 0.1
+MAINTAINER = Zajcev Evgeny
+PACKAGE = xlib
+PKG_TYPE = regular
+REQUIRES = 
+CATEGORY = standard
+
+ELCS =  lisp/xlib-const.elc lisp/xlib-math.elc lisp/xlib-xr.elc lisp/xlib-xc.elc \
+	lisp/xlib-xwin.elc lisp/xlib-xlib.elc lisp/xlib-img.elc lisp/xlib-xpm.elc \
+	lisp/xlib-tray.elc lisp/xlib-hello.elc
+
+ELCS_1 = lisp/ext/xlib-xrecord.elc lisp/ext/xlib-xtest.elc \
+	lisp/ext/xlib-xshape.elc lisp/ext/xlib-xinerama.elc \
+	lisp/ext/xlib-vidmode.elc
+
+ELCS_1_DEST = $(PACKAGE)/ext
+ELCS_1_FILES = $(ELCS_1) $(ELCS_1:.elc=.el)
+
+AUTOLOAD_PATH = lisp
+
+PRELOADS = -eval '(push "./lisp" load-path)' -l lisp/auto-autoloads.el
+
+include ../../XEmacs.rules
+README file for xlib.
+
+GNU Emacs notes:
+
+  * does not have plist-remprop<f>
+
+  * xlib-xpm does not work.
+ This directory is for xlib extensions.

lisp/ext/xlib-vidmode.el

+;;; xlib-vidmode.el --- XF86VidMode extension support.
+
+;; Copyright (C) 2004 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Fri Jan 16 18:39:44 MSK 2004
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+(defconst X-XF86VidMode-major 2 "Major version of VidMode extension.")
+(defconst X-XF86VidMode-minor 1 "Minor version of VidMode extension.")
+
+(defconst X-XF86VidMode-op-QueryVersion	0)
+(defconst X-XF86VidMode-op-GetModeLine 1 "Opcode to fetch current modeline from server.")
+(defconst X-XF86VidMode-op-ModModeLine 2)
+(defconst X-XF86VidMode-op-SwitchMode 3)
+(defconst X-XF86VidMode-op-GetMonitor 4)
+(defconst X-XF86VidMode-op-LockModeSwitch 5)
+(defconst X-XF86VidMode-op-GetAllModeLines 6)
+(defconst X-XF86VidMode-op-AddModeLine	7)
+(defconst X-XF86VidMode-op-DeleteModeLine 8)
+(defconst X-XF86VidMode-op-ValidateModeLine 9)
+(defconst X-XF86VidMode-op-SwitchToMode	10)
+(defconst X-XF86VidMode-op-GetViewPort	11)
+(defconst X-XF86VidMode-op-SetViewPort	12)
+
+;; new for version 2.x of this extension
+(defconst X-XF86VidMode-op-GetDotClocks	13)
+(defconst X-XF86VidMode-op-SetClientVersion 14)
+(defconst X-XF86VidMode-op-SetGamma 15 "Opcode to set new gamma.")
+(defconst X-XF86VidMode-op-GetGamma 16 "Opcode to fetch current gamma.")
+(defconst X-XF86VidMode-op-GetGammaRamp	17)
+(defconst X-XF86VidMode-op-SetGammaRamp	18)
+(defconst X-XF86VidMode-op-GetGammaRampSize 19)
+
+
+;;; Functions
+(defun X-XF86VidModeQueryVersion (xdpy)
+  "On display XDPY query for version of XF86VidMode extension."
+  (X-Dpy-p xdpy 'X-XF86VidModeQueryVersion)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XFree86-VidModeExtension" 'X-XF86VidModeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XF86VidMode-op-QueryVersion]
+		[2 1]))			; length
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [2 integerp]	;major version
+		      [2 integerp]	;minor version
+		      [20 nil]))))	;pad
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(defun X-XF86VidModeGetModeline (xdpy &optional screen-num)
+  "On display XDPY using XF86VidMode extension fetch current modeline."
+  (X-Dpy-p xdpy 'X-XF86VidModeGetModeline)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XFree86-VidModeExtension" 'X-XF86VidModeGetModeline))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XF86VidMode-op-GetModeLine]
+		[2 2]			; length
+		[2 (or screen-num 0)]	; screen
+		[2 nil]))		; pad
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [4 integerp]	;dotclock
+		      [2 integerp]	;hdisplay
+		      [2 integerp]	;hsyncstart
+		      [2 integerp]	;hsyncend
+		      [2 integerp]	;htotal
+		      [2 integerp]	;hskew
+		      [2 integerp]	;vdisplay
+		      [2 integerp]	;vsyncstart
+		      [2 integerp]	;vsyncend
+		      [2 integerp]	;vtotal
+		      [2 nil]		; pad
+		      [4 integerp]))))	; flags
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+
+(defun X-XF86VidModeGetGamma (xdpy &optional screen-num)
+  "On display XDPY using XF86VidMode extension fetch current gamma."
+  (X-Dpy-p xdpy 'X-XF86VidModeGetGamma)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XFree86-VidModeExtension" 'X-XF86VidModeGetGamma))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XF86VidMode-op-GetGamma]
+		[2 8]			; length
+		[2 (or screen-num 0)]	; screen
+		[2 nil]			; pad
+		[24 nil]))		;pad
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [4 integerp]	;red gamma
+		      [4 integerp]	;green gamma
+		      [4 integerp]	;blue gamma
+		      [12 nil]))))	;pad
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(defun X-XF86VidModeSetGamma (xdpy r g b &optional screen-num)
+  "On display XDPY using XF86VidMode extension fetch current gamma."
+  (X-Dpy-p xdpy 'X-XF86VidModeSetGamma)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XFree86-VidModeExtension" 'X-XF86VidModeSetGamma))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XF86VidMode-op-SetGamma]
+		[2 8]			; length
+		[2 (or screen-num 0)]	; screen
+		[2 nil]			; pad
+		[4 (* 10000 r)]		; red gamma
+		[4 (* 10000 g)]		; green gamma
+		[4 (* 10000 b)]		; blue gamma
+		[12 nil]))		;pad
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+;; TODO: write other functions
+  
+
+
+(provide 'xlib-vidmode)
+
+;;; xlib-vidmode.el ends here

lisp/ext/xlib-xdpms.el

+;;; xlib-xdpms.el --- DPMS extension support.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Tue Nov 18 03:19:16 MSK 2003
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+
+(provide 'xlib-xdpms)
+
+;;; xlib-xdpms.el ends here

lisp/ext/xlib-xinerama.el

+;;; xlib-xinerama.el --- Xinerama support.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Mon Nov 17 19:23:03 MSK 2003
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; XInerama support.
+
+;;; Code:
+
+
+(defconst X-XInerama-major 1)
+(defconst X-XInerama-minor 1)
+
+(defconst X-XInerama-op-QueryVersion	0)
+(defconst X-XInerama-op-GetState	1)
+(defconst X-XInerama-op-GetScreenCount	2)
+(defconst X-XInerama-op-GetScreenSize	3)
+
+(defconst X-XInerama-op-IsActive	4)
+(defconst X-XInerama-op-QueryScreens	5)
+
+(defun X-XIneramaQueryVersion (xdpy &optional major minor)
+  "On display XDPY query for version of XInerama extension."
+  (X-Dpy-p xdpy 'X-XIneramaQueryVersion)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA" 'X-XIneramaQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-QueryVersion]
+		[2 2]			; length
+
+		[2 (or major X-XInerama-major)]
+		[2 (or minor X-XInerama-minor)]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [2 integerp]	;major version
+		      [2 integerp]	;minor version
+		      [20 nil]))))	;pad
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(defun X-XIneramaGetState (xdpy d)
+  "Get state of drawable D."
+  (X-Dpy-p xdpy 'X-XIneramaGetState)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA" 'X-XIneramaGetState))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-GetState]
+		[2 2]			; length
+		[4 (X-Drawable-id d)]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]
+		nil
+		(list [1 integerp]	; state
+		      [2 nil]		; sequence number
+		      [4 nil]		; length
+		      [4 integerp]
+		      [20 nil])))
+	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
+    r))
+
+(defun X-XIneramaGetScreenCount (xdpy d)
+  "Get screen count."
+  (X-Dpy-p xdpy 'X-XIneramaGetScreenCount)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA" 'X-XIneramaGetScreenCount))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-GetScreenCount]
+		[2 2]			; length
+		[4 (X-Drawable-id d)]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]
+		nil
+		(list [1 integerp]	; screen count
+		      [2 nil]		; sequence number
+		      [4 nil]		; length
+		      [4 integerp]
+		      [20 nil])))
+	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
+    r))
+
+(defun X-XIneramaGetScreenSize (xdpy d scr)
+  "Get screens sizes."
+  (X-Dpy-p xdpy 'X-XIneramaGetScreenSize)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA" 'X-XIneramaGetScreenSize))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-GetScreenSize]
+		[2 3]			; length
+		[4 (X-Drawable-id d)]
+		[4 scr]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]
+		nil
+		(list [1 nil]		; unused
+		      [2 nil]		; sequence number
+		      [4 nil]		; length
+		      [4 integerp]	; width
+		      [4 integerp]	; height
+		      [4 integerp]	; window
+		      [4 integerp]	; screen
+		      [8 nil])))
+	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
+    r))
+
+;;; Alternative protocol
+
+(defun X-XIneramaIsActive (xdpy)
+  "Return non-nil if XINERAMA is active."
+  (X-Dpy-p xdpy 'X-XIneramaIsActive)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA" 'X-XIneramaIsActive))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-IsActive]
+		[2 1]			; length
+		))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]
+		nil
+		(list [1 nil]		; unused
+		      [2 nil]		; sequence
+		      [4 nil]		; length
+		      [4 integerp]	; state
+		      [20 nil])))
+	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
+    (and (car r) (nth 1 r))))
+
+(defun X-XIneramaQueryScreens (xdpy)
+  "On display XDPY query for XINERAMA screens."
+  (X-Dpy-p xdpy 'X-XIneramaIsActive)
+
+  (let* ((xin-ext (X-Dpy-get-extension xdpy "XINERAMA"))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xin-ext)) ; opcode
+		[1 X-XInerama-op-QueryScreens]
+		[2 1]			; length
+		))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]
+		nil
+		(list [1 nil]		; unused
+		      [2 nil]		; sequence
+		      [4 nil]		; length
+		      [4 length-1]	; number
+		      [20 nil]
+		      [(* 8 length-1) :X-Rect]))))
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+
+(provide 'xlib-xinerama)
+
+;;; xlib-xinerama.el ends here

lisp/ext/xlib-xrecord.el

+;;; xlib-xrecord.el --- RECORD extension for xlib.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: 18 October 2003
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; We need to open two connections to X server to use RECORD
+;; extension, one for RC controling and second for data transfer,
+;; `X-XRecordEnableContext' should be issued on data connection.
+
+;; Range8, Range16 is cons cells in form (FIRST . LAST)
+;;
+;; ExtRange is cons cell in form (MAJOR-Range8 . MINOR-Range16)
+
+;;; Code:
+
+
+(eval-when-compile
+  (require 'cl))
+
+(defconst X-XRecord-major 1)
+(defconst X-XRecord-minor 13)
+
+(defconst X-XRecord-op-QueryVersion 0)
+(defconst X-XRecord-op-CreateContext 1)
+(defconst X-XRecord-op-RegisterClients 2)
+(defconst X-XRecord-op-UnregisterClients 3)
+(defconst X-XRecord-op-GetContext 4)
+(defconst X-XRecord-op-EnableContext 5)
+(defconst X-XRecord-op-DisplayContext 6)
+(defconst X-XRecord-op-FreeContext 7)
+
+;; element-header
+(defconst X-XRecordFromServerTime (Xmask 0))
+(defconst X-XRecordFromClientTime (Xmask 1))
+(defconst X-XRecordFromClientSequence (Xmask 2))
+
+(defconst X-XRecordCurrentClients 1)
+(defconst X-XRecordFutureClients 2)
+(defconst X-XRecordAllClients 3)
+
+(defconst X-XRecordFromServer 0)
+(defconst X-XRecordFromClient 1)
+(defconst X-XRecordClientStarted 2)
+(defconst X-XRecordClientDied 3)
+(defconst X-XRecordStartOfData 4)
+(defconst X-XRecordEndOfData 5)
+
+
+(defstruct (X-RecordContext (:predicate X-RecordContext-isrc-p))
+  dpy id
+  props)				; User defined plist
+
+(defstruct (X-RecordExtrange (:predicate X-RecordExtrange-isrer-p))
+  major					; X-RecordRange8
+  minor					; X-RecordRange16
+  ;; List of extractors
+  (list '(((lambda (re)
+	     (X-RecordRange8-message (X-RecordExtrange-major re))) . 2)
+	  ((lambda (re)
+	     (X-RecordRange16-message (X-RecordExtrange-minor re))) . 4)))
+  )
+
+(defstruct (X-RecordRange (:predicate X-RecordRange-isrr-p))
+  core-requests				; X-RecordRange8
+  core-replies				; X-RecordRange8
+  ext-requests				; X-RecordExtrange
+  ext-replies				; X-RecordExtrange
+  delivered-events			; X-RecordRange8
+  device-events				; X-RecordRange8
+  errors				; X-RecordRange8
+  client-started			; BOOL
+  client-died				; BOOL
+  ;; List of extractors
+  (list '(((lambda (rr)
+	     (X-RecordRange8-message (X-RecordRange-core-requests rr))) . 2)
+	  ((lambda (rr)
+	     (X-RecordRange8-message (X-RecordRange-core-replies rr))) . 2)
+	  ((lambda (rr)
+	     (X-RecordExtrange-message (X-RecordRange-ext-requests rr))) . 6)
+	  ((lambda (rr)
+	     (X-RecordExtrange-message (X-RecordRange-ext-replies rr))) . 6)
+	  ((lambda (rr)
+	     (X-RecordRange8-message (X-RecordRange-delivered-events rr))) . 2)
+	  ((lambda (rr)
+	     (X-RecordRange8-message (X-RecordRange-device-events rr))) . 2)
+	  ((lambda (rr)
+	     (X-RecordRange8-message (X-RecordRange-errors rr))) . 2)
+	  (X-RecordRange-client-started . 1)
+	  (X-RecordRange-client-died . 1))))
+
+(defstruct (X-RecordClientInfo (:predicate X-RecordClientInfo-isrci-p))
+  client-spec				; X-RecordClientSpec
+  ranges)				; list of X-RecordRange
+
+(defstruct X-RecordState
+  enabled				; BOOL
+  datum-flags				; int
+  client-infos				; list of X-RecordClientInfo
+  )
+
+
+;; Predicates
+(defsubst X-RecordContext-p (xrc &optional sig)
+  (X-Generic-p 'X-RecordContext 'X-RecordContext-isrc-p xrc sig))
+
+(defsubst X-RecordRange8-p (xrr8 &optional sig)
+  (or (null xrr8) (consp xrr8)))
+
+(defsubst X-RecordRange16-p (xrr16 &optional sig)
+  (or (null xrr16) (consp xrr16)))
+
+(defsubst X-RecordExtrange-p (xrer &optional sig)
+  (or (null xrer) (and (consp xrer) (X-RecordRange8-p (car xrer)) (X-RecordRange16-p (cdr xrer)))))
+
+(defsubst X-RecordRange-p (xrr &optional sig)
+  (X-Generic-p 'X-RecordRange 'X-RecordRange-isrr-p xrr sig))
+
+(defsubst X-RecordClientSpec-p (xrcs &optional sig)
+  (floatp xrcs))
+
+(defsubst X-RecordClientInfo-p (xrci &optional sig)
+  (X-Generic-p 'X-RecordClientInfo 'X-RecordClientInfo-isrci-p xrci sig))
+
+;; Message generators
+(defsubst X-RecordRange8-message (xrr8)
+  "Return a string representing the record range8 XRR8."
+  (if (null xrr8)
+      (make-string 2 ?\x00)
+    (concat (int->string1 (car xrr8)) (int->string1 (cdr xrr8)))))
+
+(defsubst X-RecordRange16-message (xrr16)
+  "Return a string representing the record range16 XRR16."
+  (if (null xrr16)
+      (make-string 4 ?\x00)
+    (concat (int->string2 (car xrr16)) (int->string2 (cdr xrr16)))))
+
+(defsubst X-RecordExtrange-message (xer)
+  "Return a string representing the extrange XER."
+  (if (null xer)
+      (make-string 12 ?\x00)
+    (concat (X-RecordRange8-message (car xer)) (X-RecordRange16-message (cdr xer)))))
+
+(defsubst X-RecordRange-message (xrr)
+  "Return a string representing the record range XRR."
+  (X-Generate-simple-message 'X-RecordRange xrr))
+
+(defsubst X-RecordClientSpec-message (xrcs)
+  "Return a string representing the client spec XRCS."
+  (int->string4 xrcs))
+
+
+;;; Functions
+(defun X-XRecordQueryVersion (xdpy &optional major minor)
+  "On display XDPY query for version of record extension."
+  (X-Dpy-p xdpy 'X-XRecordQueryVersion)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-QueryVersion]
+		[2 2]			;length
+
+		[2 (or major X-XRecord-major)]
+		[2 (or minor X-XRecord-minor)]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [2 integerp]	;major version
+		      [2 integerp]	;minor version
+		      [20 nil]))))	;pad
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(defun X-XRecordCreateContext (xdpy rc elhead clspecs ranges)
+  "ELHEAD is contructed using `Xmask-or' and values
+`X-XRecordFromServerTime', `X-XRecordFromClient' and
+`X-XRecordFromClientSequence'.
+
+CLSPECS is list of X-RecordClientSpec
+RANGES is list of X-RecordRange."
+  (X-Dpy-p xdpy 'X-XRecordCreateContext)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordCreateContext))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ;opcode
+		[1 X-XRecord-op-CreateContext]
+		[2 (+ 5 (length clspecs) (* 6 (length ranges)))] ;length
+
+		[4 (X-RecordContext-id rc)] ; context
+		[1 elhead]
+		[3 nil]			; not used
+		[4 (length clspecs)]
+		[4 (length ranges)]))
+	 (msg (concat (X-Create-message ListOfFields)
+		      (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
+		      (X-Generate-message-for-list ranges 'X-RecordRange-message))))
+    (X-Dpy-send xdpy msg)
+    rc))
+
+(defun X-XRecordRegisterClients (xdpy rc elhead clspecs ranges)
+  "On display XDPY, register CLSPECS for intercepting in record context RC."
+  (X-Dpy-p xdpy 'X-XRecordRegisterClients)
+  (X-RecordContext-p rc 'X-XRecordRegisterClients)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordRegisterClients))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-RegisterClients]
+		[2 (+ 5 (length clspecs) (* 6 (length ranges)))] ; length
+		[4 (X-RecordContext-id rc)]
+		[1 elhead]
+		[3 nil]			; not used
+		[4 (length clspecs)]
+		[4 (length ranges)]))
+	 (msg (concat (X-Create-message ListOfFields)
+		      (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message)
+		      (X-Generate-message-for-list ranges 'X-RecordRange-message))))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XRecordUnregisterClients (xdpy rc clspecs)
+  "On display XDPY in record context RC unregister clients in CLSPECS."
+  (X-Dpy-p xdpy 'X-XRecordRegisterClients)
+  (X-RecordContext-p rc 'X-XRecordRegisterClients)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordRegisterClients))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-UnregisterClients]
+		[2 (+ 3 (length clspecs))] ; length
+		[4 (X-RecordContext-id rc)]
+		[4 (length clspecs)]))
+	 (msg (concat (X-Create-message ListOfFields)
+		      (X-Generate-message-for-list clspecs 'X-RecordClientSpec-message))))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XRecordGetContext (xdpy rc)
+  "On display XDPY get context for RC."
+  (X-Dpy-p xdpy 'X-XRecordGetContext)
+  (X-RecordContext-p rc 'X-XRecordRegisterClients)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-GetContext]
+		[2 2]			; length
+		[4 (X-RecordContext-id rc)])) ; context
+	 (msg (concat (X-Create-message ListOfFields)))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 integerp]	;enabled
+		      [2 integerp]	;sequence number
+		      [4 length-1]	;length
+		      [1 integerp]	;elhead
+		      [3 nil]		;not used
+		      [4 length-2]	;n, number of intercepted-clients
+		      [16 nil]		;not used
+		      [length-2 ([4 integerp]
+				 [4 length-3]
+				 [length-3
+				  ([1 integerp]
+				   [1 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+				   [2 integerp]
+				   [2 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+				   [2 integerp]
+				   [2 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+
+				   [1 integerp]
+				   [1 integerp]
+		
+				   [1 booleanp]
+				   [1 booleanp])])]))))
+
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+;      (X-log dpy "Get X-XRecordGetContext replay: %s\n" 'resp)
+
+(defun X-XRecordEnableContext (xdpy rc)
+  "On display XDPY enable RC context.
+
+This request enables data transfer between the recording client, and
+the extension and returns the protocol data the recording client has
+previously expressed interest in.  Typically, this request is executed
+by the recording client over the data connection."
+
+  (X-Dpy-p xdpy 'X-XRecordEnableContext)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordEnableContext))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ;opcode
+		[1 X-XRecord-op-EnableContext]
+		[2 2]			;length
+		[4 (X-RecordContext-id rc)]))
+	 (msg (concat (X-Create-message ListOfFields)))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 integerp]	;category
+		      [2 integerp]	;sequence number
+		      [4 length-1]	;length
+		      [1 integerp]	;elhead
+		      [1 integerp]	;client-swapped
+		      [2 nil]		;not used
+		      [4 integerp]	;id-baes
+		      [4 integerp]	;server-time
+		      [4 integerp]	;recorded sequence number
+		      [8 nil]		;not used
+		      [(* length-1 4) stringp])))
+	 (rep (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+    (X-Dpy-log xdpy "X-XRecordEnableContext:  rep=%S\n" 'rep)
+    (when (and (car rep)
+	       (= (nth 1 rep) X-XRecordStartOfData))
+    
+      ;; Mark xdpy to be always in events-excursion mode, there no
+      ;; need to process events in data connection.
+      (setf (X-Dpy-evq-protects xdpy) 100)
+      (setf (X-Dpy-parse-guess-dispatcher xdpy) 'X-XRecord-parse-guess))
+    rep))
+
+(defun X-XRecordDisableContext (xdpy rc)
+  "On display XDPY disable recording context RC."
+  (X-Dpy-p xdpy 'X-XRecordGetContext)
+  (X-RecordContext-p rc 'X-XRecordRegisterClients)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-DisplayContext]
+		[2 2]			; length
+		[4 (X-RecordContext-id rc)])) ; context
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XRecordFreeContext (xdpy rc)
+  "On display XDPY free record context RC."
+  (X-Dpy-p xdpy 'X-XRecordGetContext)
+  (X-RecordContext-p rc 'X-XRecordRegisterClients)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "RECORD" 'X-XRecordGetContext))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XRecord-op-FreeContext]
+		[2 2]			; length
+		[4 (X-RecordContext-id rc)])) ; context
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+  
+
+(defun X-XRecord-parse-guess (xdpy)
+  "Parse message received in data connection."
+  (X-Dpy-p xdpy 'X-XRecord-parse-guess)
+
+  (when (zerop (X-Dpy-readings xdpy))
+    (X-Dpy-read-excursion
+     xdpy
+     (while (> (length (X-Dpy-message-buffer xdpy)) 0)
+       (let* ((msg (X-Dpy-parse-message (list [1 integerp] ; reply
+					      [1 integerp] ;category
+					      [2 integerp] ;sequence number
+					      [4 integerp] ;length
+					      [1 integerp] ;elhead
+					      [1 integerp] ;client-swapped
+					      [2 nil] ;not used
+					      [4 integerp] ;id-baes
+					      [4 integerp] ;server-time
+					      [4 integerp] ;recorded sequence number
+					      [8 nil]) ;not used
+					nil xdpy))
+	      (mcategory (nth 1 msg))	; message categery
+	      (len (nth 3 msg))
+	      (elh (nth 4 msg))
+	      elh-value
+	      result)
+
+	 (while (> len 0)
+	   ;; There data
+	   (setq elh-value nil)
+	   (when (> elh 0)
+	     ;; there elhead
+	     (setq elh-value (X-Dpy-grab-bytes xdpy 4))
+	     (setq len (- len 4)))
+
+	   (setq result (Xforcenum (aref (X-Dpy-grab-bytes xdpy 1) 0)))
+	   (setq len (- len 1))
+
+	   (cond ((= mcategory X-XRecordFromServer)
+		  ;; Error, Event or Reply
+		  (cond ((= result 0)
+			 ;; Error, TODO
+			 (setq len 0)
+			 )
+			((= result 1)
+			 ;; Reply, TODO
+			 (setq len 0)
+			 )
+
+			;; Event
+			(t		;(< result X-MaxEvent)
+			 ;; Valid event
+			 (let ((xev (X-Dpy-parse-event xdpy result)))
+
+			   ;; Put some interception info
+			   (X-Event-put-property xev 'XRecord-Category (nth 1 msg))
+			   (X-Event-put-property xev 'XRecord-Sequence (nth 2 msg))
+			   (X-Event-put-property xev 'XRecord-Elhead (nth 4 msg))
+			   (X-Event-put-property xev 'XRecord-Elhead-value elh-value)
+			   (X-Event-put-property xev 'XRecord-Swaped (nth 5 msg))
+			   (X-Event-put-property xev 'XRecord-Idbase (nth 6 msg))
+			   (X-Event-put-property xev 'XRecord-Servertime (nth 7 msg))
+			   (X-Event-put-property xev 'XRecord-RecSeq (nth 8 msg))
+
+			   (X-Dpy-log (X-Event-dpy xev) "XRECORD EXTENSION: Get Event: %S, win=%S\n"
+				      '(X-Event-name xev) '(X-Win-id (X-Event-win xev)))
+			  
+			   (setq len (- len 31)))))
+		  )
+
+		 (t (error "Not supported category: %d" (nth 1 msg)))))
+	 )))
+    ))
+
+
+;;; Testing section:
+;;
+;; To record KeyPress/KeyRelease device events:
+;;
+;;  (setq mrc (make-X-RecordContext :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy))))
+;;  (setq mrr (make-X-RecordRange :device-events '(2 . 3)))
+;;  (setq tcl (X-Win-id (xwem-cl-xwin (xwem-cl-selected))))
+;;  (setq mrc (X-XRecordCreateContext (xwem-dpy) mrc 5 (list tcl) (list mrr)))
+;;
+;;  (X-XRecordRegisterClients (xwem-dpy) mrc 5 (list tcl) (list mrr))
+;;
+;;  (setq md (XOpenDisplay "127.0.0.1:0"))
+;;  (setf (X-Dpy-log-buffer md) "XREC.log")
+;;  (X-XRecordEnableContext md mrc)
+
+
+(provide 'xlib-xrecord)
+
+;;; xlib-xrecord.el ends here

lisp/ext/xlib-xshape.el

+;;; xlib-xshape.el --- Shape extension support.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: Mon Nov 17 19:23:03 MSK 2003
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(defconst X-XShape-op-QueryVersion		0)
+(defconst X-XShape-op-Rectangles		1)
+(defconst X-XShape-op-Mask			2)
+(defconst X-XShape-op-Combine			3)
+(defconst X-XShape-op-Offset			4)
+(defconst X-XShape-op-QueryExtents		5)
+(defconst X-XShape-op-SelectInput		6)
+(defconst X-XShape-op-InputSelected		7)
+(defconst X-XShape-op-GetRectangles		8)
+
+;; ops
+(defconst X-XShapeSet 0)
+(defconst X-XShapeUnion 1)
+(defconst X-XShapeIntersect 2)
+(defconst X-XShapeSubtract 3)
+(defconst X-XShapeInvert 4)
+
+;; kinds
+(defconst X-XShape-Bounding 0)
+(defconst X-XShape-Clip 1)
+
+;; events
+(defconst X-ShapeNotify 0)		; actuallly (0 + extension event base)
+
+(defun X-XShapeQueryVersion (xdpy)
+  "On display XDPY query for version of Shape extension."
+  (X-Dpy-p xdpy 'X-XRecordQueryVersion)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-QueryVersion]
+		[2 1]			; length
+		))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 nil]		;not used
+		      [2 integerp]	;sequence number
+		      [4 nil]		;length
+		      [2 integerp]	;major version
+		      [2 integerp]	;minor version
+		      [20 nil]))))	;pad
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(defun X-XShapeRectangles (xdpy dest-win dest-kind op x-off y-off rectangles &optional ordering)
+  "This request specifies an array of rectangles, relative to the
+origin of the window DEST-WIN plus the specified offset \\(X-OFF and
+y-OFF\\) that together define a region.  This region is combined \\(as
+specified by the operator OP\\) with the existing client region
+\\(specified by KIND\) of the destination window DEST-WIN, and the
+result is stored as the specified client region of the destination
+window.  Note that the list of rectangles can be empty, specifying an
+empty region; this is not the same as passing `X-None' to
+`X-XShapeMask'. If known by the client, ordering relations on the
+rectangles can be specified with the ordering argument.  This may
+provide faster operation by the server.  The meanings of the ordering
+values are the same as in the core protocol `XSetClipRectangles'
+request.  If an incorrect ordering is specified, the server may
+generate a Match error, but it is not required to do so.  If no error
+is generated, the graphics results are undefined. Except for
+`X-UnSorted', the rectangles should be nonintersecting, or the
+resulting region will be undefined.  `X-UnSorted' means that the
+rectangles are in arbitrary order.  `X-YSorted' means that the
+rectangles are nondecreasing in their Y origin.  `X-YXSorted'
+additionally constrains `X-YSorted' order in that all rectangles with
+an equal Y origin are nondecreasing in their X origin.  `X-YXBanded'
+additionally constrains `X-YXSorted' by requiring that, for every
+possible Y scanline, all rectangles that include that scanline have
+identical Y origins and Y extents."
+  (X-Dpy-p xdpy 'X-XShapeRectangles)
+  (X-Win-p dest-win 'X-XShapeRectangles)
+
+  (unless ordering
+    (setq ordering X-UnSorted))
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-Rectangles]
+		[2 (+ 4 (* 2 (length rectangles)))]
+		[1 op]			; operation
+		[1 dest-kind]		; destination kind
+		[1 ordering]		;
+		[1 nil]			; unused
+		[4 (X-Win-id dest-win)]	; destination window
+		[2 x-off]
+		[2 y-off]))
+	 (msg (concat (X-Create-message ListOfFields) (X-Generate-message-for-list rectangles 'X-Rect-message))))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XShapeMask (xdpy dest-win dest-kind op x-off y-off src)
+  "The SRC in this request is a 1-bit deep pixmap, or `X-None'.  If
+SRC is `X-None', the specified client region is removed from the
+window, causing the effective region to revert to the default region.
+The `X-ShapeNotify' event generated by this request and subsequent
+ShapeQueryExtents will report that a client shape has not been
+specified.  If a valid pixmap is specified, it is converted to a
+region, with bits set to one included in the region and bits set to
+zero excluded, and an offset from the window origin as specified by
+X-OFF and Y-OFF.  The resulting region is then combined \\(as
+specified by the operator OP\\) with the existing client region
+\\(indicated by DEST-KIND\\) of the destination window, and the result
+is stored as the specified client region of the destination window.
+The source pixmap and destination window must have been created on the
+same screen, or else a Match error results."
+  (X-Dpy-p xdpy 'X-XShapeMask)
+  (X-Win-p dest-win 'X-XShapeMask)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-Mask]
+		[2 5]
+		[1 op]			; operation
+		[1 dest-kind]		; destination kind
+		[2 nil]			; unused
+		[4 (X-Win-id dest-win)]	; destination window
+		[2 x-off]
+		[2 y-off]
+		[4 (if (X-Drawable-p src) (X-Drawable-id src) src)]))
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XShapeCombine (xdpy dest-win dest-kind op x-off y-off src src-kind)
+  "The client region, indicated by SRC-KIND, of the source window SRC
+is offset from the window DEST-WIN origin by X-OFF and Y-OFF and
+combined with the client region, indicated by DEST-KIND, of the
+destination window DEST-WIN.  The result is stored as the specified
+client region of the destination window.  The source and destination
+windows must be on the same screen, or else a Match error results."
+  (X-Dpy-p xdpy 'X-XShapeCombine)
+  (X-Drawable-p dest-win 'X-XShapeCombine)
+  (X-Drawable-p src 'X-XShapeCombine)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+ 	 (ListOfFields
+ 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-Combine]
+ 		[2 5]
+ 		[1 op]			; operation
+		[1 dest-kind]		; destination kind
+		[1 src-kind]
+		[1 nil]			; unused
+		[4 (X-Win-id dest-win)] ; destination window
+ 		[2 x-off]
+ 		[2 y-off]
+		[4 (X-Drawable-id src)]))
+ 	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XShapeOffset (xdpy dest-win dest-kind x-off y-off)
+  "The client region, indicated by DEST-KIND, is moved relative
+to its current position by the amounts X-OFF and Y-OFF."
+  (X-Dpy-p xdpy 'X-XShapeOffset)
+  (X-Win-p dest-win 'X-XShapeOffset)
+
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+ 	 (ListOfFields
+ 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-Offset]
+ 		[2 4]
+		[1 dest-kind]		; destination kind
+		[3 nil]			; unused
+		[4 (X-Win-id dest-win)]	; destination window
+ 		[2 x-off]
+ 		[2 y-off]))
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XShapeQueryExtents (xdpy dest-win)
+  "The boundingShaped and clipShaped results are True if the
+corresponding client regions have been specified, else they
+are False.  The x, y, width, and height values define the
+extents of the client regions, when a client region has not
+been specified, the extents of the corresponding default
+region are reported."
+  (X-Dpy-p xdpy 'X-XShapeQueryExtents)
+
+  )
+
+(defun X-XShapeSelectInput (xdpy dest-win enable)
+  "Specifying enable as T causes the server to send the requesting
+client a `X-ShapeNotify' event whenever the bounding or clip region of
+the specified window is altered by any client.  Specifying enable as
+NIL causes the server to stop sending such events."
+  (X-Dpy-p xdpy 'X-XShapeSelectInput)
+  (X-Win-p dest-win 'X-XShapeSelectInput)
+  
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+ 	 (ListOfFields
+ 	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-SelectInput]
+ 		[2 3]
+		[4 (X-Win-id dest-win)]	; destination window
+		[1 enable]
+		[3 nil]))
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(defun X-XShapeInputSelected (xdpy dest-win)
+  "Return non-nil if on display XDPY DEST-WIN is enabled to receive
+`X-ShapeNotify' events."
+  (X-Dpy-p xdpy 'X-XShapeInputSelected)
+  (X-Win-p dest-win 'X-XShapeInputSelected)
+  
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-InputSelected]
+		[2 2]			; length
+		[4 (X-Win-id dest-win)]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 booleanp]	; enabled
+		      [2 integerp]	; sequence number
+		      [4 nil]		; length
+		      [24 nil])))	;pad
+	 (r (X-Dpy-send-read xdpy msg ReceiveFields)))
+    (and (car r) (nth 1 r))))
+
+(defun X-XShapeGetRectangles (xdpy dest-win dest-kind)
+  "A list of rectangles describing the region indicated by DEST-KIND,
+and the ordering of those rectangles, is returned.  The meaning of the
+ordering values is the same as in the `X-XShapeRectangles' request."
+  (X-Dpy-p xdpy 'X-XShapeInputSelected)
+  (X-Win-p dest-win 'X-XShapeInputSelected)
+  
+  (let* ((xrec-ext (X-Dpy-get-extension xdpy "SHAPE" 'X-XShapeQueryVersion))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 xrec-ext)) ; opcode
+		[1 X-XShape-op-GetRectangles]
+		[2 3]			; length
+		[4 (X-Win-id dest-win)]
+		[1 dest-kind]
+		[3 nil]))
+	 (msg (X-Create-message ListOfFields))
+	 (ReceiveFields
+	  (list [1 success]		;success field
+		nil
+		(list [1 integerp]	; ordering
+		      [2 integerp]	; sequence number
+		      [4 length-1]	; length
+		      [20 nil]
+		      [length-1
+		       ([2 integerp]
+			[2 integerp]
+			[2 integerp]
+			[2 integerp])]))))
+
+    ;; TODO: maybe convert to X-Rect ?
+    (X-Dpy-send-read xdpy msg ReceiveFields)))
+
+(provide 'xlib-xshape)
+
+;;; xlib-xshape.el ends here

lisp/ext/xlib-xtest.el

+;;; xlib-xtest.el --- XTEST extension for xlib.
+
+;; Copyright (C) 2003 by Free Software Foundation, Inc.
+
+;; Author: Zajcev Evgeny <zevlg@yandex.ru>
+;; Created: 18 October 2003
+;; Keywords: xlib, xwem
+;; X-CVS: $Id$
+;; X-URL: http://lgarc.narod.ru/xwem/index.html
+
+;; This file is part of XWEM.
+
+;; XWEM is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XWEM is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
+;; License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; 
+
+;;; TODO:
+
+;;    * add X-XTestGetVersion, X-XTestCompareCursor, X-XTestGrabControl
+
+;;; Code:
+
+(require 'xlib-xc)
+
+(defconst X-XTest-op-GetVersion	0)
+(defconst X-XTest-op-CompareCursor	1)
+(defconst X-XTest-op-FakeInput		2)
+(defconst X-XTest-op-GrabControl	3)
+
+(defconst X-Xtest-KeyPress 2)
+(defconst X-Xtest-KeyRelease 3)
+(defconst X-Xtest-ButtonPress 4)
+(defconst X-Xtest-ButtonRelease 5)
+(defconst X-Xtest-MotionNotify 6)
+
+(defun X-XTest-FakeInput (xdpy evtype detail root rootx rooty &optional time)
+  "On display XDPY send fake event of EVTYPE with DETAIL at TIME."
+  (X-Dpy-p xdpy 'X-XTest-FakeInput)
+
+  (let* ((test-ext (X-Dpy-get-extension xdpy "XTEST" 'X-XTest-FakeInput))
+	 (ListOfFields
+	  (list (vector 1 (nth 4 test-ext)) ; opcode
+		[1 X-XTest-op-FakeInput]
+		[2 (+ 1 (* 1 8))]	;length
+
+		[1 evtype]
+		[1 detail]
+		[2 nil]			;pad
+		[4 (or time X-CurrentTime)]
+		[4 (if (X-Win-p root) (X-Win-id root) root)]
+		[8 nil]
+		[2 rootx]
+		[2 rooty]
+		[8 nil]
+		))
+	 (msg (X-Create-message ListOfFields)))
+    (X-Dpy-send xdpy msg)))
+
+(provide 'xlib-xtest)
+
+;;; xlib-xtest.el ends here

lisp/xlib-const.el

+;;; xlib-const.el --- Constants used in Xlib for masks and the like.
+
+;; Copyright (C) 1996, 1997, 1998 Eric M. Ludlam
+;;
+;; Author: Eric M. Ludlam <zappo@gnu.ai.mit.edu>
+;; Modified: Zajcev Evgeny <zevlg@yandex.ru>
+;; Keywords: xlib, xwem
+;; X-RCS: $Id$
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's author (see below) or write to:
+;;
+;;              The Free Software Foundation, Inc.
+;;              675 Mass Ave.
+;;              Cambridge, MA 02139, USA.
+;;
+;; Please send bug reports, etc. to zappo@gnu.ai.mit.edu.
+;;
+
+;;; Commentary:
+;;
+;; Constants used with our X connection.
+
+;;; Code:
+
+
+;;;###autoload
+(defconst X-CopyFromParent 0 "CopyFromParent opcode.")
+;;;###autoload
+(defconst X-InputOutput 1 "InputOutput opcode.")
+;;;###autoload
+(defconst X-InputOnly 2 "InputOnly opcode.")
+
+;;; Gravity
+
+;;;###autoload
+(defconst X-Unmap 0 "Unmap gravity.")
+;;;###autoload
+(defconst X-NorthWest 1 "NorthWest gravity.")
+;;;###autoload
+(defconst X-North 2 "North gravity.")
+;;;###autoload
+(defconst X-NorthEast 3 "NorthEast gravity.")
+;;;###autoload
+(defconst X-West 4 "West gravity.")
+;;;###autoload
+(defconst X-Center 5 "Center gravity.")
+;;;###autoload
+(defconst X-East 6 "East gravity.")
+;;;###autoload
+(defconst X-SouthWest 7 "SouthWest gravity.")
+;;;###autoload
+(defconst X-South 8 "South gravity.")
+;;;###autoload
+(defconst X-SouthEast 9 "SouthEast gravity.")
+;;;###autoload
+(defconst X-Static 10 "Static gravity.")
+
+;; backing store
+
+;;;###autoload
+(defconst X-NotUseful 0 "NotUseful backing store.")
+;;;###autoload
+(defconst X-WhenMapped 1 "WhenMapped backing store.")
+;;;###autoload
+(defconst X-Always 2 "Always backing store.")
+
+;;; Event Masks
+
+;;;###autoload
+(defconst XM-NoEvent #x0 "No Event mask.")
+;;;###autoload
+(defconst XM-KeyPress #x1 "KeyPress bitmask.")
+;;;###autoload
+(defconst XM-KeyRelease #x2 "KeyRelease bitmask.")
+;;;###autoload
+(defconst XM-ButtonPress #x4 "ButtonPress bitmask.")
+;;;###autoload
+(defconst XM-ButtonRelease #x8 "ButtonRelease bitmask.")
+;;;###autoload
+(defconst XM-EnterWindow #x10 "EnterWindow bitmask.")
+;;;###autoload
+(defconst XM-LeaveWindow #x20 "LeaveWindow bitmask.")
+;;;###autoload
+(defconst XM-PointerMotion #x40 "PointerMotion bitmask.")
+;;;###autoload
+(defconst XM-PointerMotionHint #x80 "PointerMotionHint bitmask.")
+;;;###autoload
+(defconst XM-Button1Motion #x100 "Button2Motion bitmask.")
+;;;###autoload
+(defconst XM-Button2Motion #x200 "Button2Motion bitmask.")
+;;;###autoload
+(defconst XM-Button3Motion #x400 "Button3Motion bitmask.")
+;;;###autoload
+(defconst XM-Button4Motion #x800 "Button4Motion bitmask.")
+;;;###autoload
+(defconst XM-Button5Motion #x1000 "Button5Motion bitmask.")
+;;;###autoload
+(defconst XM-ButtonMotion #x2000 "Button bitmask.")
+;;;###autoload
+(defconst XM-KeymapState #x4000 "KeymapState bitmask.")
+;;;###autoload
+(defconst XM-Exposure #x8000 "Exposure bitmask.")
+;;;###autoload
+(defconst XM-VisibilityChange #x10000 "VisibilityChange bitmask.")
+;;;###autoload
+(defconst XM-StructureNotify #x20000 "StructureNotify bitmask.")
+;;;###autoload
+(defconst XM-ResizeRedirect #x40000 "ResizeRedirect bitmask.")
+;;;###autoload
+(defconst XM-SubstructureNotify #x80000 "SubstructureNotify bitmask.")
+;;;###autoload
+(defconst XM-SubstructureRedirect #x100000 "SubstructureRedirect bitmask.")
+;;;###autoload
+(defconst XM-FocusChange #x200000 "FocusChange bitmask.")
+;;;###autoload
+(defconst XM-PropertyChange #x400000 "PropertyChange bitmask.")
+;;;###autoload
+(defconst XM-ColormapChange #x800000 "ColormapChange bitmask.")
+;;;###autoload
+(defconst XM-OwnerGrabButton #x1000000 "OwnerGrabButton bitmask.")
+
+;; Event OpCodes
+
+;;;###autoload
+(defconst X-SyntheticMask 128 "Mask the synthetic part off.")
+;;;###autoload
+(defconst X-KeyPress 2 "KeyPress event.")
+;;;###autoload
+(defconst X-KeyRelease 3 "KeyRelease event.")
+;;;###autoload
+(defconst X-ButtonPress 4 "ButtonPress event.")
+;;;###autoload
+(defconst X-ButtonRelease 5 "ButtonRelease event.")
+;;;###autoload
+(defconst X-MotionNotify 6 "MotionNotify event.")
+;;;###autoload
+(defconst X-EnterNotify 7 "EnterNotify event.")
+;;;###autoload
+(defconst X-LeaveNotify 8 "LeaveNotify event.")
+;;;###autoload
+(defconst X-FocusIn 9 "FocusIn event.")
+;;;###autoload
+(defconst X-FocusOut 10 "FocusOut event.")
+;;;###autoload
+(defconst X-KeymapNotify 11 "KeymapNotify event.")
+;;;###autoload
+(defconst X-Expose 12 "Expose event.")
+;;;###autoload
+(defconst X-GraphicsExpose 13 "GraphicsExpose event.")
+;;;###autoload
+(defconst X-NoExpose 14 "NoExpose event.")
+;;;###autoload
+(defconst X-VisibilityNotify 15 "VisibilityNotify event.")
+;;;###autoload
+(defconst X-CreateNotify 16 "CreateNotify event.")
+;;;###autoload
+(defconst X-DestroyNotify 17 "DestroyNotify event.")
+;;;###autoload
+(defconst X-UnmapNotify 18 "UnmapNotify event.")
+;;;###autoload
+(defconst X-MapNotify 19 "MapNotify event.")
+;;;###autoload
+(defconst X-MapRequest 20 "MapRequest event.")
+;;;###autoload
+(defconst X-ReparentNotify 21 "ReparentNotify event.")
+;;;###autoload
+(defconst X-ConfigureNotify 22 "ConfigureNotify event.")
+;;;###autoload
+(defconst X-ConfigureRequest 23 "ConfigureRequest event.")
+;;;###autoload
+(defconst X-GravityNotify 24 "GravityNotify event.")
+;;;###autoload
+(defconst X-ResizeRequest 25 "ResizeRequest event.")
+;;;###autoload
+(defconst X-CirculateNotify 26 "CirculateNotify event.")
+;;;###autoload
+(defconst X-CirculateRequest 27 "CirculateRequest event.")
+;;;###autoload
+(defconst X-PropertyNotify 28 "PropertyNotify event.")
+;;;###autoload
+(defconst X-SelectionClear 29 "SelectionClear event.")
+;;;###autoload
+(defconst X-SelectionRequest 30 "SelectionRequest event.")
+;;;###autoload
+(defconst X-SelectionNotify 31 "SelectionNotify event.")
+;;;###autoload
+(defconst X-ColormapNotify 32 "ColormapNotify event.")
+;;;###autoload
+(defconst X-ClientMessage 33 "ClientMessage event.")
+;;;###autoload
+(defconst X-MappingNotify 34 "MappingNotify event.")
+;;;###autoload
+(defconst X-MaxEvent 35 "1 greater than the largest event opcode.")
+
+;; Properties
+;;;###autoload
+(defconst X-PropertyNewValue 0)
+;;;###autoload
+(defconst X-PropertyDelete 1)
+
+;;; Stacking constants
+;;;###autoload
+(defconst X-Above 0 "Stacking mode Above.")
+;;;###autoload
+(defconst X-Below 1 "Stacking mode Below.")
+;;;###autoload
+(defconst X-TopIf 2 "Stacking mode TopIf.")
+;;;###autoload
+(defconst X-BottomIf 3 "Stacking mode BottomIf.")
+;;;###autoload
+(defconst X-Opposite 4 "Stacking mode Opposite.")
+
+;;; Atom format
+;;;###autoload
+(defconst X-format-8 8 "8 bit formatting for Atoms.")
+;;;###autoload
+(defconst X-format-16 16 "16 bit formatting for Atoms.")
+;;;###autoload
+(defconst X-format-32 32 "32 bit formatting for Atoms.")
+
+;;; Predefined Atoms
+;;;###autoload
+(autoload 'make-X-Atom "xlib-xwin")
+
+;;;###autoload
+(defconst XA-AnyPropertyType (make-X-Atom :id 0.0 :name "") "Any atom.")
+;;;###autoload
+(defconst XA-primary (make-X-Atom :id 1.0 :name "PRIMARY") "Atom primary encoding.")
+;;;###autoload
+(defconst XA-secondary (make-X-Atom :id 2.0 :name "SECONDARY") "Atom secondary encoding.")
+;;;###autoload
+(defconst XA-arc (make-X-Atom :id 3.0 :name "ARC") "Atom arc encoding.")
+;;;###autoload
+(defconst XA-atom (make-X-Atom :id 4.0 :name "ATOM") "Atom atom encoding.")
+;;;###autoload
+(defconst XA-bitmap (make-X-Atom :id 5.0 :name "BITMAP") "Atom bitmap encoding.")
+;;;###autoload
+(defconst XA-cardinal (make-X-Atom :id 6.0 :name "CARDINAL") "Atom cardinal encoding.")
+;;;###autoload
+(defconst XA-colormap (make-X-Atom :id 7.0 :name "COLORMAP") "Atom colormap encoding.")
+;;;###autoload
+(defconst XA-cursor (make-X-Atom :id 8.0 :name "CURSOR") "Atom cursor encoding.")
+;;;###autoload
+(defconst XA-cut-buffer0 (make-X-Atom :id 9.0 :name "XA-CUT-BUFFER0") "Atom cut-buffer0 encoding.")
+;;;###autoload
+(defconst XA-cut-buffer1 (make-X-Atom :id 10.0 :name "CUT-BUFFER1") "Atom cut-buffer1 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer2 (make-X-Atom :id 11.0 :name "CUT-BUFFER2") "Atom cut-buffer2 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer3 (make-X-Atom :id 12.0 :name "CUT-BUFFER3") "Atom cut-buffer3 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer4 (make-X-Atom :id 13.0 :name "CUT-BUFFER4") "Atom cut-buffer4 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer5 (make-X-Atom :id 14.0 :name "CUT-BUFFER5") "Atom cut-buffer5 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer6 (make-X-Atom :id 15.0 :name "CUT-BUFFER6") "Atom cut-buffer6 eoncoding.")
+;;;###autoload
+(defconst XA-cut-buffer7 (make-X-Atom :id 16.0 :name "CUT-BUFFER7") "Atom cut-buffer7 eoncoding.")
+;;;###autoload
+(defconst XA-drawable (make-X-Atom :id 17.0 :name "XA-DRAWABLE") "Atom drawable eoncoding.")
+;;;###autoload
+(defconst XA-font (make-X-Atom :id 18.0 :name "FONT") "Atom font eoncoding.")
+;;;###autoload
+(defconst XA-integer (make-X-Atom :id 19.0 :name "INTEGER") "Atom integer eoncoding.")
+;;;###autoload
+(defconst XA-pixmap (make-X-Atom :id 20.0 :name "PIXMAP") "Atom pixmap eoncoding.")
+;;;###autoload
+(defconst XA-point (make-X-Atom :id 21.0 :name "POINT") "Atom point eoncoding.")
+;;;###autoload
+(defconst XA-rectangle (make-X-Atom :id 22.0 :name "RECTANGLE") "Atom rectangle eoncoding.")
+;;;###autoload
+(defconst XA-resource-manager (make-X-Atom :id 23.0 :name "RESOURCE-MANAGER") "Atom resource-manager eoncoding.")
+;;;###autoload
+(defconst XA-rgb-color-map (make-X-Atom :id 24.0 :name "RGB-COLOR-MAP") "Atom rgb-color-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-best-map (make-X-Atom :id 25.0 :name "RGB-BEST-MAP") "Atom rgb-best-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-blue-map (make-X-Atom :id 26.0 :name "RGB-BLUE-MAP") "Atom rgb-blue-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-default-map (make-X-Atom :id 27.0 :name "RGB-DEFAULT-MAP") "Atom rgb-default-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-gray-map (make-X-Atom :id 28.0 :name "RGB-GRAY-MAP") "Atom rgb-gray-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-green-map (make-X-Atom :id 29.0 :name "RGB-GREEN-MAP") "Atom rgb-green-map eoncoding.")
+;;;###autoload
+(defconst XA-rgb-red-map (make-X-Atom :id 30.0 :name "RGB-RED-MAP") "Atom rgb-red-map eoncoding.")
+;;;###autoload
+(defconst XA-string (make-X-Atom :id 31.0 :name "STRING") "Atom string eoncoding.")
+;;;###autoload
+(defconst XA-visualid (make-X-Atom :id 32.0 :name "VISUALID") "Atom visualid eoncoding.")
+;;;###autoload
+(defconst XA-window (make-X-Atom :id 33.0 :name "WINDOW") "Atom window eoncoding.")
+;;;###autoload
+(defconst XA-wm-command (make-X-Atom :id 34.0 :name "WM-COMMAND") "Atom wm-command eoncoding.")
+;;;###autoload
+(defconst XA-wm-hints (make-X-Atom :id 35.0 :name "WM-HINTS") "Atom wm-hints eoncoding.")
+;;;###autoload
+(defconst XA-wm-client-machine (make-X-Atom :id 36.0 :name "WM-CLIENT-MACHINE") "Atom wm-client-machine eoncoding.")
+;;;###autoload
+(defconst XA-wm-icon-name (make-X-Atom :id 37.0 :name "WM-ICON-NAME") "Atom wm-icon-name eoncoding.")
+;;;###autoload
+(defconst XA-wm-icon-size (make-X-Atom :id 38.0 :name "WM-ICON-SIZE") "Atom wm-icon-size eoncoding.")
+;;;###autoload
+(defconst XA-wm-name (make-X-Atom :id 39.0 :name "WM-NAME") "Atom wm-name eoncoding.")
+;;;###autoload
+(defconst XA-wm-normal-hints (make-X-Atom :id 40.0 :name "WM-NORMAL-HINTS") "Atom wm-normal-hints eoncoding.")
+;;;###autoload
+(defconst XA-wm-size-hints (make-X-Atom :id 41.0 :name "WM-SIZE-HINTS") "Atom wm-size-hints eoncoding.")
+;;;###autoload
+(defconst XA-wm-zoom-hints (make-X-Atom :id 42.0 :name "WM-ZOOM-HINTS") "Atom wm-zoom-hints eoncoding.")
+;;;###autoload
+(defconst XA-min-space (make-X-Atom :id 43.0 :name "MIN-SPACE") "Atom min-space eoncoding.")
+;;;###autoload
+(defconst XA-norm-space (make-X-Atom :id 44.0 :name "NORM-SPACE") "Atom norm-space eoncoding.")
+;;;###autoload
+(defconst XA-max-space (make-X-Atom :id 45.0 :name "MAX-SPACE") "Atom max-space eoncoding.")
+;;;###autoload
+(defconst XA-end-space (make-X-Atom :id 46.0 :name "END-SPACE") "Atom end-space eoncoding.")
+;;;###autoload
+(defconst XA-superscript-x (make-X-Atom :id 47.0 :name "SUPERSCRIPT-X") "Atom superscript-x eoncoding.")
+;;;###autoload
+(defconst XA-superscript-y (make-X-Atom :id 48.0 :name "SUPERSCRIPT-Y") "Atom superscript-y eoncoding.")
+;;;###autoload
+(defconst XA-subscript-x (make-X-Atom :id 49.0 :name "SUBSCRIPT-X") "Atom subscript-x eoncoding.")
+;;;###autoload
+(defconst XA-subscript-y (make-X-Atom :id 50.0 :name "SUBSCRIPT-Y") "Atom subscript-y eoncoding.")
+;;;###autoload
+(defconst XA-underline-position (make-X-Atom :id 51.0 :name "UNDERLINE-POSITION") "Atom underline-position eoncoding.")
+;;;###autoload
+(defconst XA-underline-thickness (make-X-Atom :id 52.0 :name "UNDERLINE-THICKNESS") "Atom underline-thickness eoncoding.")
+;;;###autoload
+(defconst XA-strikeout-ascent (make-X-Atom :id 53.0 :name "STRIKEOUT-ASCENT") "Atom strikeout-ascent eoncoding.")
+;;;###autoload
+(defconst XA-strikeout-descent (make-X-Atom :id 54.0 :name "STRIKEOUT-DESCENT") "Atom strikeout-descent eoncoding.")
+;;;###autoload
+(defconst XA-italic-angle (make-X-Atom :id 55.0 :name "ITALIC-ANGLE") "Atom italic-angle eoncoding.")
+;;;###autoload
+(defconst XA-x-height (make-X-Atom :id 56.0 :name "X-HEIGHT") "Atom x-height eoncoding.")
+;;;###autoload
+(defconst XA-quad-width (make-X-Atom :id 57.0 :name "QUAD-WIDTH") "Atom quad-width eoncoding.")
+;;;###autoload
+(defconst XA-weight (make-X-Atom :id 58.0 :name "WEIGHT") "Atom weight eoncoding.")
+;;;###autoload
+(defconst XA-point-size (make-X-Atom :id 59.0 :name "POINT-SIZE") "Atom point-size eoncoding.")
+;;;###autoload
+(defconst XA-resolution (make-X-Atom :id 60.0 :name "RESOLUTION") "Atom resolution eoncoding.")
+;;;###autoload
+(defconst XA-copyright (make-X-Atom :id 61.0 :name "COPYRIGHT") "Atom copyright eoncoding.")
+;;;###autoload
+(defconst XA-notice (make-X-Atom :id 62.0 :name "NOTICE") "Atom notice eoncoding.")
+;;;###autoload
+(defconst XA-font-name (make-X-Atom :id 63.0 :name "FONT-NAME") "Atom font-name eoncoding.")
+;;;###autoload
+(defconst XA-family-name (make-X-Atom :id 64.0 :name "FAMILY-NAME") "Atom family-name eoncoding.")
+;;;###autoload
+(defconst XA-full-name (make-X-Atom :id 65.0 :name "FULL-NAME") "Atom full-name eoncoding.")
+;;;###autoload
+(defconst XA-cap-height (make-X-Atom :id 66.0 :name "CAP-HEIGHT") "Atom cap-height eoncoding.")
+;;;###autoload
+(defconst XA-wm-class (make-X-Atom :id 67.0 :name "WM-CLASS") "Atom wm-class eoncoding.")
+;;;###autoload
+(defconst XA-wm-transient-for (make-X-Atom :id 68.0 :name "WM-TRANSIENT-FOR") "Atom wm-transient-for eoncoding.")
+
+;;; Property Modes for atoms
+;;;###autoload
+(defconst X-PropModeReplace 0 "Property Mode Replace")
+;;;###autoload
+(defconst X-PropModePrepend 1 "Property Mode Prepend")
+;;;###autoload
+(defconst X-PropModeAppend  2 "Property Mode Append")
+
+;;; KeyButtonMask
+
+;;;###autoload
+(defconst X-Shift #x1 "Shift bitmask.")
+;;;###autoload
+(defconst X-Lock #x2 "Lock bitmask.")
+;;;###autoload
+(defconst X-Control #x4 "Control bitmask.")
+;;;###autoload
+(defconst X-Mod1 #x8 "Mod1 bitmask.")
+;;;###autoload
+(defconst X-Mod2 #x10 "Mod2 bitmask.")
+;;;###autoload
+(defconst X-Mod3 #x20 "Mod3 bitmask.")
+;;;###autoload
+(defconst X-Mod4 #x40 "Mod4 bitmask.")
+;;;###autoload
+(defconst X-Mod5 #x80 "Mod5 bitmask.")
+;;;###autoload
+(defconst X-Button1 #x100 "Button1 bitmask.")
+;;;###autoload
+(defconst X-Button2 #x200 "Button2 bitmask.")
+;;;###autoload
+(defconst X-Button3 #x400 "Button3 bitmask.")
+;;;###autoload
+(defconst X-Button4 #x800 "Button4 bitmask.")
+;;;###autoload
+(defconst X-Button5 #x1000 "Button5 bitmask.")
+
+;;;###autoload
+(defconst X-XButton1 1)
+;;;###autoload
+(defconst X-XButton2 2)
+;;;###autoload
+(defconst X-XButton3 3)
+;;;###autoload
+(defconst X-XButton4 4)
+;;;###autoload
+(defconst X-XButton5 5)
+;;; Graphic context stuff
+;;
+
+;;; functions
+;;;###autoload
+(defconst X-GXClear 0 "GC function type id.")
+;;;###autoload
+(defconst X-GXAnd 1 "GC function type id.")
+;;;###autoload
+(defconst X-GXAndReverse 2 "GC function type id.")
+;;;###autoload
+(defconst X-GXCopy 3 "GC function type id.")
+;;;###autoload
+(defconst X-GXAndInverted 4 "GC function type id.")
+;;;###autoload
+(defconst X-GXNoOp 5 "GC function type id.")
+;;;###autoload
+(defconst X-GXXor 6 "GC function type id.")
+;;;###autoload
+(defconst X-GXOr 7 "GC function type id.")
+;;;###autoload
+(defconst X-GXNor 8 "GC function type id.")
+;;;###autoload
+(defconst X-GXEquiv 9 "GC function type id.")
+;;;###autoload
+(defconst X-GXInvert 10 "GC function type id.")
+;;;###autoload
+(defconst X-GXOrReverse 11 "GC function type id.")
+;;;###autoload
+(defconst X-GXCopyInverted 12 "GC function type id.")
+;;;###autoload
+(defconst X-GXOrInverted 13 "GC function type id.")
+;;;###autoload
+(defconst X-GXNand 14 "GC function type id.")
+;;;###autoload
+(defconst X-GXSet 15 "GC function type id.")
+
+;; line styles
+;;;###autoload
+(defconst X-LineSolid 0 "GC line-style.")
+;;;###autoload
+(defconst X-LineOnOffDash 1 "GC line-style.")
+;;;###autoload
+(defconst X-LineDoubleDash 2 "GC line-style.")
+
+;; cap-styles
+;;;###autoload
+(defconst X-CapNotLast 0 "GC cap-styles.")
+;;;###autoload
+(defconst X-CapButt 1 "GC cap-styles.")
+;;;###autoload
+(defconst X-CapRound 2 "GC cap-styles.")
+;;;###autoload
+(defconst X-CapProjecting 3 "GC cap-styles.")
+
+;; join styles
+;;;###autoload
+(defconst X-JoinMiter 0 "GC join-style.")
+;;;###autoload
+(defconst X-JoinRound 1 "GC join-style.")
+;;;###autoload
+(defconst X-JoinBevel 2 "GC join-style.")
+
+;; fill style
+;;;###autoload
+(defconst X-FillSolid 0 "GC fill-style.")
+;;;###autoload
+(defconst X-FillTiled 1 "GC fill-style.")
+;;;###autoload
+(defconst X-FillStippled 2 "GC fill-style.")
+;;;###autoload
+(defconst X-FillOpaqueStippled 3 "GC fill-style.")
+
+;; fill rule
+;;;###autoload
+(defconst X-EvenOddRule 0 "GC fill-rule.")
+;;;###autoload
+(defconst X-WindingRule 1 "GC fill-rule.")
+
+;; arc-mode
+;;;###autoload
+(defconst X-ArcChord 0 "GC arc mode.")
+;;;###autoload
+(defconst X-ArcPieSlice 1 "GC arc mode.")
+
+;; Subwindow mode
+;;;###autoload
+(defconst X-ClipByChildren 0 "GC subwindow-mode.")
+;;;###autoload
+(defconst X-IncludeInferiors 1 "GC subwindow-mode.")
+
+;; XSetClipRectangles ordering
+;;;###autoload
+(defconst X-UnSorted 0 "Unsorted list.")
+;;;###autoload
+(defconst X-YSorted 1 "Sorted by Y.")
+;;;###autoload
+(defconst X-YXSorted 2 "Sorted by X and Y.")
+;;;###autoload
+(defconst X-YXBanded 3)
+
+;; Imaging
+;;;###autoload
+(defconst X-XYBitmap 0)			; depth 1, XYFormat
+;;;###autoload
+(defconst X-XYPixmap 1)			; depth == drawable depth
+;;;###autoload
+(defconst X-ZPixmap 2)			; depth == drawable depth
+
+;;; Some color type stuff
+;;
+;;;###autoload
+(defconst X-AllocNone 0 "No color entries writable.")
+;;;###autoload
+(defconst X-AllocAll  1 "All color entries writable.")
+
+;;;###autoload
+(defconst X-DoRed 1 "Do Red mask.")
+;;;###autoload
+(defconst X-DoGreen 2 "Do Green mask.")
+;;;###autoload
+(defconst X-DoBlue 4 "Do blue mask.")
+;;;###autoload
+(defconst X-DoRedGreenBlue 7 "All Color Dos ored together.")
+
+;;; Some drawing constants
+;;
+;;;###autoload
+(defconst X-Origin 0 "Specifies point drawn with relation to origin.")
+;;;###autoload
+(defconst X-Previous 1 "Specifies points draw with relation to previous point.")
+
+
+;; Misc
+;;;###autoload
+(defconst X-None 0 "universal null resource or null atom")
+
+;;;###autoload
+(defconst X-RevertToNone 0 "for XSetInputFocus")
+;;;###autoload
+(defconst X-RevertToPointerRoot 1 "for XSetInputFocus")
+;;;###autoload
+(defconst X-RevertToParent 2 "for XSetInputFocus")
+
+;;;###autoload
+(defconst X-ParentRelative 1
+  "Background pixmap in CreateWindow and ChangeWindowAttributes.")
+;;;###autoload
+(defconst X-CopyFromParent 0
+  "Border pixmap in CreateWindow and ChangeWindowAttributes special
+  VisualID and special window class passed to CreateWindow.")
+;;;###autoload
+(defconst X-PointerWindow 0 "destination window in SendEvent")
+;;;###autoload
+(defconst X-InputFocus 1 "destination window in SendEvent")
+;;;###autoload
+(defconst X-PointerRoot	1 "focus window in SetInputFocus")
+;;;###autoload
+(defconst X-AnyPropertyType 0 "special Atom, passed to GetProperty")
+;;;###autoload
+(defconst X-AnyKey 0 "special Key Code, passed to GrabKey")
+;;;###autoload
+(defconst X-AnyButton 0 "special Button Code, passed to GrabButton")
+;;;###autoload
+(defconst X-AllTemporary 0 "special Resource ID passed to KillClient")
+;;;###autoload
+(defconst X-CurrentTime	0 "special Time")
+;;;###autoload
+(defconst X-NoSymbol 0 "special KeySym")
+
+;;;###autoload
+(defconst X-GrabModeSync 0 "specific mode")
+;;;###autoload
+(defconst X-GrabModeAsync 1 "specific mode")
+
+;;;###autoload
+(defconst X-AllPlanes -1 "Mask for all planes in XGetImage.")
+
+;; AllowEvents modes
+;;;###autoload
+(defconst X-AsyncPointer 0)
+;;;###autoload
+(defconst X-SyncPointer 1)
+;;;###autoload
+(defconst X-ReplayPointer 2)
+;;;###autoload
+(defconst X-AsyncKeyboard 3)
+;;;###autoload
+(defconst X-SyncKeyboard 4)
+;;;###autoload
+(defconst X-ReplayKeyboard 5)
+;;;###autoload
+(defconst X-AsyncBoth 6)
+;;;###autoload
+(defconst X-SyncBoth 7)
+
+;; For window Attributes
+;;;###autoload
+(defconst X-CWBackPixmap #x1)
+;;;###autoload
+(defconst X-CWBackPixel #x2)
+;;;###autoload
+(defconst X-CWBorderPixmap #x4)
+;;;###autoload
+(defconst X-CWBorderPixel #x8)
+;;;###autoload
+(defconst X-CWBitGravity #x10)
+;;;###autoload
+(defconst X-CWWinGravity #x20)
+;;;###autoload
+(defconst X-CWBackingStore #x40)
+;;;###autoload
+(defconst X-CWBackingPlanes #x80)
+;;;###autoload
+(defconst X-CWBackingPixel #x100)
+;;;###autoload
+(defconst X-CWOverrideRedirect #x200)
+;;;###autoload
+(defconst X-CWSaveUnder #x400)
+;;;###autoload
+(defconst X-CWEventMask #x800)
+;;;###autoload
+(defconst X-CWDontPropagate #x1000)
+;;;###autoload
+(defconst X-CWColormap #x2000)
+;;;###autoload
+(defconst X-CWCursor #x4000)
+
+;; used in ChangeSaveSet
+;;;###autoload
+(defconst X-SetModeInsert 0)
+;;;###autoload
+(defconst X-SetModeDelete 1)
+
+;; used in ConfigureWindow
+;;;###autoload
+(defconst X-CWX #x1)
+;;;###autoload
+(defconst X-CWY #x2)
+;;;###autoload
+(defconst X-CWWidth #x4)
+;;;###autoload
+(defconst X-CWHeight #x8)
+;;;###autoload
+(defconst X-CWBorderWidth #x10)
+;;;###autoload
+(defconst X-CWSibling #x20)
+;;;###autoload
+(defconst X-CWStackMode #x40)
+
+;;; Cursors
+;;;###autoload
+(defconst X-XC-num_glyphs 154)
+;;;###autoload
+(defconst X-XC-X_cursor 0)
+;;;###autoload
+(defconst X-XC-arrow 2)
+;;;###autoload
+(defconst X-XC-based_arrow_down 4)
+;;;###autoload
+(defconst X-XC-based_arrow_up 6)
+;;;###autoload
+(defconst X-XC-boat 8)
+;;;###autoload
+(defconst X-XC-bogosity 10)
+;;;###autoload
+(defconst X-XC-bottom_left_corner 12)
+;;;###autoload
+(defconst X-XC-bottom_right_corner 14)
+;;;###autoload
+(defconst X-XC-bottom_side 16)
+;;;###autoload
+(defconst X-XC-bottom_tee 18)
+;;;###autoload
+(defconst X-XC-box_spiral 20)
+;;;###autoload
+(defconst X-XC-center_ptr 22)
+;;;###autoload
+(defconst X-XC-circle 24)
+;;;###autoload
+(defconst X-XC-clock 26)
+;;;###autoload
+(defconst X-XC-coffee_mug 28)
+;;;###autoload
+(defconst X-XC-cross 30)
+;;;###autoload
+(defconst X-XC-cross_reverse 32)
+;;;###autoload
+(defconst X-XC-crosshair 34)
+;;;###autoload
+(defconst X-XC-diamond_cross 36)
+;;;###autoload
+(defconst X-XC-dot 38)
+;;;###autoload
+(defconst X-XC-dotbox 40)
+;;;###autoload
+(defconst X-XC-double_arrow 42)
+;;;###autoload
+(defconst X-XC-draft_large 44)
+;;;###autoload
+(defconst X-XC-draft_small 46)
+;;;###autoload
+(defconst X-XC-draped_box 48)
+;;;###autoload
+(defconst X-XC-exchange 50)
+;;;###autoload
+(defconst X-XC-fleur 52)
+;;;###autoload
+(defconst X-XC-gobbler 54)
+;;;###autoload
+(defconst X-XC-gumby 56)
+;;;###autoload
+(defconst X-XC-hand1 58)
+;;;###autoload
+(defconst X-XC-hand2 60)
+;;;###autoload
+(defconst X-XC-heart 62)
+;;;###autoload
+(defconst X-XC-icon 64)
+;;;###autoload
+(defconst X-XC-iron_cross 66)
+;;;###autoload
+(defconst X-XC-left_ptr 68)
+;;;###autoload
+(defconst X-XC-left_side 70)
+;;;###autoload
+(defconst X-XC-left_tee 72)
+;;;###autoload
+(defconst X-XC-leftbutton 74)
+;;;###autoload
+(defconst X-XC-ll_angle 76)
+;;;###autoload
+(defconst X-XC-lr_angle 78)
+;;;###autoload
+(defconst X-XC-man 80)
+;;;###autoload
+(defconst X-XC-middlebutton 82)
+;;;###autoload
+(defconst X-XC-mouse 84)
+;;;###autoload
+(defconst X-XC-pencil 86)
+;;;###autoload
+(defconst X-XC-pirate 88)
+;;;###autoload
+(defconst X-XC-plus 90)
+;;;###autoload
+(defconst X-XC-question_arrow 92)
+;;;###autoload
+(defconst X-XC-right_ptr 94)
+;;;###autoload
+(defconst X-XC-right_side 96)
+;;;###autoload
+(defconst X-XC-right_tee 98)
+;;;###autoload
+(defconst X-XC-rightbutton 100)
+;;;###autoload
+(defconst X-XC-rtl_logo 102)
+;;;###autoload
+(defconst X-XC-sailboat 104)
+;;;###autoload
+(defconst X-XC-sb_down_arrow 106)
+;;;###autoload
+(defconst X-XC-sb_h_double_arrow 108)
+;;;###autoload
+(defconst X-XC-sb_left_arrow 110)
+;;;###autoload
+(defconst X-XC-sb_right_arrow 112)
+;;;###autoload
+(defconst X-XC-sb_up_arrow 114)
+;;;###autoload
+(defconst X-XC-sb_v_double_arrow 116)
+;;;###autoload
+(defconst X-XC-shuttle 118)
+;;;###autoload
+(defconst X-XC-sizing 120)
+;;;###autoload
+(defconst X-XC-spider 122)
+;;;###autoload
+(defconst X-XC-spraycan 124)
+;;;###autoload
+(defconst X-XC-star 126)
+;;;###autoload
+(defconst X-XC-target 128)
+;;;###autoload
+(defconst X-XC-tcross 130)
+;;;###autoload
+(defconst X-XC-top_left_arrow 132)
+;;;###autoload
+(defconst X-XC-top_left_corner 134)