summaryrefslogtreecommitdiff
path: root/progs/lib/X11
diff options
context:
space:
mode:
authorYale AI Dept <ai@nebula.cs.yale.edu>1993-07-14 13:08:00 -0500
committerDuncan McGreggor <duncan.mcgreggor@rackspace.com>1993-07-14 13:08:00 -0500
commit4e987026148fe65c323afbc93cd560c07bf06b3f (patch)
tree26ae54177389edcbe453d25a00c38c2774e8b7d4 /progs/lib/X11
Import to github.
Diffstat (limited to 'progs/lib/X11')
-rw-r--r--progs/lib/X11/README11
-rw-r--r--progs/lib/X11/clx-patch.lisp39
-rw-r--r--progs/lib/X11/xlib.hs877
-rw-r--r--progs/lib/X11/xlib.hu5
-rw-r--r--progs/lib/X11/xlibclx.scm1262
-rw-r--r--progs/lib/X11/xlibprims.hi1465
-rw-r--r--progs/lib/X11/xlibprims.hu5
7 files changed, 3664 insertions, 0 deletions
diff --git a/progs/lib/X11/README b/progs/lib/X11/README
new file mode 100644
index 0000000..db748e4
--- /dev/null
+++ b/progs/lib/X11/README
@@ -0,0 +1,11 @@
+This directory contains the Haskell->CLX support code.
+
+If you see errors like "ID 42 is a :WM_RESIZE_HINTS, not a window",
+you can get rid of them by loading clx-patch.lisp. This seems to be a
+bug where CLX is not consistent with the protocol in some way; we've
+seen it on some machines and not others. The line
+
+(load "$HASKELL/progs/lib/X11/clx-patch.lisp")
+
+can be placed in your .yhaskell file to load the patch on startup.
+
diff --git a/progs/lib/X11/clx-patch.lisp b/progs/lib/X11/clx-patch.lisp
new file mode 100644
index 0000000..fe2a5e3
--- /dev/null
+++ b/progs/lib/X11/clx-patch.lisp
@@ -0,0 +1,39 @@
+(lisp:in-package 'xlib)
+(defmacro generate-lookup-functions (useless-name &body types)
+ `(within-definition (,useless-name generate-lookup-functions)
+ ,@(mapcar
+ #'(lambda (type)
+ `(defun ,(xintern 'lookup- type)
+ (display id)
+ (declare (type display display)
+ (type resource-id id))
+ (declare (values ,type))
+ ,(if (member type *clx-cached-types*)
+ `(let ((,type (lookup-resource-id display id)))
+ (cond ((null ,type) ;; Not found, create and s
+ave it.
+ (setq ,type (,(xintern 'make- type)
+ :display display :id id))
+ (save-id display id ,type))
+ ;; Found. Check the type
+ ,(cond ((null '()) ;*type-check?*)
+ `(t ,type))
+ ((member type '(window pixmap))
+ `((type? ,type 'drawable) ,type)
+)
+ (t `((type? ,type ',type) ,type))
+)
+ ,@(when '() ;*type-check?*
+ `((t (x-error 'lookup-error
+ :id id
+ :display display
+ :type ',type
+ :object ,type))))))
+ ;; Not being cached. Create a new one each time.
+ `(,(xintern 'make- type)
+ :display display :id id))))
+ types)))
+(macroexpand
+ (generate-lookup-functions ignore
+ window))
+
diff --git a/progs/lib/X11/xlib.hs b/progs/lib/X11/xlib.hs
new file mode 100644
index 0000000..716cc8c
--- /dev/null
+++ b/progs/lib/X11/xlib.hs
@@ -0,0 +1,877 @@
+module Xlib(XLibTypes..,XLibPrims..) where
+import XLibTypes
+import XLibPrims
+
+module XLibTypes(XDisplay, XScreen, XWindow, XGcontext, XPixmap,
+ XColormap, XCursor, XFont, XImage, XMaybe(..), XError(..),
+ XBitmap(..), XKeysymTable(..), XBitVec(..),
+ XPixarray(..), XByteVec(..), XAtom(..), XProperty(..),
+ XPixel(..), XDrawable(..), XTime(..), XSwitch(..),
+ XWindowPlace(..), XEventMode(..), XEventKind(..),
+ XWindowVisibility(..), XWindowStackMode(..),
+ XPropertyState(..), XMapReqType(..), XGraphFun(..),
+ XEvent(..), XEventType(..), XEventSlot(..), XEventMask(..),
+ XEventMaskKey(..), XStateMask(..), XStateMaskKey(..),
+ XWinAttribute(..),XGCAttribute(..), XImAttribute(..),
+ XGrabAttribute(..), XArcMode(..), XCapStyle(..),
+ XClipMask(..), XFillRule(..), XFillStyle(..),
+ XFunction(..), XJoinStyle(..), XLineStyle(..),
+ XSubwindowMode(..), XPoint(..), XSize(..), XRect(..),
+ XArc(..), XBitmapFormat(..), XByteOrder(..),
+ XPixmapFormat(..), XVisualInfo(..), XVisualClass(..),
+ XFillContent(..), XBackingStore(..), XGravity(..),
+ XWindowClass(..), XMapState(..), XImageData(..),
+ XImageFormat(..), XImageType(..), XDrawDirection(..),
+ XColor(..), XInputFocus(..), XGrabStatus(..),
+ XKeysym(..), XCloseDownMode(..), XScreenSaver(..))
+ where
+
+data XMaybe a {-# STRICT #-} = XSome a
+ | XNull
+ --deriving (Printers)
+
+data XDisplay = XDisplay --deriving (Printers)
+data XScreen = XScreen --deriving (Printers)
+data XWindow = XWindow --deriving (Printers)
+data XGcontext = XGcontext --deriving (Printers)
+data XPixmap = XPixmap --deriving (Printers)
+data XColormap = XColormap --deriving (Printers)
+data XCursor = XCursor --deriving (Printers)
+data XFont = XFont --deriving (Printers)
+data XImage = XImage --deriving (Printers)
+
+data XError {-# STRICT #-}
+ = XError String
+ --deriving Printers
+data XBitmap {-# STRICT #-}
+ = XBitmap [[Int]]
+instance Text(XBitmap) where
+ showsPrec p x = showString "<<XBitMap>>"
+
+data XKeysymTable {-# STRICT #-}
+ = XKeysymTable [[Integer]]
+instance Text(XKeysymTable) where
+ showsPrec p x = showString "<<XKeysymTable>>"
+
+data XBitVec {-# STRICT #-}
+ = XBitVec [Int]
+instance Text(XBitVec) where
+ showsPrec p x = showString "<<XBitVec>>"
+
+data XPixarray {-# STRICT #-}
+ = XPixarray [[Integer]]
+instance Text(XPixarray) where
+ showsPrec p x = showString "<<XPixarray>>"
+
+data XByteVec {-# STRICT #-}
+ = XByteVec [Int]
+instance Text(XByteVec) where
+ showsPrec p x = showString "<<XByteVec>>"
+
+
+data XAtom {-# STRICT #-}
+ = XAtom String
+ --deriving (Printers)
+
+data XProperty {-#STRICT #-}
+ = XProperty [Integer] -- data
+ XAtom -- type
+ Int -- format
+ --deriving (Printers)
+
+data XPixel {-# STRICT #-}
+ = XPixel Integer
+ --deriving (Printers)
+
+data XDrawable {-# STRICT #-}
+ = XDrawWindow XWindow
+ | XDrawPixmap XPixmap
+ --deriving (Printers)
+
+data XTime {-# STRICT #-}
+ = XTime Integer
+ --deriving (Printers)
+
+data XSwitch = XOn
+ | XOff
+ --deriving (Printers)
+
+data XWindowPlace = XTopPlace
+ | XBottomPlace
+ --deriving (Printers)
+
+data XEventMode = XNormalMode
+ | XGrabMode
+ | XUngrabMode
+ | XWhileGrabbedMode
+ --deriving (Printers)
+
+data XEventKind = XAncestorKind
+ | XVirtualKind
+ | XInferiorKind
+ | XNonlinearKind
+ | XNonlinearVirtualKind
+ | XPointerKind
+ | XPointerRootKind
+ | XNoneKind
+ --deriving (Printers)
+
+data XWindowVisibility = XUnobscured
+ | XPartiallyObscured
+ | XFullyObscured
+ --deriving (Printers)
+
+data XWindowStackMode = XStackAbove
+ | XStackBelow
+ | XStackTopIf
+ | XStackBottomIf
+ | XStackOpposite
+ --deriving (Printers)
+
+data XPropertyState = XNewValueProperty
+ | XDeletedProperty
+ --deriving (Printers)
+
+data XMapReqType = XModifierMapping
+ | XKeyboardMapping
+ | XPointerMapping
+ --deriving (Printers)
+
+data XGraphFun {-# STRICT #-}
+ = XGraphFun Int -- major opcode
+ Int -- minor opcode
+ --deriving (Printers)
+
+data XEvent {-# STRICT #-}
+ = XEvent XEventType
+ [XEventSlot]
+
+data XEventType = XKeyPressEvent
+ | XKeyReleaseEvent
+ | XButtonPressEvent
+ | XButtonReleaseEvent
+ | XMotionNotifyEvent
+ | XEnterNotifyEvent
+ | XLeaveNotifyEvent
+ | XFocusInEvent
+ | XFocusOutEvent
+ | XKeymapNotifyEvent
+ | XMappingNotifyEvent
+ | XExposureEvent
+ | XGraphicsExposureEvent
+ | XNoExposureEvent
+ | XCirculateNotifyEvent
+ | XConfigureNotifyEvent
+ | XCreateNotifyEvent
+ | XDestroyNotifyEvent
+ | XGravityNotifyEvent
+ | XMapNotifyEvent
+ | XReparentNotifyEvent
+ | XUnmapNotifyEvent
+ | XVisibilityNotifyEvent
+ | XCirculateRequestEvent
+ | XColormapNotifyEvent
+ | XConfigureRequestEvent
+ | XMapRequestEvent
+ | XResizeRequestEvent
+ | XClientMessageEvent
+ | XPropertyNotifyEvent
+ | XSelectionClearEvent
+ | XSelectionNotifyEvent
+ | XSelectionRequestEvent
+ | XOtherEvents
+ --deriving Printers
+
+data XEventSlot {-# STRICT #-}
+ = XEventWindow XWindow
+ | XEventEventWindow XWindow
+ | XEventCode Int
+ | XEventPos XPoint
+ | XEventState XStateMask
+ | XEventTime XTime
+ | XEventRoot XWindow
+ | XEventRootPos XPoint
+ | XEventChild (XMaybe XWindow)
+ | XEventSameScreenP Bool
+ | XEventHintP Bool
+ | XEventMode XEventMode
+ | XEventKind XEventKind
+ | XEventFocusP Bool
+ | XEventKeymap XBitVec
+ | XEventRequest XMapReqType
+ | XEventStart Int
+ | XEventCount Int
+ | XEventRect XRect
+ | XEventDrawable XDrawable
+ | XEventXGraphFun XGraphFun
+ | XEventPlace XWindowPlace
+ | XEventBorderWidth Int
+ | XEventAboveSibling (XMaybe XWindow)
+ | XEventOverrideRedirectP Bool
+ | XEventParent XWindow
+ | XEventConfigureP Bool
+ | XEventVisibility XWindowVisibility
+ | XEventNewP Bool
+ | XEventInstalledP Bool
+ | XEventStackMode XWindowStackMode
+ | XEventValueMask Int
+ | XEventSize XSize
+ | XEventMessage XProperty
+ | XEventPropertyState XPropertyState
+ | XEventAtom XAtom
+ | XEventSelection XAtom
+ | XEventTarget XAtom
+ | XEventProperty (XMaybe XAtom)
+ | XEventRequestor XWindow
+ --deriving Printers
+
+data XEventMask {-# STRICT #-}
+ = XEventMask [XEventMaskKey]
+ --deriving (Printers)
+
+data XEventMaskKey
+ = XButton1Motion
+ | XButton2Motion
+ | XButton3Motion
+ | XButton4Motion
+ | XButton5Motion
+ | XButtonMotion
+ | XButtonPress
+ | XButtonRelease
+ | XColormapChange
+ | XEnterWindow
+ | XExposure
+ | XFocusChange
+ | XKeyPress
+ | XKeyRelease
+ | XKeymapState
+ | XLeaveWindow
+ | XOwnerGrabButton
+ | XPointerMotion
+ | XPointerMotionHint
+ | XPropertyChange
+ | XResizeRedirect
+ | XStructureNotify
+ | XSubstructureRedirect
+ | XVisibilityChange
+ --deriving (Printers)
+
+data XStateMask {-# STRICT #-}
+ = XStateMask [XStateMaskKey]
+ --deriving (Printers)
+
+data XStateMaskKey
+ = XShift
+ | XLock
+ | XControl
+ | XMod1
+ | XMod2
+ | XMod3
+ | XMod4
+ | XMod5
+ | XButton1
+ | XButton2
+ | XButton3
+ | XButton4
+ | XButton5
+ --deriving (Printers)
+
+data XWinAttribute {-# STRICT #-}
+ = XWinBackground XPixel
+ | XWinEventMask XEventMask
+ | XWinDepth Int
+ | XWinBorderWidth Int
+ | XWinClass XWindowClass
+ | XWinVisual Int
+ | XWinBorder XFillContent
+ | XWinBackingStore XBackingStore
+ | XWinBackingPlanes XPixel
+ | XWinBackingPixel XPixel
+ | XWinSaveUnder XSwitch
+ | XWinDoNotPropagateMask XEventMask
+ | XWinOverrideRedirect XSwitch
+ | XWinColormap XColormap
+ | XWinCursor XCursor
+ --deriving (Printers)
+
+data XGCAttribute {-# STRICT #-}
+ = XGCArcMode XArcMode
+ | XGCBackground XPixel
+ | XGCCapStyle XCapStyle
+ | XGCClipMask XClipMask
+ | XGCClipOrigin XPoint
+ | XGCDashOffset Int
+ | XGCDashes [Int]
+ | XGCExposures XSwitch
+ | XGCFillRule XFillRule
+ | XGCFillStyle XFillStyle
+ | XGCFont XFont
+ | XGCForeground XPixel
+ | XGCFunction XFunction
+ | XGCJoinStyle XJoinStyle
+ | XGCLineStyle XLineStyle
+ | XGCLineWidth Int
+ | XGCPlaneMask XPixel
+ | XGCStipple XPixmap
+ | XGCSubwindowMode XSubwindowMode
+ | XGCTile XPixmap
+ | XGCTileOrigin XPoint
+ --deriving (Printers)
+
+data XImAttribute {-# STRICT #-}
+ = XImBitLsbFirstP Bool
+ | XImBitsPerPixel Int
+ | XImBlueMask XPixel
+ | XImByteLsbFirstP Bool
+ | XImBytesPerLine Int
+ | XImData XImageData
+ | XImDepth Int
+ | XImFormat XImageFormat
+ | XImGreenMask XPixel
+ | XImSize XSize
+ | XImName String
+ | XImRedMask XPixel
+ | XImHotSpot XPoint
+ --deriving (Printers)
+
+data XGrabAttribute {-# STRICT #-}
+ = XGrabOwnerP Bool
+ | XGrabSyncPointerP Bool
+ | XGrabSyncKeyboardP Bool
+ | XGrabConfineTo XWindow
+ | XGrabCursor XCursor
+ --deriving (Printers)
+
+data XArcMode = XChord
+ | XPieSlice
+ --deriving (Printers)
+
+data XCapStyle = XButt
+ | XNotLast
+ | XProjecting
+ | XRound
+ --deriving (Printers)
+
+data XClipMask {-# STRICT #-}
+ = XClipMaskPixmap XPixmap
+ | XClipMaskRects [XRect]
+ | XClipMaskNone
+ --deriving (Printers)
+
+data XFillRule = XFillEvenOdd
+ | XFillWinding
+ --deriving (Printers)
+
+data XFillStyle = XFillOpaqueStippled
+ | XFillSolid
+ | XFillStippled
+ | XFillTiled
+ --deriving (Printers)
+
+data XFunction = XBoole1
+ | XBoole2
+ | XBooleAndC1
+ | XBooleAndC2
+ | XBooleAnd
+ | XBooleC1
+ | XBooleC2
+ | XBooleClr
+ | XBooleEqv
+ | XBooleIor
+ | XBooleNand
+ | XBooleNor
+ | XBooleOrc1
+ | XBooleOrc2
+ | XBooleSet
+ | XBooleXor
+ --deriving (Printers)
+
+data XJoinStyle = XJoinBevel
+ | XJoinMiter
+ | XJoinRound
+ --deriving (Printers)
+
+data XLineStyle = XLineSolid
+ | XLineDoubleDash
+ | XLineOnOffDash
+ --deriving (Printers)
+
+data XSubwindowMode = XClipByChildren
+ | XIncludeInferiors
+ --deriving (Printers)
+
+-- BASIC GEOMETRY
+
+data XPoint {-# STRICT #-} = XPoint Int Int -- x,y
+ --deriving (Printers)
+
+data XSize {-# STRICT #-} = XSize Int Int -- width, height
+ --deriving (Printers)
+
+data XRect {-# STRICT #-} = XRect Int Int Int Int -- x, y, width, height
+ --deriving (Printers)
+
+data XArc {-# STRICT #-} = XArc Int Int Int Int Float Float
+ --deriving (Printers) -- x, y, width, height, angle1, angle2
+
+data XBitmapFormat {-# STRICT #-} = XBitmapFormat Int Int Bool
+ --deriving (Printers) -- unit, pad, lsb-first-p
+
+data XByteOrder = XLsbFirst
+ | XMsbFirst
+ --deriving (Printers)
+
+data XPixmapFormat {-# STRICT #-} = XPixmapFormat Int Int Int
+ --deriving (Printers) -- depth, bits-per-pixel, scanline-pad
+
+data XVisualInfo {-# STRICT #-} = XVisualInfo
+ Int -- id
+ XVisualClass -- class
+ XPixel -- red-mask
+ XPixel -- green-mask
+ XPixel -- blue-mask
+ Int -- bits-per-rgb
+ Int -- colormap-entries
+ --deriving (Printers)
+
+data XVisualClass = XDirectColor
+ | XGrayScale
+ | XPseudoColor
+ | XStaticColor
+ | XStaticGray
+ | XTrueColor
+ --deriving (Printers)
+
+data XFillContent {-# STRICT #-}
+ = XFillPixel XPixel
+ | XFillPixmap XPixmap
+ | XFillNone
+ | XFillParentRelative
+ | XFillCopy
+ --deriving (Printers)
+
+data XBackingStore = XAlwaysBackStore
+ | XNeverBackStore
+ | XBackStoreWhenMapped
+ | XBackStoreNotUseful
+ --deriving (Printers)
+
+data XGravity = XForget
+ | XStatic
+ | XCenter
+ | XEast
+ | XNorth
+ | XNorthEast
+ | XNorthWest
+ | XSouth
+ | XSouthEast
+ | XSouthWest
+ | XWest
+ --deriving (Printers)
+
+data XWindowClass = XInputOutput
+ | XInputOnly
+ --deriving (Printers)
+
+data XMapState = XUnmapped
+ | XUnviewable
+ | XViewable
+ --deriving (Printers)
+
+data XImageData {-# STRICT #-}
+ = XBitmapData [XBitmap]
+ | XPixarrayData XPixarray
+ | XByteVecData XByteVec
+ --deriving (Printers)
+
+data XImageFormat = XXyPixmapImage
+ | XZPixmapImage
+ | XBitmapImage
+ --deriving (Printers)
+
+data XImageType = XImageX
+ | XImageXy
+ | XImageZ
+ --deriving (Printers)
+
+data XDrawDirection = XLeftToRight
+ | XRightToLeft
+ --deriving (Printers)
+
+data XColor {-# STRICT #-} = XColor Float Float Float
+ --deriving (Printers)
+
+data XInputFocus {-# STRICT #-}
+ = XFocusWindow XWindow
+ | XFocusNone
+ | XFocusPointerRoot
+ | XFocusParent
+ --deriving (Printers)
+
+data XGrabStatus = XAlreadyGrabbed
+ | XFrozen
+ | XInvalidTime
+ | XNotViewable
+ | XSuccess
+ --deriving (Printers)
+
+
+data XKeysym {-# STRICT #-} = XKeysym Integer
+ --deriving (Printers)
+
+
+data XCloseDownMode = XDestroy
+ | XRetainPermanent
+ | XRetainTemporary
+ --deriving (Printers)
+
+data XScreenSaver {-# STRICT #-} = XScreenSaver Int Int Bool Bool
+ --deriving (Printers)
+
+{-#
+ImportLispType (
+ XMaybe (XSome ("not-null?", "identity", "identity"),
+ XNull ("null?", "'()")),
+ XError (XError ("cons-xerror", "x-error-string")),
+ XBitmap (XBitmap ("mk-bitmap", "sel-bitmap")),
+ XKeysymTable (XKeysymTable ("mk-keysym-table", "sel-keysym-table")),
+ XBitVec (XBitVec ("mk-bitvec", "sel-bitvec")),
+ XPixarray (XPixarray ("mk-pixarray", "sel-pixarray")),
+ XByteVec (XByteVec ("mk-bytevec", "sel-bytevec")),
+ XAtom (XAtom ("mk-atom", "sel-atom")),
+ XProperty (XProperty ("mk-xproperty", "sel-xproperty-data",
+ "sel-xproperty-type", "sel-xproperty-format")),
+ XDrawable (XDrawWindow ("xlib:window-p", "identity", "identity"),
+ XDrawPixmap ("xlib:pixmap-p", "identity", "identity")),
+ XSwitch ( XOn(":on"), XOff(":off")),
+ XWindowPlace (XTopPlace (":top"), XBottomPlace (":bottom")),
+ XEventMode (XNormalMode (":normal"),
+ XGrabMode (":grab"),
+ XUngrabMode (":ungrab"),
+ XWhileGrabbedMode (":while-grabbed")),
+ XEventKind (XAncestorKind (":ancestor"),
+ XVirtualKind (":virtual"),
+ XInferiorKind (":inferior"),
+ XNonlinearKind (":nonlinear"),
+ XNonlinearVirtualKind (":nonlinear-virtual"),
+ XPointerKind (":pointer"),
+ XPointerRootKind (":pointer-root"),
+ XNoneKind (":none")),
+ XWindowVisibility (XUnobscured (":unobscured"),
+ XPartiallyObscured (":partially-obscured"),
+ XFullyObscured (":fully-obscured")),
+ XWindowStackMode (XStackAbove (":above"),
+ XStackBelow (":below"),
+ XStackTopIf (":top-if"),
+ XStackBottomIf (":bottom-if"),
+ XStackOpposite (":opposite")),
+ XPropertyState (XNewValueProperty (":new-value"),
+ XDeletedProperty (":deleted")),
+ XMapReqType (XModifierMapping (":modifier"),
+ XKeyboardMapping (":keyboard"),
+ XPointerMapping (":pointer")),
+ XGraphFun (XGraphFun ("cons", "car", "cdr")),
+ XEvent (XEvent ("mk-event", "sel-event-type", "sel-event-slots")),
+ XEventType (XKeyPressEvent (":key-press"),
+ XKeyReleaseEvent (":key-release"),
+ XButtonPressEvent (":button-press"),
+ XButtonReleaseEvent (":button-release"),
+ XMotionNotifyEvent (":motion-notify"),
+ XEnterNotifyEvent (":enter-notify"),
+ XLeaveNotifyEvent (":leave-notify"),
+ XFocusInEvent (":focus-in"),
+ XFocusOutEvent (":focus-out"),
+ XKeymapNotifyEvent (":keymap-notify"),
+ XMappingNotifyEvent (":mapping-notify"),
+ XExposureEvent (":exposure"),
+ XGraphicsExposureEvent (":graphics-exposure"),
+ XNoExposureEvent (":no-exposure"),
+ XCirculateNotifyEvent (":circulate-notify"),
+ XConfigureNotifyEvent (":configure-notify"),
+ XCreateNotifyEvent (":create-notify"),
+ XDestroyNotifyEvent (":destroy-notify"),
+ XGravityNotifyEvent (":gravity-notify"),
+ XMapNotifyEvent (":map-notify"),
+ XReparentNotifyEvent (":reparent-notify"),
+ XUnmapNotifyEvent (":unmap-notify"),
+ XVisibilityNotifyEvent (":visibility-notify"),
+ XCirculateRequestEvent (":circulate-notify"),
+ XColormapNotifyEvent (":colormap-notify"),
+ XConfigureRequestEvent (":configure-request"),
+ XMapRequestEvent (":map-request"),
+ XResizeRequestEvent (":resize-request"),
+ XClientMessageEvent (":client-message"),
+ XPropertyNotifyEvent (":property-notify"),
+ XSelectionClearEvent (":selection-clear"),
+ XSelectionNotifyEvent (":selection-notify"),
+ XSelectionRequestEvent (":selection-request"),
+ XOtherEvents (":others")),
+ XEventSlot (XEventWindow ("is-window", "mk-window", "keyword-val"),
+ XEventEventWindow
+ ("is-event-window", "mk-event-window", "keyword-val"),
+ XEventCode ("is-code", "mk-code", "keyword-val"),
+ XEventPos ("is-pos", "mk-pos", "keyword-val"),
+ XEventState ("is-state", "mk-state", "keyword-val"),
+ XEventTime ("is-time", "mk-time", "keyword-val"),
+ XEventRoot ("is-root", "mk-root", "keyword-val"),
+ XEventRootPos ("is-root-pos", "mk-root-pos", "keyword-val"),
+ XEventChild ("is-child", "mk-child", "keyword-val"),
+ XEventSameScreenP
+ ("is-same-screen-p", "mk-same-screen-p", "keyword-val"),
+ XEventHintP ("is-hint-p", "mk-hint-p", "keyword-val"),
+ XEventMode ("is-mode", "mk-mode", "keyword-val"),
+ XEventKind ("is-kind", "mk-kind", "keyword-val"),
+ XEventFocusP ("is-focus-p", "mk-focus-p", "keyword-val"),
+ XEventKeymap ("is-keymap", "mk-keymap", "keyword-val"),
+ XEventRequest ("is-request", "mk-request", "keyword-val"),
+ XEventStart ("is-start", "mk-start", "keyword-val"),
+ XEventCount ("is-count", "mk-count", "keyword-val"),
+ XEventRect ("is-rect", "mk-rect", "keyword-val"),
+ XEventDrawable ("is-drawable", "mk-drawable", "keyword-val"),
+ XEventXGraphFun ("is-graph-fun", "mk-graph-fun", "keyword-val"),
+ XEventPlace ("is-place", "mk-place", "keyword-val"),
+ XEventBorderWidth
+ ("is-border-width", "mk-border-width", "keyword-val"),
+ XEventAboveSibling
+ ("is-above-sibling", "mk-above-sibling", "keyword-val"),
+ XEventOverrideRedirectP
+ ("is-override-redirect-p", "mk-override-redirect-p", "keyword-val"),
+ XEventParent ("is-parent", "mk-parent", "keyword-val"),
+ XEventConfigureP ("is-configure-p", "mk-configure-p", "keyword-val"),
+ XEventVisibility ("is-visibility", "mk-visibility", "keyword-val"),
+ XEventNewP ("is-new-p", "mk-new-p", "keyword-val"),
+ XEventInstalledP ("is-installed-p", "mk-installed-p", "keyword-val"),
+ XEventStackMode ("is-stack-mode", "mk-stack-mode", "keyword-val"),
+ XEventValueMask ("is-value-mask", "mk-value-mask", "keyword-val"),
+ XEventSize ("is-size", "mk-size", "keyword-val"),
+ XEventMessage ("is-message", "mk-message", "keyword-val"),
+ XEventPropertyState
+ ("is-property-state", "mk-property-state", "keyword-val"),
+ XEventAtom ("is-atom", "mk-atom", "keyword-val"),
+ XEventSelection ("is-selection", "mk-selection", "keyword-val"),
+ XEventTarget ("is-target", "mk-target", "keyword-val"),
+ XEventProperty ("is-property", "mk-property", "keyword-val"),
+ XEventRequestor ("is-requestor", "mk-requestor", "keyword-val")),
+ XEventMask (XEventMask ("x-make-event-mask", "x-event-mask-key-list")),
+ XEventMaskKey (XButton1Motion (":button-1-motion"),
+ XButton2Motion (":button-2-motion"),
+ XButton3Motion (":button-3-motion"),
+ XButton4Motion (":button-4-motion"),
+ XButton5Motion (":button-5-motion"),
+ XButtonMotion (":button-motion"),
+ XButtonPress (":button-press"),
+ XButtonRelease (":button-release"),
+ XColormapChange (":colormap-change"),
+ XEnterWindow (":enter-window"),
+ XExposure (":exposure"),
+ XFocusChange (":focus-change"),
+ XKeyPress (":key-press"),
+ XKeyRelease (":key-release"),
+ XKeymapState (":keymap-state"),
+ XLeaveWindow (":leave-window"),
+ XOwnerGrabButton (":owner-grab-button"),
+ XPointerMotion (":pointer-motion"),
+ XPointerMotionHint (":pointer-motion-hint"),
+ XPropertyChange (":property-change"),
+ XResizeRedirect (":resize-redirect"),
+ XStructureNotify (":structure-notify"),
+ XSubstructureRedirect (":substructure-notify"),
+ XVisibilityChange (":visibility-change")),
+ XStateMask (XStateMask ("x-make-state-mask", "x-state-mask-key-list")),
+ XStateMaskKey (XShift (":shift"),
+ XLock (":lock"),
+ XControl (":control"),
+ XMod1 (":mod-1"),
+ XMod2 (":mod-2"),
+ XMod3 (":mod-3"),
+ XMod4 (":mod-4"),
+ XMod5 (":mod-5"),
+ XButton1 (":button-1"),
+ XButton2 (":button-2"),
+ XButton3 (":button-3"),
+ XButton4 (":button-4"),
+ XButton5 (":button-5")),
+ XWinAttribute
+ (XWinBackground ("is-background","mk-background","keyword-val"),
+ XWinEventMask ("is-event-mask","mk-event-mask","keyword-val"),
+ XWinDepth ("is-depth","mk-depth","keyword-val"),
+ XWinBorderWidth ("is-border-width","mk-border-width","keyword-val"),
+ XWinClass ("is-class","mk-class","keyword-val"),
+ XWinVisual ("is-visual","mk-visual","keyword-val"),
+ XWinBorder ("is-border","mk-border","keyword-val"),
+ XWinBackingStore ("is-backing-store","mk-backing-store","keyword-val"),
+ XWinBackingPlanes ("is-backing-planes","mk-backing-planes","keyword-val"),
+ XWinBackingPixel ("is-backing-pixel","mk-backing-pixel","keyword-val"),
+ XWinSaveUnder ("is-save-under","mk-save-under","keyword-val"),
+ XWinDoNotPropagateMask ("is-do-not-propagate-mask",
+ "mk-do-not-propagate-mask","keyword-val"),
+ XWinOverrideRedirect("is-override-redirect",
+ "mk-override-redirect","keyword-val"),
+ XWinColormap ("is-colormap","mk-colormap","keyword-val"),
+ XWinCursor ("is-cursor","mk-cursor","keyword-val")),
+ XGCAttribute(
+ XGCArcMode ("is-arc-mode","mk-arc-mode","keyword-val"),
+ XGCBackground ("is-background","mk-background","keyword-val"),
+ XGCCapStyle ("is-cap-style","mk-cap-style","keyword-val"),
+ XGCClipMask ("is-clip-mask","mk-clip-mask","keyword-val"),
+ XGCClipOrigin ("is-clip-origin","mk-clip-origin","keyword-val"),
+ XGCDashOffset ("is-dash-offset","mk-dash-offset","keyword-val"),
+ XGCDashes ("is-dashes","mk-dashes","keyword-val"),
+ XGCExposures ("is-exposures","mk-exposures","keyword-val"),
+ XGCFillRule ("is-fill-rule","mk-fill-rule","keyword-val"),
+ XGCFillStyle ("is-fill-style","mk-fill-style","keyword-val"),
+ XGCFont ("is-font","mk-font","keyword-val"),
+ XGCForeground ("is-foreground","mk-foreground","keyword-val"),
+ XGCFunction ("is-function","mk-function","keyword-val"),
+ XGCJoinStyle ("is-join-style","mk-join-style","keyword-val"),
+ XGCLineStyle ("is-line-style","mk-line-style","keyword-val"),
+ XGCLineWidth ("is-line-width","mk-line-width","keyword-val"),
+ XGCPlaneMask ("is-plane-mask","mk-plane-mask","keyword-val"),
+ XGCStipple ("is-stipple","mk-stipple","keyword-val"),
+ XGCSubwindowMode ("is-subwindow-mode","mk-subwindow-mode","keyword-val"),
+ XGCTile ("is-tile","mk-tile","keyword-val"),
+ XGCTileOrigin ("is-tile-origin","mk-tile-origin","keyword-val")),
+ XImAttribute (
+ XImBitLsbFirstP ("is-bit-lsb-first-p","mk-bit-lsb-first-p","keyword-val"),
+ XImBitsPerPixel ("is-bits-per-pixel","mk-bits-per-pixel","keyword-val"),
+ XImBlueMask ("is-blue-mask","mk-blue-mask","keyword-val"),
+ XImByteLsbFirstP ("is-byte-lsb-first-p","mk-byte-lsb-first-p","keyword-val"),
+ XImBytesPerLine ("is-bytes-per-line","mk-bytes-per-line","keyword-val"),
+ XImData ("is-data","mk-data","keyword-val"),
+ XImDepth ("is-depth","mk-depth","keyword-val"),
+ XImFormat ("is-format","mk-format","keyword-val"),
+ XImGreenMask ("is-green-mask","mk-green-mask","keyword-val"),
+ XImSize ("is-size","mk-size","keyword-val"),
+ XImName ("is-name","mk-name","keyword-val"),
+ XImRedMask ("is-red-mask","mk-red-mask","keyword-val"),
+ XImHotSpot ("is-hot-spot","mk-hot-spot","keyword-val")),
+ XGrabAttribute (
+ XGrabOwnerP ("is-owner-p", "mk-owner-p", "keyword-val"),
+ XGrabSyncPointerP ("is-sync-pointer-p", "mk-sync-pointer-p", "keyword-val"),
+ XGrabSyncKeyboardP ("is-sync-keyboard-p", "mk-sync-keyboard-p", "keyword-val"),
+ XGrabConfineTo ("is-confine-to", "mk-confine-to", "keyword-val"),
+ XGrabCursor ("is-cursor", "mk-cursor", "keyword-val")),
+ XArcMode (XChord (":chord"),
+ XPieSlice (":pie-slice")),
+ XCapStyle (XButt (":butt"),
+ XNotLast (":not-last"),
+ XProjecting (":projecting"),
+ XRound (":round")),
+ XClipMask (XClipMaskPixmap ("xlib:pixmap-p","identity","identity"),
+ XClipMaskRects ("not-pixmap-and-list-p","mk-clip-mask-rects",
+ "sel-clip-mask-rects"),
+ XClipMaskNone ("null?", "()")),
+ XFillRule (XFillEvenOdd (":even-odd"),
+ XFillWinding (":winding")),
+ XFillStyle (XFillOpaqueStippled (":opaque-stippled"),
+ XFillSolid (":solid"),
+ XFillStippled (":stippled"),
+ XFillTiled (":tiled")),
+ XFunction (XBoole1 ("xlib::boole-1"),
+ XBoole2 ("xlib::boole-2"),
+ XBooleAndC1 ("xlib::boole-andc1"),
+ XBooleAndC2 ("xlib::boole-andc2"),
+ XBooleAnd ("xlib::boole-and"),
+ XBooleC1 ("xlib::boole-c1"),
+ XBooleC2 ("xlib::boole-c2"),
+ XBooleClr ("xlib::boole-clr"),
+ XBooleEqv ("xlib::boole-eqv"),
+ XBooleIor ("xlib::boole-ior"),
+ XBooleNand ("xlib::boole-nand"),
+ XBooleNor ("xlib::boole-nor"),
+ XBooleOrc1 ("xlib::boole-orc1"),
+ XBooleOrc2 ("xlib::boole-orc2"),
+ XBooleSet ("xlib::boole-set"),
+ XBooleXor ("xlib::boole-xor")),
+ XJoinStyle (XJoinBevel (":bevel"),
+ XJoinMiter (":miter"),
+ XJoinRound (":round")),
+ XLineStyle (XLineSolid (":solid"),
+ XLineDoubleDash (":double-dash"),
+ XLineOnOffDash (":on-off-dash")),
+ XSubwindowMode (XClipByChildren (":clip-by-children"),
+ XIncludeInferiors (":include-inferiors")),
+ XPoint(XPoint("mk-xpoint", "xpoint-x", "xpoint-y")),
+ XSize (XSize ("mk-xsize", "xsize-w", "xsize-h")),
+ XRect (XRect ("mk-xrect", "xrect-x", "xrect-y", "xrect-w", "xrect-h")),
+ XArc (XArc ("mk-xarc", "xarc-x", "xarc-y", "xarc-w", "xarc-h",
+ "xarc-a1", "xarc-a2")),
+ XBitmapFormat
+ (XBitmapFormat ("bitmap-format-p", "mk-bitmap-format",
+ "xlib:bitmap-format-unit",
+ "xlib:bitmap-format-pad",
+ "xlib:bitmap-format-lsb-first-p")),
+ XByteOrder (XLsbFirst (":lsbfirst"),
+ XMsbFirst (":msbfirst")),
+ XPixmapFormat (XPixmapFormat ("pixmap-format-p", "mk-pixmap-format",
+ "xlib:pixmap-format-depth",
+ "xlib:pixmap-format-bits-per-pixel",
+ "xlib:pixmap-format-scanline-pad")),
+ XVisualInfo
+ (XVisualInfo ( "visual-info-p", "mk-xvisual-info",
+ "xlib:visual-info-id",
+ "xlib:visual-info-class",
+ "xlib:visual-info-red-mask",
+ "xlib:visual-info-green-mask",
+ "xlib:visual-info-blue-mask",
+ "xlib:visual-info-bits-per-rgb",
+ "xlib:visual-info-colormap-entries")),
+ XVisualClass (XDirectColor (":direct-color"),
+ XGrayScale (":gray-scale"),
+ XPseudoColor (":pseudo-color"),
+ XStaticColor (":static-color"),
+ XStaticGray (":static-gray"),
+ XTrueColor (":true-color")),
+ XFillContent (XFillPixel ("is-fill-pixel", "identity","identity"),
+ XFillPixmap ("xlib:pixmap-p", "identity","identity"),
+ XFillNone (":none"),
+ XFillParentRelative (":parent-relative"),
+ XFillCopy (":copy")),
+ XBackingStore (XAlwaysBackStore (":always"),
+ XNeverBackStore (":never"),
+ XBackStoreWhenMapped (":when-mapped"),
+ XBackStoreNotUseful (":not-useful")),
+ XGravity (XForget (":forget"),
+ XStatic (":static"),
+ XCenter (":center"),
+ XEast (":east"),
+ XNorth (":north"),
+ XNorthEast (":north-east"),
+ XNorthWest (":north-west"),
+ XSouth (":south"),
+ XSouthEast (":south-east"),
+ XSouthWest (":south-west"),
+ XWest ("west")),
+ XWindowClass (XInputOutput (":input-output"),
+ XInputOnly (":input-only")),
+ XMapState (XUnmapped (":unmapped"),
+ XUnviewable (":unviewable"),
+ XViewable (":viewable")),
+ XImageData (XBitmapData ("bitmap-list-p", "haskell-list->list/identity", "list->haskell-list/identity"),
+ XPixarrayData ("pixarray-p", "identity", "identity"),
+ XByteVecData ("bytevec-p", "identity", "identity")),
+ XImageFormat (XXyPixmapImage (":xy-pixmap"),
+ XZPixmapImage (":z-pixmap"),
+ XBitmapImage (":bitmap")),
+ XImageType (XImageX ("'xlib:image-x"),
+ XImageXy ("'xlib:image-xy"),
+ XImageZ ("'xlib:image-z")),
+ XDrawDirection (XLeftToRight (":left-to-right"),
+ XRightToLeft (":right-to-left")),
+ XColor (XColor ("xlib:color-p", "mk-color",
+ "xlib:color-red", "xlib:color-green", "xlib:color-blue")),
+ XInputFocus (XFocusWindow ("xlib:window-p", "identity", "identity"),
+ XFocusNone (":none"),
+ XFocusPointerRoot (":pointer-root"),
+ XFocusParent (":parent")),
+ XGrabStatus (XAlreadyGrabbed (":already-grabbed"),
+ XFrozen (":frozen"),
+ XInvalidTime (":invalid-time"),
+ XSuccess (":success")),
+ XCloseDownMode (XDestroy (":destroy"),
+ XRetainPermanent (":retain-permanent"),
+ XRetainTemporary (":retain-temporary")),
+ XScreenSaver (XScreenSaver ("list", "car", "cadr", "caddr", "cadddr")))
+
+#-}
+
diff --git a/progs/lib/X11/xlib.hu b/progs/lib/X11/xlib.hu
new file mode 100644
index 0000000..b86b2ac
--- /dev/null
+++ b/progs/lib/X11/xlib.hu
@@ -0,0 +1,5 @@
+:output $LIBRARYBIN/
+:stable
+:o= all
+xlib.hs
+xlibprims.hu
diff --git a/progs/lib/X11/xlibclx.scm b/progs/lib/X11/xlibclx.scm
new file mode 100644
index 0000000..1f1fd6a
--- /dev/null
+++ b/progs/lib/X11/xlibclx.scm
@@ -0,0 +1,1262 @@
+;;; xlibclx.scm -- Lisp support for Haskell/CLX interface
+
+;; general
+
+(define-syntax (nth-value n form)
+ (cond ((eqv? n 0)
+ `(values ,form))
+ ((number? n)
+ (let ((temps '()))
+ (dotimes (i n)
+ (declare (ignorable i))
+ (push (gensym) temps))
+ `(multiple-value-bind ,(reverse temps) ,form
+ (declare (ignore ,@(reverse (cdr temps))))
+ ,(car temps))))
+ (else
+ `(lisp:nth ,n (lisp:multiple-value-list ,form)))
+ ))
+
+
+(define-local-syntax (keywordify string)
+ `(lisp:intern ,string (lisp:find-package "KEYWORD")))
+
+(define-local-syntax (xlibify string)
+ `(lisp:intern ,string (lisp:find-package "XLIB")))
+
+
+
+;;; This is stuff to support slots that consist of a keyword/value
+;;; pair. Note that the value is always unboxed.
+
+(define-syntax (make-keyword key value)
+ `(cons ,key ,value))
+
+(define-syntax (is-keyword? x key)
+ `(eq? (car ,x) ,key))
+
+(define-syntax (keyword-key x) `(car ,x))
+(define-syntax (keyword-val x) `(cdr ,x))
+
+(define-syntax (define-keyword-constructor name)
+ (let* ((name-str (symbol->string name))
+ (key (keywordify name-str))
+ (is-name (string->symbol (string-append "IS-" name-str)))
+ (mk-name (string->symbol (string-append "MK-" name-str))))
+ `(begin
+ (define (,mk-name x) (make-keyword ,key x))
+ (define (,is-name x) (is-keyword? x ,key)))
+ ))
+
+(define-syntax (define-event-slot-finder slot)
+ (let* ((slot-str (symbol->string slot))
+ (slot-key (keywordify slot-str))
+ (fun (string->symbol (string-append "X-EVENT-" slot-str))))
+ `(define (,fun event) (lookup-event-slot (cdr event) ,slot-key))))
+
+(define (lookup-event-slot event key)
+ (if (null? event)
+ (error "non-existent event slot: ~A" key)
+ (if (eq? key (car event))
+ (cadr event)
+ (lookup-event-slot (cddr event) key))))
+
+
+(define-syntax (define-attribute-setter entity attribute)
+ (let* ((entity-attr (string-append (symbol->string entity)
+ "-"
+ (symbol->string attribute)))
+ (fun-name (string->symbol (string-append "X-SET-" entity-attr)))
+ (xfun-name (xlibify entity-attr)))
+ `(define (,fun-name ,entity ,attribute)
+ (setf (,xfun-name ,entity) ,attribute))))
+
+(define-syntax (make-h-tuple . args)
+ (let ((nargs (map (lambda (arg) `(box ,arg)) args)))
+ `(make-tuple ,@nargs)))
+
+;; type XError
+
+(define (cons-xerror x)
+ (declare (ignore x))
+ (error "can't construct XError"))
+
+(define (x-error-string c)
+ (make-haskell-string (format '#f "~A" c)))
+
+
+;;; The forces here are necessary because the thing being funcalled
+;;; returns a data structure of type (IO a), and we need to do
+;;; an IO a -> a transformation.
+
+#+lucid
+(define (x-handle-error handler body)
+ (lisp:catch 'x-error-handle
+ (lcl:handler-bind ((lisp:error (mk-handler handler)))
+ (force (funcall body (box 'state))))))
+
+#+(or cmu allegro lispworks)
+(define (x-handle-error handler body)
+ (lisp:catch 'x-error-handle
+ (lisp:handler-bind ((lisp:error (mk-handler handler)))
+ (force (funcall body (box 'state))))))
+
+#+akcl
+(define (x-handle-error handler body)
+ (error "AKCL does not support HANDLER-BIND!"))
+
+(define (mk-handler handler)
+ (lambda (c)
+ (lisp:throw 'x-error-handle
+ (force (funcall handler
+ (box c)
+ (box 'state))))))
+
+;; for type XMaybe
+
+(define (not-null? x) (not (null? x)))
+
+
+;; For Bitmap, Pixarray, KeysymTable
+
+(define (array2->haskell-list a)
+ (let* ((dims (lisp:array-dimensions a))
+ (i1max (car dims))
+ (i2max (cadr dims)))
+ (declare (type fixnum i1max i2max))
+ (do ((i1 (the fixnum (1- i1max)) (the fixnum (1- i1)))
+ (outer '()))
+ ((< i1 0) outer)
+ (declare (type fixnum i1))
+ (setf outer
+ (cons
+ (box
+ (do ((i2 (the fixnum (1- i2max)) (the fixnum (1- i2)))
+ (inner '()))
+ ((< i2 0) inner)
+ (declare (type fixnum i2))
+ (setf inner
+ (cons (box (lisp:aref a i1 i2))
+ (box inner)))))
+ (box outer))))
+ ))
+
+
+;; Bitmap
+
+(define (mk-bitmap ll)
+ (let ((l (haskell-list->list #'haskell-list->list/identity ll)))
+ (lisp:make-array `(,(length l) , (length (car l)))
+ :element-type 'lisp:bit
+ :initial-contents l)))
+
+(define (sel-bitmap l)
+ (array2->haskell-list l))
+
+
+;; XKeysymTable
+
+(define (mk-keysym-table ll)
+ (let ((l (haskell-list->list #'haskell-list->list/identity ll)))
+ (lisp:make-array `(,(length l) , (length (car l)))
+ :element-type 'xlib:card32
+ :initial-contents l)))
+
+(define (sel-keysym-table l)
+ (array2->haskell-list l))
+
+;; XPixarray
+
+(define (mk-pixarray ll)
+ (let ((l (haskell-list->list #'haskell-list->list/identity ll)))
+ (let* ((max-num (find-max l))
+ (pix-type (cond ((<= max-num 1) 'lisp:bit)
+ ((<= max-num 15) '(lisp:unsigned-byte 4))
+ ((<= max-num 255) 'xlib:card8)
+ ((<= max-num 65535) 'xlib:card16)
+ (else 'xlib:card32))))
+ (declare (type integer max-num))
+ (lisp:make-array `(,(length l) , (length (car l)))
+ :element-type pix-type
+ :initial-contents l))))
+
+(define (find-max l)
+ (let ((max 0))
+ (dolist (ll l)
+ (dolist (lll ll)
+ (when (> (the integer lll) (the integer max))
+ (setf max lll))))
+ max))
+
+(define (sel-pixarray l)
+ (array2->haskell-list l))
+
+
+
+
+;;; Can't use mumble vector primitives on arrays of specialized types!
+
+(define (array1->haskell-list a)
+ (declare (type lisp:vector a))
+ (let ((imax (lisp:length a)))
+ (declare (type fixnum imax))
+ (do ((i (the fixnum (1- imax)) (the fixnum (1- i)))
+ (result '()))
+ ((< i 0) result)
+ (declare (type fixnum i))
+ (setf result
+ (cons (box (lisp:aref a i))
+ (box result))))))
+
+;; BitVec
+
+(define (mk-bitvec ll)
+ (let ((l (haskell-list->list/identity ll)))
+ (lisp:make-array `(,(length l)) :element-type 'lisp:bit
+ :initial-contents l)))
+
+(define (sel-bitvec l)
+ (array1->haskell-list l))
+
+;; ByteVec
+
+(define (mk-bytevec ll)
+ (let ((l (haskell-list->list/identity ll)))
+ (lisp:make-array `(,(length l)) :element-type 'xlib:card8
+ :initial-contents l)))
+
+(define (sel-bytevec l)
+ (array1->haskell-list l))
+
+
+;; XAtom
+(define (mk-atom name)
+ (keywordify (haskell-string->string name)))
+
+(define (sel-atom atom)
+ (make-haskell-string (symbol->string atom)))
+
+;; XProperty
+;;; watch out for name conflict with :property keyword stuff
+(define (mk-xproperty d ty f) (list (haskell-list->list/identity d) ty f))
+(define (sel-xproperty-data p) (list->haskell-list/identity (car p)))
+(define (sel-xproperty-type p) (cadr p))
+(define (sel-xproperty-format p) (caddr p))
+
+(define (mk-event type slots)
+ (cons type (slots->keywords (haskell-list->list/identity slots))))
+
+(define (sel-event-type event) (car event))
+
+(define (sel-event-slots event)
+ (list->haskell-list/identity (keywords->slots (car event) (cdr event) event)))
+
+;; XEventSlot
+
+(define-keyword-constructor window)
+(define-keyword-constructor event-window)
+(define-keyword-constructor code)
+(define-keyword-constructor pos)
+(define-keyword-constructor state)
+(define-keyword-constructor time)
+(define-keyword-constructor root)
+(define-keyword-constructor root-pos)
+(define-keyword-constructor child)
+(define-keyword-constructor same-screen-p)
+(define-keyword-constructor hint-p)
+(define-keyword-constructor mode)
+(define-keyword-constructor kind)
+(define-keyword-constructor focus-p)
+(define-keyword-constructor keymap)
+(define-keyword-constructor request)
+(define-keyword-constructor start)
+(define-keyword-constructor count)
+(define-keyword-constructor rect)
+(define-keyword-constructor drawable)
+(define-keyword-constructor graph-fun)
+(define-keyword-constructor place)
+(define-keyword-constructor border-width)
+(define-keyword-constructor above-sibling)
+(define-keyword-constructor override-redirect-p)
+(define-keyword-constructor parent)
+(define-keyword-constructor configure-p)
+(define-keyword-constructor visibility)
+(define-keyword-constructor new-p)
+(define-keyword-constructor installed-p)
+(define-keyword-constructor stack-mode)
+(define-keyword-constructor value-mask)
+(define-keyword-constructor size)
+(define-keyword-constructor message)
+(define-keyword-constructor property-state)
+(define-keyword-constructor atom)
+(define-keyword-constructor selection)
+(define-keyword-constructor target)
+(define-keyword-constructor property)
+(define-keyword-constructor requestor)
+
+(define-event-slot-finder window)
+(define-event-slot-finder event-window)
+(define-event-slot-finder code)
+(define-event-slot-finder x)
+(define-event-slot-finder y)
+(define-event-slot-finder state)
+(define-event-slot-finder time)
+(define-event-slot-finder root)
+(define-event-slot-finder root-x)
+(define-event-slot-finder root-y)
+(define-event-slot-finder child)
+(define-event-slot-finder same-screen-p)
+(define-event-slot-finder hint-p)
+(define-event-slot-finder mode)
+(define-event-slot-finder kind)
+(define-event-slot-finder focus-p)
+(define-event-slot-finder keymap)
+(define-event-slot-finder request)
+(define-event-slot-finder start)
+(define-event-slot-finder count)
+(define-event-slot-finder width)
+(define-event-slot-finder height)
+(define-event-slot-finder drawable)
+(define-event-slot-finder major)
+(define-event-slot-finder minor)
+(define-event-slot-finder place)
+(define-event-slot-finder border-width)
+(define-event-slot-finder above-sibling)
+(define-event-slot-finder override-redirect-p)
+(define-event-slot-finder parent)
+(define-event-slot-finder configure-p)
+(define-event-slot-finder new-p)
+(define-event-slot-finder installed-p)
+(define-event-slot-finder stack-mode)
+(define-event-slot-finder value-mask)
+(define-event-slot-finder data)
+(define-event-slot-finder type)
+(define-event-slot-finder format)
+(define-event-slot-finder atom)
+(define-event-slot-finder selection)
+(define-event-slot-finder target)
+(define-event-slot-finder property)
+(define-event-slot-finder requestor)
+
+(define (x-event-pos event) (mk-xpoint (x-event-x event) (x-event-y event)))
+
+(define (x-event-root-pos event)
+ (mk-xpoint (x-event-root-x event) (x-event-root-y event)))
+
+(define (x-event-size event)
+ (mk-xsize (x-event-width event) (x-event-height event)))
+
+(define (x-event-rect event)
+ (mk-xrect (x-event-x event) (x-event-y event)
+ (x-event-width event) (x-event-height event)))
+
+(define (x-event-graph-fun event)
+ (cons (x-event-major event) (x-event-minor event)))
+
+(define (x-event-message event)
+ (list (sequence->list (x-event-data event))
+ (x-event-type event)
+ (x-event-format event)))
+
+
+;; XEventMask
+
+(define (x-make-event-mask keys)
+ (apply (function xlib:make-event-mask) (haskell-list->list/identity keys)))
+
+(define (x-event-mask-key-list mask)
+ (list->haskell-list/identity (xlib:make-event-keys mask)))
+
+;; XStateMask
+
+(define (x-make-state-mask keys)
+ (apply (function xlib:make-state-mask) (haskell-list->list/identity keys)))
+
+(define (x-state-mask-key-list mask)
+ (list->haskell-list/identity (xlib:make-state-keys mask)))
+
+
+(define-keyword-constructor background)
+(define-keyword-constructor foreground)
+(define-keyword-constructor event-mask)
+(define-keyword-constructor depth)
+(define-keyword-constructor border-width)
+(define-keyword-constructor class)
+(define-keyword-constructor visual)
+(define-keyword-constructor border)
+(define-keyword-constructor backing-store)
+(define-keyword-constructor backing-planes)
+(define-keyword-constructor backing-pixel)
+(define-keyword-constructor save-under)
+(define-keyword-constructor do-not-propagate-mask)
+(define-keyword-constructor override-redirect)
+(define-keyword-constructor colormap)
+(define-keyword-constructor cursor)
+
+(define-keyword-constructor arc-mode)
+(define-keyword-constructor cap-style)
+(define-keyword-constructor clip-mask)
+(define-keyword-constructor clip-origin)
+(define-keyword-constructor dash-offset)
+(define-keyword-constructor dashes)
+(define-keyword-constructor exposures)
+(define-keyword-constructor fill-rule)
+(define-keyword-constructor fill-style)
+(define-keyword-constructor font)
+(define-keyword-constructor function)
+(define-keyword-constructor join-style)
+(define-keyword-constructor line-style)
+(define-keyword-constructor line-width)
+(define-keyword-constructor plane-mask)
+(define-keyword-constructor stipple)
+(define-keyword-constructor subwindow-mode)
+(define-keyword-constructor tile)
+(define-keyword-constructor tile-origin)
+
+(define-keyword-constructor bit-lsb-first-p)
+(define-keyword-constructor bits-per-pixel)
+(define-keyword-constructor blue-mask)
+(define-keyword-constructor byte-lsb-first-p)
+(define-keyword-constructor bytes-per-line)
+(define-keyword-constructor data)
+(define-keyword-constructor format)
+(define-keyword-constructor green-mask)
+(define-keyword-constructor size)
+(define-keyword-constructor name)
+(define-keyword-constructor red-mask)
+(define-keyword-constructor hot-spot)
+
+
+(define-keyword-constructor owner-p)
+(define-keyword-constructor sync-pointer-p)
+(define-keyword-constructor sync-keyboard-p)
+(define-keyword-constructor confine-to)
+
+
+;; XClipMask
+
+(define (not-pixmap-and-list-p x)
+ (and (pair? x) (not (xlib:pixmap-p x))))
+(define (mk-clip-mask-rects rects)
+ (rects->point-seq (haskell-list->list/identity rects)))
+(define (sel-clip-mask-rects point-seq)
+ (list->haskell-list/identity (point-seq->rects point-seq)))
+
+;; XPoint
+
+(define (mk-xpoint x y) (cons x y))
+(define (xpoint-x x) (car x))
+(define (xpoint-y x) (cdr x))
+
+;; XSize
+
+(define (mk-xsize x y) (cons x y))
+(define (xsize-w x) (car x))
+(define (xsize-h x) (cdr x))
+
+;; XRect
+(define (mk-xrect x y w h) (vector x y w h))
+(define (xrect-x x) (vector-ref x 0))
+(define (xrect-y x) (vector-ref x 1))
+(define (xrect-w x) (vector-ref x 2))
+(define (xrect-h x) (vector-ref x 3))
+
+;; XArc
+
+(define (mk-xarc x y w h a1 a2) (vector x y w h a1 a2))
+
+(define (xarc-x x) (vector-ref x 0))
+(define (xarc-y x) (vector-ref x 1))
+(define (xarc-w x) (vector-ref x 2))
+(define (xarc-h x) (vector-ref x 3))
+(define (xarc-a1 x) (vector-ref x 4))
+(define (xarc-a2 x) (vector-ref x 5))
+
+;; BitmapFormat
+
+(define (mk-bitmap-format u p l)
+ (xlib::make-bitmap-format :unit u :pad p :lsb-first-p l))
+
+;; PixmapFormat
+
+(define (mk-pixmap-format u p l)
+ (xlib::make-pixmap-format :depth u :bits-per-pixel p :scanline-pad l))
+
+;; XVisualInfo
+
+(define (mk-xvisual-info id cl rm gm bm bs es)
+ (xlib::make-visual-info :id id :class cl :red-mask rm :green-mask gm
+ :blue-mask bm :bits-per-rgb bs :colormap-entries es))
+
+;; XFillContent
+
+(define (is-fill-pixel x) (not (or (xlib:pixmap-p x) (symbol? x))))
+
+;; XBackingStore
+
+;; XImageData
+
+(define (bitmap-list-p x) (pair? x))
+(define (pixarray-p x) (and (not (pair? x)) (eq? (lisp:array-rank x) 2)))
+(define (bytevec-p x) (and (not (pair? x)) (eq? (lisp:array-rank x) 1)))
+
+;; XColor
+(define (mk-color r g b)
+ (xlib:make-color :red r :green g :blue b))
+
+
+(define (x-print x)
+ (print x))
+
+(define (x-set-event-mask-key mask key-sym)
+ (lisp:logior mask (xlib:make-event-mask key-sym)))
+
+(define (x-clear-event-mask-key mask key-sym)
+ (lisp:logand mask (lisp:lognot (xlib:make-event-mask key-sym))))
+
+
+(define (x-test-event-mask-key mask key-sym)
+ (if (eqv? 0 (lisp:logand mask (xlib:make-event-mask key-sym))) '#f '#t))
+
+(define (x-set-state-mask-key mask key-sym)
+ (lisp:logior mask (xlib:make-state-mask key-sym)))
+
+(define (x-clear-state-mask-key mask key-sym)
+ (lisp:logand mask (lisp:lognot (xlib:make-state-mask key-sym))))
+
+(define (x-test-state-mask-key mask key-sym)
+ (if (eqv? 0 (lisp:logand mask (xlib:make-state-mask key-sym))) '#f '#t))
+
+
+;;; Display is a string of the format name:d.s
+;;; ignore s; if d is omitted, default it to zero.
+
+(define (x-open-display display)
+ (let* ((end (string-length display))
+ (colon (or (string-position #\: display 0 end) end))
+ (dot (or (string-position #\. display colon end) end)))
+ (declare (type fixnum end colon dot))
+ (xlib:open-display
+ (substring display 0 colon)
+ :display (if (eqv? colon dot)
+ 0
+ (string->number (substring display (1+ colon) dot))))))
+
+(define (x-set-display-error-handler display error-fun)
+ (declare (ignore display error-fun))
+ (error "not implemented"))
+
+(define (x-set-display-after-function display after-fun)
+ (declare (ignore display after-fun))
+ (error "not implemented"))
+
+(define (x-screen-depths screen)
+ (let ((depths (xlib:screen-depths screen)))
+ (map (lambda (l) (make-h-tuple (car l) (list->haskell-list/identity (cdr l))))
+ depths)))
+
+(define (x-screen-size screen)
+ (mk-xsize (xlib:screen-width screen) (xlib:screen-height screen)))
+
+(define (x-screen-mmsize screen)
+ (mk-xsize (xlib:screen-width-in-millimeters screen)
+ (xlib:screen-height-in-millimeters screen)))
+
+(define (x-create-window parent rect attrs)
+ (apply (function XLIB:CREATE-WINDOW)
+ `(:parent ,parent :x ,(xrect-x rect) :y ,(xrect-y rect)
+ :width ,(xrect-w rect) :height ,(xrect-h rect)
+ ,@(attrs->keywords attrs))))
+
+(define-attribute-setter drawable border-width)
+
+(define (x-drawable-size drawable)
+ (mk-xsize (xlib:drawable-width drawable) (xlib:drawable-height drawable)))
+
+(define (x-drawable-resize drawable size)
+ (setf (xlib:drawable-width drawable) (xsize-w size))
+ (setf (xlib:drawable-height drawable) (xsize-h size)))
+
+(define (x-window-pos window)
+ (mk-xpoint (xlib:drawable-x window) (xlib:drawable-y window)))
+
+(define (x-window-move window point)
+ (setf (xlib:drawable-x window) (xpoint-x point))
+ (setf (xlib:drawable-y window) (xpoint-y point)))
+
+(define-attribute-setter window background)
+(define-attribute-setter window backing-pixel)
+(define-attribute-setter window backing-planes)
+(define-attribute-setter window backing-store)
+(define-attribute-setter window bit-gravity)
+(define-attribute-setter window border)
+(define-attribute-setter window colormap)
+
+(define (x-set-window-cursor window cursor)
+ (let ((val (if (null? cursor) :none cursor)))
+ (setf (xlib:window-cursor window) val)))
+
+(define-attribute-setter window do-not-propagate-mask)
+(define-attribute-setter window event-mask)
+(define-attribute-setter window gravity)
+(define-attribute-setter window override-redirect)
+(define-attribute-setter window priority)
+(define-attribute-setter window save-under)
+
+(define (x-query-tree window)
+ (multiple-value-bind (children parent root)
+ (xlib:query-tree window)
+ (make-h-tuple (list->haskell-list/identity children) parent root)))
+
+(define (x-reparent-window window parent point)
+ (xlib:reparent-window window parent (xpoint-x point) (xpoint-y point)))
+
+(define (x-translate-coordinates source point dest)
+ (xlib:translate-coordinates source (xpoint-x point) (xpoint-y point) dest))
+
+(define (x-create-pixmap size depth drawable)
+ (xlib:create-pixmap :width (xsize-w size)
+ :height (xsize-h size)
+ :depth depth
+ :drawable drawable))
+
+(define (x-create-gcontext drawable attrs)
+ (apply (function XLIB:CREATE-GCONTEXT)
+ `(:drawable ,drawable ,@(attrs->keywords attrs))))
+
+(define (x-update-gcontext gcontext attrs)
+ (do ((keys (attrs->keywords attrs) (cddr keys)))
+ ((null? keys))
+ (x-update-gcontext-attr gcontext (car keys) (cadr keys))))
+
+(define (x-update-gcontext-attr gcontext key attr)
+ (case key
+ (:arc-mode (setf (xlib:gcontext-arc-mode gcontext) attr))
+ (:background (setf (xlib:gcontext-background gcontext) attr))
+ (:cap-style (setf (xlib:gcontext-cap-style gcontext) attr))
+ (:fill-style (setf (xlib:gcontext-fill-style gcontext) attr))
+ (:clip-mask (setf (xlib:gcontext-clip-mask gcontext) attr))
+ (:clip-x (setf (xlib:gcontext-clip-x gcontext) attr))
+ (:clip-y (setf (xlib:gcontext-clip-y gcontext) attr))
+ (:dash-offset (setf (xlib:gcontext-dash-offset gcontext) attr))
+ (:dashes (setf (xlib:gcontext-dashes gcontext) attr))
+ (:exposures (setf (xlib:gcontext-exposures gcontext) attr))
+ (:fill-rule (setf (xlib:gcontext-fill-rule gcontext) attr))
+ (:font (setf (xlib:gcontext-font gcontext) attr))
+ (:foreground (setf (xlib:gcontext-foreground gcontext) attr))
+; (:function (setf (xlib:gcontext-function gcontext) attr))
+ (:join-style (setf (xlib:gcontext-join-style gcontext) attr))
+ (:line-style (setf (xlib:gcontext-line-style gcontext) attr))
+; (:line-width (setf (xlib:gcontext-line-width gcontext) attr))
+; (:plane-mask (setf (xlib:gcontext-plane-mask gcontext) attr))
+; (:stipple (setf (xlib:gcontext-stipple gcontext) attr))
+ (:subwindow-mode (setf (xlib:gcontext-subwindow-mode gcontext) attr))
+; (:tile (setf (xlib:gcontext-tile gcontext) attr))
+; (:ts-x (setf (xlib:gcontext-ts-x gcontext) attr))
+; (:ts-y (setf (xlib:gcontext-ts-y gcontext) attr))
+ (else (format '#t "Graphics context attribute ~A is not settable.~%"
+ key))))
+
+(define (x-query-best-stipple dsize drawable)
+ (multiple-value-bind (w h)
+ (xlib:query-best-stipple (xsize-w dsize) (xsize-h dsize) drawable)
+ (mk-xsize w h)))
+
+(define (x-query-best-tile dsize drawable)
+ (multiple-value-bind (w h)
+ (xlib:query-best-tile (xsize-w dsize) (xsize-h dsize) drawable)
+ (mk-xsize w h)))
+
+(define (x-clear-area window rect exposures-p)
+ (xlib:clear-area window
+ :x (xrect-x rect)
+ :y (xrect-y rect)
+ :width (xrect-w rect)
+ :height (xrect-h rect)
+ :exposures-p exposures-p))
+
+(define (x-copy-area src gcontext rect dest point)
+ (xlib:copy-area src
+ gcontext
+ (xrect-x rect) (xrect-y rect)
+ (xrect-w rect) (xrect-h rect)
+ dest
+ (xpoint-x point) (xpoint-y point)))
+
+(define (x-copy-plane src gcontext plane rect dest point)
+ (xlib:copy-plane src
+ gcontext
+ plane
+ (xrect-x rect) (xrect-y rect)
+ (xrect-w rect) (xrect-h rect)
+ dest
+ (xpoint-x point) (xpoint-y point)))
+
+(define (x-draw-point drawable gcontext point)
+ (xlib:draw-point drawable gcontext (xpoint-x point) (xpoint-y point)))
+
+(define (x-draw-points drawable gcontext points)
+ (xlib:draw-points drawable gcontext (points->point-seq points)))
+
+(define (points->point-seq points)
+ (if (null? points)
+ '()
+ (let ((point (car points)))
+ (lisp:list* (xpoint-x point)
+ (xpoint-y point)
+ (points->point-seq (cdr points))))))
+
+(define (segments->point-seq segments)
+ (if (null? segments)
+ '()
+ (let* ((first-pair (car segments))
+ (point-1 (force (tuple-select 2 0 first-pair)))
+ (point-2 (force (tuple-select 2 1 first-pair))))
+ (lisp:list* (xpoint-x point-1)
+ (xpoint-y point-1)
+ (xpoint-x point-2)
+ (xpoint-y point-2)
+ (segments->point-seq (cdr segments))))))
+
+(define (rects->point-seq rects)
+ (if (null? rects)
+ '()
+ (let ((rect (car rects)))
+ (lisp:list* (xrect-x rect)
+ (xrect-y rect)
+ (xrect-w rect)
+ (xrect-h rect)
+ (rects->point-seq (cdr rects))))))
+
+(define (point-seq->rects point-seq)
+ (if (null? point-seq)
+ '()
+ (cons (mk-xrect (car point-seq) (cadr point-seq)
+ (caddr point-seq) (cadddr point-seq))
+ (point-seq->rects (cddddr point-seq)))))
+
+(define (arcs->point-seq arcs)
+ (if (null? arcs)
+ '()
+ (let ((arc (car arcs)))
+ (lisp:list* (xarc-x arc)
+ (xarc-y arc)
+ (xarc-w arc)
+ (xarc-h arc)
+ (xarc-a1 arc)
+ (xarc-a2 arc)
+ (arcs->point-seq (cdr arcs))))))
+
+(define (x-draw-line drawable gcontext point-1 point-2)
+ (xlib:draw-line drawable gcontext (xpoint-x point-1) (xpoint-y point-1)
+ (xpoint-x point-2) (xpoint-y point-2)))
+
+(define (x-draw-lines drawable gcontext points fill-p)
+ (xlib:draw-lines drawable gcontext
+ (points->point-seq points) :fill-p fill-p))
+
+(define (x-draw-segments drawable gcontext segments)
+ (xlib:draw-segments drawable gcontext (segments->point-seq segments)))
+
+(define (x-draw-rectangle drawable gcontext rect fill-p)
+ (xlib:draw-rectangle drawable gcontext
+ (xrect-x rect) (xrect-y rect)
+ (xrect-w rect) (xrect-h rect)
+ fill-p))
+
+(define (x-draw-rectangles drawable gcontext rects fill-p)
+ (xlib:draw-rectangles drawable gcontext
+ (rects->point-seq rects)
+ fill-p))
+
+(define (x-draw-arc drawable gcontext arc fill-p)
+ (xlib:draw-arc drawable gcontext
+ (xarc-x arc) (xarc-y arc)
+ (xarc-w arc) (xarc-h arc)
+ (xarc-a1 arc) (xarc-a2 arc)
+ fill-p))
+
+(define (x-draw-arcs drawable gcontext arcs fill-p)
+ (xlib:draw-arcs drawable gcontext
+ (arcs->point-seq arcs)
+ fill-p))
+
+(define (x-draw-glyph drawable gcontext point element)
+ (nth-value 1
+ (xlib:draw-glyph drawable gcontext (xpoint-x point)
+ (xpoint-y point) element)))
+
+(define (x-draw-glyphs drawable gcontext point element)
+ (nth-value 1 (xlib:draw-glyphs drawable gcontext (xpoint-x point)
+ (xpoint-y point) element)))
+
+(define (x-draw-image-glyph drawable gcontext point element)
+ (nth-value 1 (xlib:draw-image-glyph drawable gcontext (xpoint-x point)
+ (xpoint-y point) element)))
+
+(define (x-draw-image-glyphs drawable gcontext point element)
+ (nth-value 1 (xlib:draw-image-glyphs drawable gcontext (xpoint-x point)
+ (xpoint-y point) element)))
+
+(define (x-image-size image)
+ (mk-xsize (xlib:image-width image) (xlib:image-height image)))
+
+(define (x-image-name image)
+ (let ((lisp-name (xlib:image-name image)))
+ (cond ((null? lisp-name) "")
+ ((symbol? lisp-name) (symbol->string lisp-name))
+ (else lisp-name))))
+
+(define-attribute-setter image name)
+
+(define (x-image-hot-spot image)
+ (mk-xpoint (xlib:image-x-hot image) (xlib:image-y-hot image)))
+
+(define (x-set-image-hot-spot image point)
+ (setf (xlib:image-x-hot image) (xpoint-x point))
+ (setf (xlib:image-y-hot image) (xpoint-y point)))
+
+(define-attribute-setter image xy-bitmap-list)
+(define-attribute-setter image z-bits-per-pixel)
+(define-attribute-setter image z-pixarray)
+
+(define (x-create-image attrs)
+ (apply (function xlib:create-image) (attrs->keywords attrs)))
+
+(define (x-copy-image image rect type)
+ (xlib:copy-image image :x (xrect-x rect) :y (xrect-y rect)
+ :width (xrect-w rect) :height (xrect-h rect)
+ :result-type type))
+
+(define (x-get-image drawable rect pmask format type)
+ (xlib:get-image drawable :x (xrect-x rect) :y (xrect-y rect)
+ :width (xrect-w rect) :height (xrect-h rect)
+ :plane-mask pmask :format format :result-type type))
+
+(define (x-put-image drawable gcontext image point rect)
+ (xlib:put-image drawable gcontext image
+ :src-x (xpoint-x point) :src-y (xpoint-y point)
+ :x (xrect-x rect) :y (xrect-y rect)
+ :width (xrect-w rect) :height (xrect-h rect)))
+
+(define (x-get-raw-image drawable rect pmask format)
+ (xlib:get-raw-image drawable
+ :x (xrect-x rect) :y (xrect-y rect)
+ :width (xrect-w rect) :height (xrect-h rect)
+ :plane-mask pmask :format format))
+
+(define (x-put-raw-image drawable gcontext data depth rect left-pad format)
+ (xlib:put-raw-image drawable gcontext data
+ :depth depth
+ :x (xrect-x rect) :y (xrect-y rect)
+ :width (xrect-w rect) :height (xrect-h rect)
+ :left-pad left-pad :format format))
+
+(define (x-font-name font)
+ (let ((lisp-name (xlib:font-name font)))
+ (cond ((null? lisp-name) "")
+ ((symbol? lisp-name) (symbol->string lisp-name))
+ (else lisp-name))))
+
+(define (x-alloc-color colormap color)
+ (multiple-value-bind (pixel screen-color exact-color)
+ (xlib:alloc-color colormap color)
+ (make-h-tuple pixel screen-color exact-color)))
+
+(define (x-alloc-color-cells colormap colors planes contiguous-p)
+ (multiple-value-bind (pixels mask)
+ (xlib:alloc-color-cells colormap colors :planes planes
+ :contiguous-p contiguous-p)
+ (make-h-tuple (list->haskell-list/identity pixels) (list->haskell-list/identity mask))))
+
+(define (x-alloc-color-planes colormap colors reds greens blues contiguous-p)
+ (multiple-value-bind (pixels red-mask green-mask blue-mask)
+ (xlib:alloc-color-planes colormap colors :reds reds :greens greens
+ :blues blues :contiguous-p contiguous-p)
+ (make-h-tuple (list->haskell-list/identity pixels)
+ red-mask
+ green-mask
+ blue-mask)))
+
+(define (x-lookup-color colormap name)
+ (multiple-value-bind (screen-color exact-color)
+ (xlib:lookup-color colormap name)
+ (make-h-tuple screen-color exact-color)))
+
+(define (unzip l)
+ (if (null? l)
+ '()
+ (let ((h (car l)))
+ (lisp:list* (force (tuple-select 2 0 h))
+ (force (tuple-select 2 1 h))
+ (unzip (cdr l))))))
+
+(define (x-store-colors colormap pixel-colors)
+ (xlib:store-colors colormap (unzip pixel-colors)))
+
+(define (x-create-cursor source mask point foreground background)
+ (apply (function xlib:create-cursor)
+ `(:source ,source
+ ,@(if mask `(:mask ,mask) '())
+ :x ,(xpoint-x point) :y ,(xpoint-y point)
+ :foreground ,foreground :background ,background)))
+
+(define (x-create-glyph-cursor src mask foreground background)
+ (apply (function xlib:create-glyph-cursor)
+ `(:source-font ,(force (tuple-select 2 0 src))
+ :source-char ,(integer->char (force (tuple-select 2 1 src)))
+ ,@(if mask
+ `(:mask-font ,(force (tuple-select 2 0 mask))
+ :mask-char ,(integer->char (force (tuple-select 2 1 mask))))
+ '())
+ :foreground ,foreground :background ,background)))
+
+(define (x-query-best-cursor size display)
+ (multiple-value-bind (w h)
+ (xlib:query-best-cursor (xsize-w size) (xsize-h size) display)
+ (mk-xsize w h)))
+
+(define (x-change-property window property content)
+ (xlib:change-property window property
+ (car content) (cadr content)
+ (caddr content)))
+
+(define (x-get-property window property)
+ (lisp:multiple-value-bind (data type format)
+ (xlib:get-property window property)
+ (list (sequence->list data) type format)))
+
+(define (x-convert-selection selection type requestor property time)
+ (apply (function xlib:convert-selection)
+ `(,selection ,type ,requestor ,property ,@(if time `(,time) '()))))
+
+(define (x-set-selection-owner display selection time owner)
+ (if time
+ (setf (xlib:selection-owner display selection time) owner)
+ (setf (xlib:selection-owner display selection) owner)))
+
+(define (sequence->list seq)
+ (if (list? seq) seq
+ (do ((i (1- (lisp:length seq)) (1- i))
+ (res '() (cons (lisp:elt seq i) res)))
+ ((< i 0) res))))
+
+(define *this-event* '())
+
+(define (translate-event lisp:&rest event-slots lisp:&key event-key
+ lisp:&allow-other-keys)
+ (setf *this-event* (cons event-key event-slots))
+ '#t)
+
+
+(define (x-get-event display)
+ (xlib:process-event display :handler #'translate-event :force-output-p '#t)
+ *this-event*)
+
+(define (x-queue-event display event append-p)
+ (apply (function xlib:queue-event)
+ `(,display ,(car event) ,@(cdr event) :append-p ,append-p)))
+
+(define (x-event-listen display)
+ (let ((res (xlib:event-listen display)))
+ (if (null? res) 0 res)))
+
+(define (x-send-event window event mask)
+ (apply (function xlib:send-event)
+ `(,window ,(car event) ,mask ,@(cdr event))))
+
+(define (x-global-pointer-position display)
+ (multiple-value-bind (x y) (xlib:global-pointer-position display)
+ (mk-xpoint x y)))
+
+(define (x-pointer-position window)
+ (multiple-value-bind (x y same) (xlib:pointer-position window)
+ (if same (mk-xpoint x y) '())))
+
+(define (x-motion-events window start stop)
+ (do ((npos '() (cons (mk-xpoint (car pos) (cadr pos)) npos))
+ (pos (xlib:motion-events window :start start :stop stop)
+ (cdddr pos)))
+ ((null? pos) (nreverse npos))))
+
+(define (x-warp-pointer dest-win point)
+ (xlib:warp-pointer dest-win (xpoint-x point) (xpoint-y point)))
+
+(define (x-set-input-focus display focus revert-to time)
+ (apply (function xlib:set-input-focus)
+ `(,display ,focus ,revert-to ,@(if time `(,time) '()))))
+
+(define (x-input-focus display)
+ (multiple-value-bind (focus revert-to) (xlib:input-focus display)
+ (make-h-tuple focus revert-to)))
+
+(define (x-grab-pointer window event-mask attrs time)
+ (apply (function xlib:grab-pointer)
+ `(,window ,event-mask
+ ,@(attrs->keywords attrs)
+ ,@(if time `(:time ,time) '()))))
+
+(define (x-ungrab-pointer display time)
+ (if time
+ (xlib:ungrab-pointer display :time time)
+ (xlib:ungrab-pointer display)))
+
+(define (x-change-active-pointer-grab display event-mask attrs time)
+ (apply (function xlib:change-active-pointer-grab)
+ `(,display ,event-mask
+ ,@(attrs->keywords attrs)
+ ,@(if time `(,time) '()))))
+
+(define (x-grab-button window button event-mask state-mask attrs)
+ (apply (function xlib:grab-button)
+ `(,window ,button ,event-mask :modifiers ,state-mask
+ ,@(attrs->keywords attrs))))
+
+(define (x-ungrab-button window button modifiers)
+ (xlib:ungrab-button window button :modifiers modifiers))
+
+(define (x-grab-keyboard window attrs time)
+ (apply (function xlib:grab-keyboard)
+ `(,window ,@(attrs->keywords attrs)
+ ,@(if time `(:time ,time) '()))))
+
+(define (x-ungrab-keyboard display time)
+ (if time
+ (xlib:ungrab-keyboard display :time time)
+ (xlib:ungrab-keyboard display)))
+
+(define (x-grab-key window key state-mask attrs)
+ (apply (function xlib:grab-key)
+ `(,window ,key :modifiers ,state-mask ,@(attrs->keywords attrs))))
+
+(define (x-ungrab-key window key modifiers)
+ (xlib:ungrab-button window key :modifiers modifiers))
+
+(define (x-set-pointer-acceleration display val)
+ (xlib:change-pointer-control display :acceleration val))
+
+(define (x-set-pointer-threshold display val)
+ (xlib:change-pointer-control display :threshold val))
+
+(define (x-pointer-acceleration display)
+ (lisp:coerce (nth-value 0 (xlib:pointer-control display))
+ 'lisp:single-float))
+
+(define (x-pointer-threshold display)
+ (lisp:coerce (nth-value 1 (xlib:pointer-control display))
+ 'lisp:single-float))
+
+(define-attribute-setter pointer mapping)
+
+(define (x-set-keyboard-key-click-percent display v)
+ (xlib:change-keyboard-control display :key-click-percent v))
+
+(define (x-set-keyboard-bell-percent display v)
+ (xlib:change-keyboard-control display :bell-percent v))
+
+(define (x-set-keyboard-bell-pitch display v)
+ (xlib:change-keyboard-control display :bell-pitch v))
+
+(define (x-set-keyboard-bell-duration display v)
+ (xlib:change-keyboard-control display :bell-duration v))
+
+
+;;; Yes, leds are really counted from 1 rather than 0.
+
+(define (x-set-keyboard-led display v)
+ (declare (type integer v))
+ (do ((led 1 (1+ led))
+ (vv v (lisp:ash vv -1)))
+ ((> led 32))
+ (declare (type fixnum led) (type integer vv))
+ (xlib:change-keyboard-control display
+ :led led
+ :led-mode (if (lisp:logand vv 1) :on :off))))
+
+(define (x-set-keyboard-auto-repeat-mode display v)
+ (do ((key 0 (1+ key)))
+ ((>= key (lisp:length v)))
+ (declare (type fixnum key))
+ (xlib:change-keyboard-control display
+ :key key
+ :auto-repeat-mode (if (eqv? (the fixnum (lisp:aref v key)) 1) :on :off)
+ )))
+
+(define (x-keyboard-key-click-percent display)
+ (nth-value 0 (xlib:keyboard-control display)))
+
+(define (x-keyboard-bell-percent display)
+ (nth-value 1 (xlib:keyboard-control display)))
+
+(define (x-keyboard-bell-pitch display)
+ (nth-value 2 (xlib:keyboard-control display)))
+
+(define (x-keyboard-bell-duration display)
+ (nth-value 3 (xlib:keyboard-control display)))
+
+(define (x-keyboard-led display)
+ (nth-value 4 (xlib:keyboard-control display)))
+
+(define (x-keyboard-auto-repeat-mode display)
+ (nth-value 6 (xlib:keyboard-control display)))
+
+(define (x-modifier-mapping display)
+ (lisp:multiple-value-list (xlib:modifier-mapping display)))
+
+(define (x-set-modifier-mapping display l)
+ (let ((l1 (cddddr l)))
+ (xlib:set-modifier-mapping display
+ :shift (car l)
+ :lock (cadr l)
+ :control (caddr l)
+ :mod1 (cadddr l)
+ :mod2 (car l1)
+ :mod3 (cadr l1)
+ :mod4 (caddr l1)
+ :mod5 (cadddr l1))))
+
+(define (x-keysym-character display keysym state)
+ (let ((res (xlib:keysym->character display keysym state)))
+ (if (char? res) (char->integer res) '())))
+
+(define (x-keycode-character display keycode state)
+ (let ((res (xlib:keycode->character display keycode state)))
+ (if (char? res) (char->integer res) '())))
+
+(define-attribute-setter close-down mode)
+
+(define-attribute-setter access control)
+
+(define (x-screen-saver display)
+ (lisp:multiple-value-list (xlib:screen-saver display)))
+
+(define (x-set-screen-saver display ss)
+ (xlib:set-screen-saver display (car ss) (cadr ss) (caddr ss) (cadddr ss)))
+
+(define (slots->keywords slots)
+ (if (null slots) '()
+ `(,@(slot->keyword (car slots)) ,@(slots->keywords (cdr slots)))))
+
+(define (slot->keyword slot)
+ (let* ((tag (keyword-key slot))
+ (val (keyword-val slot)))
+ (case tag
+ (:pos `(:x ,(xpoint-x val) :y ,(xpoint-y val)))
+ (:root-pos `(:root-x ,(xpoint-x val) :root-y ,(xpoint-y val)))
+ (:size `(:width ,(xsize-w val) :height ,(xsize-h val)))
+ (:rect `(:x ,(xrect-x val) :y ,(xrect-y val)
+ :width ,(xrect-w val) :height ,(xrect-h val)))
+ (:graph-fun `(:major ,(car val) :minor ,(cdr val)))
+ (:visibility `(:state ,val))
+ (:property-state `(:state ,val))
+ (:message `(:data ,(car val) :type ,(cadr val) :format ,(caddr val)))
+ (else `(,tag ,val)))))
+
+(define (keywords->slots type keywords event)
+ (let* ((slots (keywords->slots1 type keywords))
+ (has-root-xy (memq type '(:key-press :key-release :button-press
+ :button-release :motion-notify
+ :enter-notify :leave-notify)))
+ (has-xy (or has-root-xy
+ (memq type '(:gravity-notify :reparent-notify))))
+ (has-graph-fun (memq type '(:graphics-exposure :no-exposure)))
+ (has-rect (memq type '(:exposure :graphics-exposure
+ :configure-notify
+ :create-notify :configure-request)))
+ (has-size (memq type '(:resize-request)))
+ (has-message (memq type '(:client-message))))
+ (when has-xy
+ (push (make-keyword :pos (x-event-pos event)) slots))
+ (when has-root-xy
+ (push (make-keyword :root-pos (x-event-root-pos event)) slots))
+ (when has-graph-fun
+ (push (make-keyword :graph-fun (x-event-graph-fun event)) slots))
+ (when has-rect
+ (push (make-keyword :rect (x-event-rect event)) slots))
+ (when has-size
+ (push (make-keyword :size (x-event-size event)) slots))
+ (when has-message
+ (push (make-keyword :message (x-event-message event)) slots))
+ slots))
+
+(define (keywords->slots1 type keywords)
+ (if (null? keywords)
+ '()
+ (if (memq (car keywords)
+ '(:x :y :width :height :root-x :root-y
+ :major :minor :type :data :format))
+ (keywords->slots1 type (cddr keywords))
+ (cons (keyword->slot type (car keywords) (cadr keywords))
+ (keywords->slots1 type (cddr keywords))))))
+
+(define (keyword->slot type slot val)
+ (if (eq? slot :state)
+ (case type
+ (:property-state (make-keyword :property-state val))
+ (:visibility (make-keyword :visibility val))
+ (else (make-keyword :state val)))
+ (make-keyword slot val)))
+
+(define (attrs->keywords attrs)
+ (if (null attrs)
+ '()
+ (nconc (attr->keyword (car attrs))
+ (attrs->keywords (cdr attrs)))))
+
+(define (attr->keyword attr)
+ (let* ((tag (keyword-key attr))
+ (val (keyword-val attr)))
+ (case tag
+ (:clip-origin `(:clip-x ,(xpoint-x val) :clip-y ,(xpoint-y val)))
+ (:dashes `(,tag ,(haskell-list->list/identity val)))
+ (:tile-origin `(:ts-x ,(xpoint-x val) :ts-y ,(xpoint-y val)))
+ (:size `(:width ,(xsize-w val) :height ,(xsize-h val)))
+ (:name `(:name ,(haskell-string->string val)))
+ (:hot-spot `(:x-hot ,(xpoint-x val) :y-hot ,(xpoint-y val)))
+ (else `(,tag ,val)))))
+
+(define (x-mutable-array-create inits)
+ (list->vector inits))
+
+(define (x-mutable-array-lookup a i)
+ (vector-ref a i))
+
+(define (x-mutable-array-update a i x)
+ (setf (vector-ref a i) x))
+
+(define (x-mutable-array-length a)
+ (vector-length a))
+
+(define (get-time-zone)
+ (nth-value 8 (lisp:get-decoded-time)))
+
+(define (decode-time time zone)
+ (multiple-value-bind (sec min hour date mon year week ds-p)
+ (if zone
+ (lisp:decode-universal-time time zone)
+ (lisp:decode-universal-time time))
+ (make-h-tuple
+ (list->haskell-list/identity (list sec min hour date mon year week))
+ ds-p)))
+
+(define (encode-time time zone)
+ (apply (function lisp:encode-universal-time)
+ (if (null? zone) time (append time (list zone)))))
+
+(define (get-run-time)
+ (/ (lisp:coerce (lisp:get-internal-run-time) 'lisp:single-float)
+ (lisp:coerce lisp:internal-time-units-per-second 'lisp:single-float)))
+
+(define (get-elapsed-time)
+ (/ (lisp:coerce (lisp:get-internal-real-time) 'lisp:single-float)
+ (lisp:coerce lisp:internal-time-units-per-second 'lisp:single-float)))
+
+(define (prim.thenio---1 x fn)
+ (lambda (state)
+ (declare (ignore state))
+ (let ((res (funcall x (box 'state))))
+ (format '#t "~A~%" res)
+ (funcall fn res (box 'state)))))
+
+(define-attribute-setter wm name)
+(define-attribute-setter wm icon-name)
diff --git a/progs/lib/X11/xlibprims.hi b/progs/lib/X11/xlibprims.hi
new file mode 100644
index 0000000..02d4163
--- /dev/null
+++ b/progs/lib/X11/xlibprims.hi
@@ -0,0 +1,1465 @@
+-- 4/13/93 add xTestEventMask, xTestStateMask
+-- 4/14/93 add xMArrayLength,
+-- xGetEventN
+-- 4/15/93 change xKeycodeCharacter
+-- add xKeysymCharacter
+-- add xHandleError
+-- add xError
+-- 4/27/93 Change Bool to XSwitch in XWinAttribute, XGCAttribute
+
+interface XLibPrims where
+
+import XLibTypes(
+ XDisplay, XScreen, XWindow, XGcontext, XPixmap,
+ XColormap, XCursor, XFont, XImage, XMaybe, XError,
+ XBitmap, XKeysymTable, XBitVec,
+ XPixarray, XByteVec, XAtom, XProperty,
+ XPixel, XDrawable, XTime, XSwitch,
+ XWindowPlace, XEventMode, XEventKind,
+ XWindowVisibility, XWindowStackMode,
+ XPropertyState, XMapReqType, XGraphFun,
+ XEvent, XEventType, XEventSlot, XEventMask,
+ XEventMaskKey, XStateMask, XStateMaskKey,
+ XWinAttribute,XGCAttribute, XImAttribute,
+ XGrabAttribute, XArcMode, XCapStyle,
+ XClipMask, XFillRule, XFillStyle,
+ XFunction, XJoinStyle, XLineStyle,
+ XSubwindowMode, XPoint, XSize, XRect,
+ XArc, XBitmapFormat, XByteOrder,
+ XPixmapFormat, XVisualInfo, XVisualClass,
+ XFillContent, XBackingStore, XGravity,
+ XWindowClass, XMapState, XImageData,
+ XImageFormat, XImageType, XDrawDirection,
+ XColor, XInputFocus, XGrabStatus,
+ XKeysym, XCloseDownMode, XScreenSaver)
+
+xHandleError :: (XError -> IO a) -> IO a -> IO a
+xError :: String -> IO a
+
+xEventType :: XEvent -> XEventType
+xEventWindow :: XEvent -> XWindow
+xEventEventWindow :: XEvent -> XWindow
+xEventCode :: XEvent -> Int
+xEventPos :: XEvent -> XPoint
+xEventState :: XEvent -> XStateMask
+xEventTime :: XEvent -> XTime
+xEventRoot :: XEvent -> XWindow
+xEventRootPos :: XEvent -> XPoint
+xEventChild :: XEvent -> (XMaybe XWindow)
+xEventSameScreenP :: XEvent -> Bool
+xEventHintP :: XEvent -> Bool
+xEventMode :: XEvent -> XEventMode
+xEventKind :: XEvent -> XEventKind
+xEventFocusP :: XEvent -> Bool
+xEventKeymap :: XEvent -> XBitVec
+xEventRequest :: XEvent -> XMapReqType
+xEventStart :: XEvent -> Int
+xEventCount :: XEvent -> Int
+xEventRect :: XEvent -> XRect
+xEventDrawable :: XEvent -> XDrawable
+xEventXGraphFun :: XEvent -> XGraphFun
+xEventPlace :: XEvent -> XWindowPlace
+xEventBorderWidth :: XEvent -> Int
+xEventAboveSibling :: XEvent -> (XMaybe XWindow)
+xEventOverrideRedirectP :: XEvent -> Bool
+xEventParent :: XEvent -> XWindow
+xEventConfigureP :: XEvent -> Bool
+xEventVisibility :: XEvent -> XWindowVisibility
+xEventNewP :: XEvent -> Bool
+xEventInstalledP :: XEvent -> Bool
+xEventStackMode :: XEvent -> XWindowStackMode
+xEventValueMask :: XEvent -> Int
+xEventSize :: XEvent -> XSize
+xEventMessage :: XEvent -> XProperty
+xEventPropertyState :: XEvent -> XPropertyState
+xEventAtom :: XEvent -> XAtom
+xEventSelection :: XEvent -> XAtom
+xEventTarget :: XEvent -> XAtom
+xEventProperty :: XEvent -> (XMaybe XAtom)
+xEventRequestor :: XEvent -> XWindow
+
+xSetEventMaskKey :: XEventMask -> XEventMaskKey -> XEventMask
+xClearEventMaskKey :: XEventMask -> XEventMaskKey -> XEventMask
+xTestEventMaskKey :: XEventMask -> XEventMaskKey -> Bool
+
+xSetStateMaskKey :: XStateMask -> XStateMaskKey -> XStateMask
+xClearStateMaskKey :: XStateMask -> XStateMaskKey -> XStateMask
+xTestStateMaskKey :: XStateMask -> XStateMaskKey -> Bool
+
+
+-- DISPLAYS
+
+-- open
+
+xOpenDisplay :: String -- host:display
+ -> IO XDisplay
+
+-- display attributes
+
+xDisplayAuthorizationData :: XDisplay -> String
+xDisplayAuthorizationName :: XDisplay -> String
+xDisplayBitmapFormat :: XDisplay -> XBitmapFormat
+xDisplayByteOrder :: XDisplay -> XByteOrder
+xDisplayDisplay :: XDisplay -> Int
+xSetDisplayErrorHandler :: XDisplay -> (XError -> IO ()) -> IO ()
+xDisplayImageLsbFirstP :: XDisplay -> Bool
+xDisplayMaxKeycode :: XDisplay -> Int
+xDisplayMaxRequestLength :: XDisplay -> Int
+xDisplayMinKeycode :: XDisplay -> Int
+xDisplayMotionBufferSize :: XDisplay -> Int
+xDisplayPixmapFormats :: XDisplay -> [XPixmapFormat]
+xDisplayProtocolMajorVersion :: XDisplay -> Int
+xDisplayProtocolMinorVersion :: XDisplay -> Int
+xDisplayResourceIdBase :: XDisplay -> Int
+xDisplayResourceIdMask :: XDisplay -> Int
+xDisplayRoots :: XDisplay -> [XScreen]
+xDisplayVendorName :: XDisplay -> String
+xDisplayReleaseNumber :: XDisplay -> Int
+
+-- output buffer
+
+xDisplayAfterFunction :: XDisplay -> XMaybe (IO ())
+xSetDisplayAfterFunction :: XDisplay -> XMaybe (IO ()) -> IO ()
+xDisplayForceOutput :: XDisplay -> IO ()
+xDisplayFinishOutput :: XDisplay -> IO ()
+
+-- close
+
+xCloseDisplay :: XDisplay -> IO ()
+
+-- SCREENS
+
+xScreenBackingStores :: XScreen -> XBackingStore
+xScreenBlackPixel :: XScreen -> XPixel
+xScreenDefaultColormap :: XScreen -> XColormap
+xScreenDepths :: XScreen -> [(Int, [XVisualInfo])]
+xScreenEventMaskAtOpen :: XScreen -> XEventMask
+xScreenSize :: XScreen -> XSize
+xScreenMMSize :: XScreen -> XSize
+xScreenMaxInstalledMaps :: XScreen -> Int
+xScreenMinInstalledMaps :: XScreen -> Int
+xScreenRoot :: XScreen -> XWindow
+xScreenRootDepth :: XScreen -> Int
+xScreenRootVisual :: XScreen -> Int
+xScreenSaveUndersP :: XScreen -> Bool
+xScreenWhitePixel :: XScreen -> XPixel
+
+-- WINDOWS AND PIXMAPS
+
+-- drawables
+
+xDrawableDisplay :: XDrawable -> XDisplay
+xDrawableEqual :: XDrawable -> XDrawable -> Bool
+xDrawableId :: XDrawable -> Int
+
+-- creating windows
+
+xCreateWindow :: XWindow -- parent
+ -> XRect -- (x,y,width,height)
+ -> [XWinAttribute] -- optional arguments
+ -> IO XWindow
+
+-- window attributes
+
+xWindowBorderWidth :: XWindow -> IO Int
+xSetWindowBorderWidth :: XWindow -> Int -> IO ()
+
+xDrawableDepth :: XDrawable -> Int
+
+xDrawableSize :: XDrawable -> IO XSize
+xDrawableResize :: XDrawable -> XSize -> IO ()
+
+xWindowPos :: XWindow -> IO XPoint
+xWindowMove :: XWindow -> XPoint -> IO ()
+
+xWindowAllEventMasks :: XWindow -> IO XEventMask
+xSetWindowBackground :: XWindow -> XFillContent -> IO ()
+
+xWindowBackingPixel :: XWindow -> IO XPixel
+xSetWindowBackingPixel :: XWindow -> XPixel -> IO ()
+
+xWindowBackingPlanes :: XWindow -> IO XPixel
+xSetWindowBackingPlanes :: XWindow -> XPixel -> IO ()
+
+xWindowBackingStore :: XWindow -> IO XBackingStore
+xSetWindowBackingStore :: XWindow -> XBackingStore -> IO ()
+
+xWindowBitGravity :: XWindow -> IO XGravity
+xSetWindowBitGravity :: XWindow -> XGravity -> IO ()
+
+xSetWindowBorder :: XWindow -> XFillContent -> IO ()
+
+xWindowClass :: XWindow -> XWindowClass
+
+xWindowColorMap :: XWindow -> IO (XMaybe XColormap)
+xSetWindowColorMap :: XWindow -> XColormap -> IO ()
+xWindowColormapInstalledP :: XWindow -> IO Bool
+
+xSetWindowCursor :: XWindow -> (XMaybe XCursor) -> IO ()
+
+xWindowDisplay :: XWindow -> XDisplay
+
+xWindowDoNotPropagateMask :: XWindow -> IO XEventMask
+xSetWindowDoNotPropagateMask :: XWindow -> XEventMask -> IO ()
+
+xWindowEqual :: XWindow -> XWindow -> Bool
+
+xWindowEventMask :: XWindow -> IO XEventMask
+xSetWindowEventMask :: XWindow -> XEventMask -> IO ()
+
+xWindowGravity :: XWindow -> IO XGravity
+xSetWindowGravity :: XWindow -> XGravity -> IO ()
+
+xWindowId :: XWindow -> Int
+
+xWindowMapState :: XWindow -> IO XMapState
+
+xWindowOverrideRedirect :: XWindow -> IO XSwitch
+xSetWindowOverrideRedirect :: XWindow -> XSwitch -> IO ()
+
+xSetWindowPriority :: XWindow -> XWindowStackMode -> IO ()
+
+xWindowSaveUnder :: XWindow -> IO XSwitch
+xSetWindowSaveUnder :: XWindow -> XSwitch -> IO ()
+
+xWindowVisual :: XWindow -> Int
+
+-- stacking order
+
+xCirculateWindowDown :: XWindow -> IO ()
+xCirculateWindowUp :: XWindow -> IO ()
+
+-- window hierarchy
+
+xDrawableRoot :: XDrawable -> IO XWindow
+xQueryTree :: XWindow -> IO ([XWindow], -- children
+ XMaybe XWindow,-- parent
+ XWindow) -- root
+
+xReparentWindow :: XWindow -- window
+ -> XWindow -- parent
+ -> XPoint -- (x,y)
+ -> IO ()
+
+xTranslateCoordinates :: XWindow -- source
+ -> XPoint -- (source-x,source-y)
+ -> XWindow -- destination
+ -> IO (XMaybe XPoint) -- (dest-x,dest-y)
+
+-- mapping windows
+
+xMapWindow :: XWindow -> IO ()
+xMapSubwindows :: XWindow -> IO ()
+xUnmapWindow :: XWindow -> IO ()
+xUnmapSubwindows :: XWindow -> IO ()
+
+-- destroying windows
+
+xDestroyWindow :: XWindow -> IO ()
+xDestroySubwindows :: XWindow -> IO ()
+
+-- pixmaps
+
+xCreatePixmap :: XSize -- (width,height)
+ -> Int -- depth
+ -> XDrawable -- drawable
+ -> IO XPixmap
+
+xFreePixmap :: XPixmap -> IO ()
+
+xPixmapDisplay :: XPixmap -> XDisplay
+xPixmapEqual :: XPixmap -> XPixmap -> Bool
+
+-- GRAPHICS CONTEXTS
+
+xCreateGcontext :: XDrawable -- drawable
+ -> [XGCAttribute] -- optional arguments
+ -> IO XGcontext
+
+xUpdateGcontext :: XGcontext -- old gcontext
+ -> [XGCAttribute] -- changes
+ -> IO () -- new gcontext
+
+xFreeGcontext :: XGcontext -> IO ()
+
+xGcontextDisplay :: XGcontext -> XDisplay
+xGcontextEqual :: XGcontext -> XGcontext -> Bool
+
+xGcontextId :: XGcontext -> Int
+
+xQueryBestStipple :: XSize -> XDrawable -> XSize
+xQueryBestTile :: XSize -> XDrawable -> XSize
+
+xCopyGcontext :: XGcontext -- source
+ -> XGcontext -- destination
+ -> IO ()
+
+-- GRAPHICS OPERATIONS
+
+xClearArea :: XWindow -- window
+ -> XRect -- (x,y,width,height)
+ -> Bool -- exposure-p
+ -> IO ()
+
+xCopyArea :: XDrawable -- source
+ -> XGcontext -- gcontext
+ -> XRect -- (src-x,src-y,w,h)
+ -> XDrawable -- destination
+ -> XPoint -- (dest-x,dest-y)
+ -> IO ()
+
+xCopyPlane :: XDrawable -- source
+ -> XGcontext -- gcontext
+ -> XPixel -- plane
+ -> XRect -- (src-x,src-y,w,h)
+ -> XDrawable -- destination
+ -> XPoint -- (dest-x,dest-y)
+ -> IO ()
+
+xDrawPoint :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x,y)
+ -> IO ()
+
+xDrawPoints :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> [XPoint] -- points
+ -> IO ()
+
+xDrawLine :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x1,y1)
+ -> XPoint -- (x2,y2)
+ -> IO ()
+
+xDrawLines :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> [XPoint] -- points
+ -> Bool -- fill-p
+ -> IO ()
+
+xDrawSegments :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> [(XPoint,XPoint)] -- segments
+ -> IO ()
+
+xDrawRectangle :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XRect -- (x,y,width,height)
+ -> Bool -- fill-p
+ -> IO ()
+
+xDrawRectangles :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> [XRect] -- rectangles
+ -> Bool -- fill-p
+ -> IO ()
+
+xDrawArc :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XArc -- (x,y,w,h,a1,a2)
+ -> Bool -- fill-p
+ -> IO ()
+
+xDrawArcs :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> [XArc] -- arcs
+ -> Bool -- fill-p
+ -> IO ()
+
+xDrawGlyph :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x,y)
+ -> Char -- element
+ -> IO (XMaybe Int) -- width
+
+xDrawGlyphs :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x,y)
+ -> String -- sequence
+ -> IO (XMaybe Int) -- width
+
+xDrawImageGlyph :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x,y)
+ -> Char -- element
+ -> IO (XMaybe Int) -- width
+
+xDrawImageGlyphs :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XPoint -- (x,y)
+ -> String -- sequence
+ -> IO (XMaybe Int) -- width
+
+-- IMAGES
+
+xImageBlueMask :: XImage -> XMaybe XPixel
+xImageDepth :: XImage -> Int
+xImageGreenMask :: XImage -> XMaybe XPixel
+xImageSize :: XImage -> XSize
+xImageName :: XImage -> String
+xSetImageName :: XImage -> String -> IO ()
+xImageRedMask :: XImage -> XMaybe XPixel
+xImageHotSpot :: XImage -> XMaybe XPoint
+xSetImageHotSpot :: XImage -> XPoint -> IO ()
+
+-- XY-format images
+
+xImageXYBitmaps :: XImage -> IO [XBitmap]
+xSetImageXYBitmaps :: XImage -> [XBitmap] -> IO ()
+
+-- Z-format images
+
+xImageZBitsPerPixel :: XImage -> IO Int
+xsetImageZBitsPerPixel :: XImage -> Int -> IO ()
+xImageZPixarray :: XImage -> IO XPixarray
+xSetImageZPixarray :: XImage -> XPixarray -> IO ()
+
+-- image functions
+
+xCreateImage :: [XImAttribute] -> IO XImage
+xCopyImage :: XImage -- image
+ -> XRect -- (x,y,width,height)
+ -> XImageType -- result-type
+ -> XImage -- new-image
+
+xGetImage :: XDrawable -- drawable
+ -> XRect -- (x,y,width,height)
+ -> XPixel -- plane-mask
+ -> XImageFormat -- format
+ -> XImageType -- result-type
+ -> IO XImage -- image
+
+xPutImage :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XImage -- ximage
+ -> XPoint -- (src-x,src-y)
+ -> XRect -- (x,y,width,height)
+ -> IO ()
+
+-- image files
+
+xReadBitmapFile :: String -- pathname
+ -> IO XImage
+
+xWriteBitmapFile :: String -- pathname
+ -> XImage -> IO ()
+
+-- direct image transfer
+
+xGetRawImage :: XDrawable -- drawable
+ -> XRect -- (x,y,width,height)
+ -> XPixel -- plane-mask
+ -> XImageFormat -- format
+ -> IO XImageData -- data
+
+xPutRawImage :: XDrawable -- drawable
+ -> XGcontext -- gcontext
+ -> XImageData -- data
+ -> Int -- depth
+ -> XRect -- (x,y,width,height)
+ -> Int -- left-pad
+ -> XImageFormat -- format
+ -> IO ()
+
+-- FONTS
+
+-- opening fonts
+
+xOpenFont :: XDisplay -> String -> IO XFont
+xCloseFont :: XFont -> IO ()
+xDiscardFontInfo :: XFont -> IO ()
+
+-- listing fonts
+
+xFontPath :: XDisplay -> IO [String]
+xListFontNames :: XDisplay -> String -- pattern
+ -> IO [String]
+xListFonts :: XDisplay -> String -- pattern
+ -> IO [XFont]
+
+-- font attriburtes
+
+xFontAllCharExistsP :: XFont -> Bool
+xFontAscent :: XFont -> Int
+xFontDefaultChar :: XFont -> Int
+xFontDescent :: XFont -> Int
+xFontDirection :: XFont -> XDrawDirection
+xFontDisplay :: XFont -> XDisplay
+xFontEqual :: XFont -> XFont -> Int
+xFontId :: XFont -> Int
+
+xFontMaxByte1 :: XFont -> Int
+xFontMaxByte2 :: XFont -> Int
+xFontMaxChar :: XFont -> Int
+xFontMinByte1 :: XFont -> Int
+xFontMinByte2 :: XFont -> Int
+xFontMinChar :: XFont -> Int
+
+xFontName :: XFont -> String
+
+xFontMaxCharAscent :: XFont -> Int
+xFontMaxCharAttributes :: XFont -> Int
+xFontMaxCharDescent :: XFont -> Int
+xFontMaxCharLeftBearing :: XFont -> Int
+xFontMaxCharRightBearing :: XFont -> Int
+xFontMaxCharWidth :: XFont -> Int
+xFontMinCharAscent :: XFont -> Int
+xFontMinCharAttributes :: XFont -> Int
+xFontMinCharDescent :: XFont -> Int
+xFontMinCharLeftBearing :: XFont -> Int
+xFontMinCharRightBearing :: XFont -> Int
+xFontMinCharWidth :: XFont -> Int
+
+-- char attributes
+
+xCharAscent :: XFont -> Int -> XMaybe Int
+xCharAttributes :: XFont -> Int -> XMaybe Int
+xCharDescent :: XFont -> Int -> XMaybe Int
+xCharLeftBearing :: XFont -> Int -> XMaybe Int
+xCharRightBearing :: XFont -> Int -> XMaybe Int
+xCharWidth :: XFont -> Int -> XMaybe Int
+
+-- querying text size
+
+xTextWidth :: XFont -- font
+ -> String -- sequence
+ -> Int -- width
+
+-- COLORS
+
+-- creating colormaps
+
+xCreateColormap :: XVisualInfo -- visual
+ -> XWindow -- window
+ -> Bool -- alloc-p
+ -> IO XColormap
+
+xCopyColormapAndFree :: XColormap -> IO XColormap
+xFreeColormap :: XColormap -> IO ()
+
+-- installing colormaps
+
+xInstallColormap :: XColormap -> IO ()
+xInstalledColormaps :: XWindow -> IO [XColormap]
+xUnInstallColormap :: XColormap -> IO ()
+
+-- allocating colors
+
+xAllocColor :: XColormap -> XColor
+ -> IO (XPixel, -- pixel
+ XColor, -- screen-color
+ XColor) -- exact-color
+
+xAllocColorCells :: XColormap -- pixel
+ -> Int -- colors
+ -> Int -- planes
+ -> Bool -- contiguous
+ -> IO ([XPixel], -- pixels
+ [XPixel]) -- mask
+
+xAllocColorPlanes :: XColormap -- colormap
+ -> Int -- colors
+ -> Int -- reds
+ -> Int -- greens
+ -> Int -- blues
+ -> Bool -- contiguous-p
+ -> IO ([XPixel], -- pixel
+ XPixel, -- red-mask
+ XPixel, -- green-mask
+ XPixel) -- blue-mask
+
+xFreeColors :: XColormap -> [XPixel] -- pixels
+ -> XPixel -- plane-mask
+ -> IO ()
+
+-- finding colors
+
+xLookupColor :: XColormap -> String -- name
+ -> IO (XColor, -- screen-color
+ XColor) -- exact-color
+
+xQueryColors :: XColormap -> [XPixel] -- pixels
+ -> IO [XColor]
+
+-- changing colors
+
+xStoreColor :: XColormap -> XPixel -- pixel
+ -> XColor -- color
+ -> IO ()
+
+xStoreColors :: XColormap -- colormap
+ -> [(XPixel, XColor)] -- pixel-colors
+ -> IO ()
+
+-- colormap attributes
+
+xColormapDisplay :: XColormap -> XDisplay
+xColormapEqual :: XColormap -> XColormap -> Bool
+
+-- CURSORS
+
+xCreateCursor :: XPixmap -- source
+ -> (XMaybe XPixmap) -- mask
+ -> XPoint -- (x,y)
+ -> XColor -- foreground
+ -> XColor -- background
+ -> IO XCursor
+
+xCreateGlyphCursor :: (XFont, char) -- (src-font,src-char)
+ -> (XMaybe (XFont, Char)) -- (mask-font,mask-char)
+ -> XColor -- foreground
+ -> XColor -- background
+ -> IO XCursor
+
+xFreeCursor :: XCursor -> IO ()
+
+xQueryBestCursor :: XSize -- (width,height)
+ -> XDisplay -> IO XSize
+
+xRecolorCursor :: XCursor -> XColor -- foreground
+ -> XColor -- background
+ -> IO ()
+
+xCursorDisplay :: XCursor -> XDisplay
+xCursorEqual :: XCursor -> XCursor -> Bool
+
+-- ATOMS, PROPERTIES, AND SELECTIONS
+
+-- atoms
+
+xAtomName :: XDisplay -> Int -- atom-id
+ -> XAtom
+
+xFindAtom :: XDisplay -> XAtom -- atom-name
+ -> IO (XMaybe Int)
+
+xInternAtom :: XDisplay -> XAtom -- atom-name
+ -> IO (XMaybe Int)
+
+-- properties
+
+xChangeProperty :: XWindow -- window
+ -> XAtom -- property
+ -> XProperty -- (data,type,format)
+ -> IO ()
+
+xDeleteProperty :: XWindow -> XAtom -> IO ()
+xGetProperty :: XWindow -- window
+ -> XAtom -- property
+ -> IO XProperty -- (data,type,format)
+
+xListProperties :: XWindow -> IO [XAtom]
+xRotateProperties :: XWindow -- window
+ -> [XAtom] -- properties
+ -> Int -- delta
+ -> IO ()
+
+-- selections
+
+xConvertSelection :: XAtom -- selection
+ -> XAtom -- type
+ -> XWindow -- requester
+ -> XAtom -- property
+ -> (XMaybe XTime) -- time
+ -> IO ()
+
+xSelectionOwner :: XDisplay -- display
+ -> XAtom -- selection
+ -> IO (XMaybe XWindow)
+
+xSetSelectionOwner :: XDisplay -- display
+ -> XAtom -- selection
+ -> (XMaybe XTime) -- time
+ -> XWindow -- owner
+ -> IO ()
+
+-- EVENT
+
+-- Wait for the next event
+
+xGetEvent :: XDisplay -> IO XEvent
+
+-- managing the event queue
+
+xQueueEvent :: XDisplay -> XEvent -> Bool -- append-p
+ -> IO ()
+
+xEventListen :: XDisplay -> IO Int -- # of events in queue
+
+-- sending events
+
+xSendEvent :: XWindow -- window
+ -> XEvent -- event key and slots
+ -> XEventMask -- event-mask
+ -> IO ()
+
+-- pointer position
+
+xGlobalPointerPosition :: XDisplay -> IO XPoint
+xPointerPosition :: XWindow -> IO (XMaybe XPoint)
+xMotionEvents :: XWindow -> XTime -> XTime -> IO [XPoint]
+xWarpPointer :: XWindow -> XPoint -> IO ()
+
+-- keyboard input focus
+
+xSetInputFocus :: XDisplay -- display
+ -> XInputFocus -- focus
+ -> XInputFocus -- revert-to
+ -> (XMaybe XTime) -- time
+ -> IO ()
+
+xInputFucus :: XDisplay -> IO (XInputFocus, -- focus
+ XInputFocus) -- revert-to
+
+-- grabbing the pointer
+
+xGrabPointer :: XWindow -- window
+ -> XEventMask -- event-mask
+ -> [XGrabAttribute] -- optional attributes
+ -> XMaybe XTime -- time
+ -> IO XGrabStatus
+
+xUngrabPointer :: XDisplay -> XMaybe XTime -> IO ()
+
+xChangeActivePointerGrab :: XDisplay -> XEventMask -- event-mask
+ -> [XGrabAttribute] -- cursor
+ -> XMaybe XTime -> IO ()
+
+-- grabbing a button
+
+xGrabButton :: XWindow -- window
+ -> Int -- button
+ -> XEventMask -- event-mask
+ -> XStateMask -- modifiers
+ -> [XGrabAttribute] -- optional attributes
+ -> IO ()
+
+xUngrabButton :: XWindow -> Int -- button
+ -> XStateMask -- modifiers
+ -> IO ()
+
+-- grabbing the keyboard
+
+xGrabKeyboard :: XWindow -- window
+ -> [XGrabAttribute] -- optional attributes
+ -> XMaybe XTime -- time
+ -> IO XGrabStatus
+
+xUngrabkeyboard :: XDisplay -> XMaybe XTime -> IO ()
+
+-- grabbing a key
+
+xGrabKey :: XWindow -- window
+ -> Int -- key
+ -> XStateMask -- modifiers
+ -> [XGrabAttribute] -- optional attributes
+ -> IO ()
+
+xUngrabKey :: XWindow -> Int -> XStateMask -- modifiers
+ -> IO ()
+
+-- CONTROL FUNCTIONS
+
+-- grabbing the server
+
+xGrabServer :: XDisplay -> IO ()
+xUngrabServer :: XDisplay -> IO ()
+
+-- pointer control
+
+xSetPointerAcceleration :: XDisplay -> Float -> IO ()
+xSetPointerThreshold :: XDisplay -> Float -> IO ()
+xPointerAcceleration :: XDisplay -> IO Float
+xPointerThreshold :: XDisplay -> IO Float
+xSetPointerMapping :: XDisplay -> [Int] -> IO ()
+xPointerMapping :: XDisplay -> IO [Int]
+
+-- keyboard control
+
+xBell :: XDisplay -> Int -> IO ()
+
+xSetKeyboardKeyClickPercent :: XDisplay -> Int -> IO ()
+xSetKeyboardBellPercent :: XDisplay -> Int -> IO ()
+xSetKeyboardBellPitch :: XDisplay -> Int -> IO ()
+xSetKeyboardBellDuration :: XDisplay -> Int -> IO ()
+xSetKeyboardLed :: XDisplay -> Integer -> IO ()
+xSetKeyboardAutoRepeatMode :: XDisplay -> XBitVec -> IO ()
+
+xKeyboardKeyClickPercent :: XDisplay -> IO Int
+xKeyboardBellPercent :: XDisplay -> IO Int
+xKeyboardBellPitch :: XDisplay -> IO Int
+xKeyboardBellDuration :: XDisplay -> IO Int
+
+xKeyboardLed :: XDisplay -> IO Integer
+xKeyboardAutoRepeatMode :: XDisplay -> IO XBitVec
+
+xModifierMapping :: XDisplay -> IO [[Int]]
+xSetModifierMapping :: XDisplay -> [[Int]] -> IO (XMaybe ())
+xQueryKeymap :: XDisplay -> IO XBitVec
+
+-- keyboard mapping
+
+xChangeKeyboardMapping :: XDisplay -- display
+ -> XKeysymTable -- keysyms
+ -> IO ()
+
+xKeyboardMapping :: XDisplay -- display
+ -> IO XKeysymTable -- mappings
+
+xKeycodeKeysym :: XDisplay -- display
+ -> Int -- keycode
+ -> Int -- keysym-index
+ -> IO XKeysym
+
+xKeysymCharacter :: XDisplay -- display
+ -> XKeysym -- keysym
+ -> XStateMask -- state
+ -> IO (XMaybe Char)
+
+xKeycodeCharacter :: XDisplay -- display
+ -> Int -- keycode
+ -> XStateMask -- state
+ -> IO (XMaybe Char)
+
+-- client termination
+
+xAddToSaveSet :: XWindow -> IO ()
+xCloseDownMode :: XDisplay -> IO XCloseDownMode
+xSetCloseDownMode :: XDisplay -> XCloseDownMode -> IO ()
+xKillClient :: XDisplay -> Int -> IO ()
+xKillTemporaryClients :: XDisplay -> IO ()
+xRemoveFromSaveSet :: XWindow -> IO ()
+
+-- managing host access
+
+xAccessControl :: XDisplay -> IO Bool
+xSetAccessControl :: XDisplay -> Bool -> IO ()
+xAccessHosts :: XDisplay -> IO [String]
+xAddAccessHost :: XDisplay -> String -> IO ()
+xRemoveAccessHost :: XDisplay -> String -> IO ()
+
+-- screen saver
+
+xActivateScreenSaver :: XDisplay -> IO ()
+xResetScreenSaver :: XDisplay -> IO ()
+
+xScreenSaver :: XDisplay -> IO XScreenSaver
+xSetScreenSaver :: XDisplay -> XScreenSaver -> IO ()
+
+{-#
+
+
+xHandleError :: LispName("x-handle-error")
+xError :: LispName("xlib::x-error")
+
+xEventType :: LispName("sel-event-type")
+
+xEventWindow :: LispName ("x-event-window")
+xEventEventWindow :: LispName ("x-event-event-window")
+xEventCode :: LispName ("x-event-code")
+xEventPos :: LispName ("x-event-pos")
+xEventState :: LispName ("x-event-state")
+xEventTime :: LispName ("x-event-time")
+xEventRoot :: LispName ("x-event-root")
+xEventRootPos :: LispName ("x-event-root-pos")
+xEventChild :: LispName ("x-event-child")
+xEventSameScreenP :: LispName ("x-event-same-screen-p")
+xEventHintP :: LispName ("x-event-hint-p")
+xEventMode :: LispName ("x-event-mode")
+xEventKind :: LispName ("x-event-kind")
+xEventFocusP :: LispName ("x-event-focus-p")
+xEventKeymap :: LispName ("x-event-keymap")
+xEventRequest :: LispName ("x-event-request")
+xEventStart :: LispName ("x-event-start")
+xEventCount :: LispName ("x-event-count")
+xEventRect :: LispName ("x-event-rect")
+xEventDrawable :: LispName ("x-event-drawable")
+xEventXGraphFun :: LispName ("x-event-graph-fun")
+xEventPlace :: LispName ("x-event-place")
+xEventBorderWidth :: LispName ("x-event-border-width")
+xEventAboveSibling :: LispName ("x-event-above-sibling")
+xEventOverrideRedirectP :: LispName ("x-event-override-redirect-p")
+xEventParent :: LispName ("x-event-parent")
+xEventConfigureP :: LispName ("x-event-configure-p")
+xEventVisibility :: LispName ("x-event-state")
+xEventNewP :: LispName ("x-event-new-p")
+xEventInstalledP :: LispName ("x-event-installed-p")
+xEventStackMode :: LispName ("x-event-stack-mode")
+xEventValueMask :: LispName ("x-event-value-mask")
+xEventSize :: LispName ("x-event-size")
+xEventMessage :: LispName ("x-event-message")
+xEventPropertyState :: LispName ("x-event-state")
+xEventAtom :: LispName ("x-event-atom")
+xEventSelection :: LispName ("x-event-selection")
+xEventTarget :: LispName ("x-event-target")
+xEventProperty :: LispName ("x-event-property")
+xEventRequestor :: LispName ("x-event-requestor")
+
+
+xSetEventMaskKey :: LispName ("x-set-event-mask-key")
+xClearEventMaskKey :: LispName ("x-clear-event-mask-key")
+xTestEventMaskKey :: LispName ("x-test-event-mask-key")
+
+xSetStateMaskKey :: LispName ("x-set-state-mask-key")
+xClearStateMaskKey :: LispName ("x-clear-state-mask-key")
+xTestStateMaskKey :: LispName ("x-test-state-mask-key")
+
+-- DISPLAYS
+
+-- open
+
+xOpenDisplay :: LispName("x-open-display")
+
+-- display attributes
+
+xDisplayAuthorizationData :: LispName("xlib:display-authorization-data")
+xDisplayAuthorizationName :: LispName("xlib:display-authorization-name")
+xDisplayBitmapFormat :: LispName("xlib:display-bitmap-format")
+xDisplayByteOrder :: LispName("xlib:display-byte-order")
+xDisplayDisplay :: LispName("xlib:display-display")
+xSetDisplayErrorHandler :: LispName("x-set-display-error-handler")
+xDisplayImageLsbFirstP :: LispName("xlib:display-image-lsb-first-p")
+xDisplayMaxKeycode :: LispName("xlib:display-max-keycode")
+xDisplayMaxRequestLength :: LispName("xlib:display-max-request-length")
+xDisplayMinKeycode :: LispName("xlib:display-min-keycode")
+xDisplayMotionBufferSize :: LispName("xlib:display-motion-buffer-size")
+xDisplayPixmapFormats :: LispName("xlib:display-pixmap-formats")
+xDisplayProtocolMajorVersion :: LispName("xlib:display-protocol-major-version")
+xDisplayProtocolMinorVersion :: LispName("xlib:display-protocol-minor-version")
+xDisplayResourceIdBase :: LispName("xlib:display-resource-id-base")
+xDisplayResourceIdMask :: LispName("xlib:display-resource-id-mask")
+xDisplayRoots :: LispName("xlib:display-roots")
+xDisplayVendorName :: LispName("xlib:display-vendor-name")
+xDisplayReleaseNumber :: LispName("xlib:display-release-number")
+
+-- output buffer
+
+xDisplayAfterFunction :: LispName("xlib:display-after-function")
+xSetDisplayAfterFunction :: LispName("x-set-display-after-function")
+xDisplayForceOutput :: LispName("xlib:display-force-output")
+xDisplayFinishOutput :: LispName("xlib:display-finish-output")
+
+-- close
+
+xCloseDisplay :: LispName("xlib:close-display")
+
+-- SCREENS
+
+xScreenBackingStores :: LispName("xlib:screen-backing-stores")
+xScreenBlackPixel :: LispName("xlib:screen-black-pixel")
+xScreenDefaultColormap :: LispName("xlib:screen-default-colormap")
+xScreenDepths :: LispName("x-screen-depths")
+xScreenEventMaskAtOpen :: LispName("xlib:screen-event-mask-at-open")
+xScreenSize :: LispName("x-screen-size")
+xScreenMMSize :: LispName("x-screen-mmsize")
+xScreenMaxInstalledMaps :: LispName("xlib:screen-max-installed-maps")
+xScreenMinInstalledMaps :: LispName("xlib:screen-min-installed-maps")
+xScreenRoot :: LispName("xlib:screen-root")
+xScreenRootDepth :: LispName("xlib:screen-root-depth")
+xScreenRootVisual :: LispName("xlib:screen-root-visual")
+xScreenSaveUndersP :: LispName("xlib:screen-save-unders-p")
+xScreenWhitePixel :: LispName("xlib:screen-white-pixel")
+
+-- WINDOWS AND PIXMAPS
+
+-- drawables
+
+xDrawableDisplay :: LispName("xlib:drawable-display")
+xDrawableEqual :: LispName("xlib:drawable-equal")
+xDrawableId :: LispName("xlib:drawable-id")
+
+-- creating windows
+
+xCreateWindow :: LispName("x-create-window")
+
+-- window attributes
+
+xWindowBorderWidth :: LispName("xlib:drawable-border-width")
+xSetWindowBorderWidth :: LispName("x-set-drawable-border-width")
+
+xDrawableDepth :: LispName("xlib:drawable-depth")
+
+xDrawableSize :: LispName("x-drawable-size")
+xDrawableResize :: LispName("x-drawable-resize")
+
+xWindowPos :: LispName("x-window-pos")
+xWindowMove :: LispName("x-window-move")
+
+xWindowAllEventMasks :: LispName("xlib:window-all-event-masks")
+
+xSetWindowBackground :: LispName("x-set-window-background")
+
+xWindowBackingPixel :: LispName("xlib:window-backing-pixel")
+xSetWindowBackingPixel :: LispName("x-set-window-backing-pixel")
+
+xWindowBackingPlanes :: LispName("xlib:window-backing-planes")
+xSetWindowBackingPlanes :: LispName("x-set-window-backing-planes")
+
+xWindowBackingStore :: LispName("xlib:window-backing-store")
+xSetWindowBackingStore :: LispName("x-set-window-backing-store")
+
+xWindowBitGravity :: LispName("xlib:window-bit-gravity")
+xSetWindowBitGravity :: LispName("x-set-window-bit-gravity")
+
+xSetWindowBorder :: LispName("x-set-window-border")
+
+xWindowClass :: LispName("xlib:window-class")
+
+xWindowColorMap :: LispName("xlib:window-colormap")
+xSetWindowColorMap :: LispName("x-set-window-colormap")
+xWindowColormapInstalledP :: LispName("xlib:window-colormap-installed-p")
+
+xSetWindowCursor :: LispName("x-set-window-cursor")
+
+xWindowDisplay :: LispName("xlib:window-display")
+
+xWindowDoNotPropagateMask :: LispName("xlib:window-do-not-propagate-mask")
+xSetWindowDoNotPropagateMask :: LispName("x-set-window-do-not-propagate-mask")
+
+xWindowEqual :: LispName("xlib:window-equal")
+
+xWindowEventMask :: LispName("xlib:window-event-mask")
+xSetWindowEventMask :: LispName("x-set-window-event-mask")
+
+xWindowGravity :: LispName("xlib:window-gravity")
+xSetWindowGravity :: LispName("x-set-window-gravity")
+
+xWindowId :: LispName("xlib:window-id")
+
+xWindowMapState :: LispName("xlib:window-map-state")
+
+xWindowOverrideRedirect :: LispName("xlib:window-override-redirect")
+xSetWindowOverrideRedirect :: LispName("x-set-window-override-redirect")
+
+xSetWindowPriority :: LispName("x-set-window-priority")
+
+xWindowSaveUnder :: LispName("xlib:window-save-under")
+xSetWindowSaveUnder :: LispName("x-set-window-save-under")
+xWindowVisual :: LispName("xlib:window-visual")
+
+-- stacking order
+
+xCirculateWindowDown :: LispName("xlib:circulate-window-down")
+xCirculateWindowUp :: LispName("xlib:circulate-window-up")
+
+-- window hierarchy
+
+xDrawableRoot :: LispName("xlib:drawable-root")
+xQueryTree :: LispName("x-query-tree")
+
+xReparentWindow :: LispName("x-reparent-window")
+
+xTranslateCoordinates :: LispName("x-translate-coordinates")
+
+-- mapping windows
+
+xMapWindow :: LispName("xlib:map-window")
+xMapSubwindows :: LispName("xlib:map-subwindows")
+xUnmapWindow :: LispName("xlib:unmap-window")
+xUnmapSubwindows :: LispName("xlib:unmap-subwindows")
+
+-- destroying windows
+
+xDestroyWindow :: LispName("xlib:destroy-window")
+xDestroySubwindows :: LispName("xlib:destroy-subwindows")
+
+-- pixmaps
+
+xCreatePixmap :: LispName("x-create-pixmap")
+xFreePixmap :: LispName("xlib:free-pixmap")
+xPixmapDisplay :: LispName("xlib:pixmap-display")
+xPixmapEqual :: LispName("xlib:pixmap-equal")
+
+-- GRAPHICS CONTEXTS
+
+xCreateGcontext :: LispName("x-create-gcontext")
+xUpdateGcontext :: LispName("x-update-gcontext")
+xFreeGcontext :: LispName("xlib:free-gcontext")
+
+xGcontextDisplay :: LispName("xlib:gcontext-display")
+xGcontextEqual :: LispName("xlib:gcontext-equal")
+
+xGcontextId :: LispName("xlib:gcontext-id")
+
+xQueryBestStipple :: LispName("x-query-best-stipple")
+xQueryBestTile :: LispName("x-query-best-tile")
+
+xCopyGcontext :: LispName("xlib:copy-gcontext")
+
+-- GRAPHICS OPERATIONS
+
+xClearArea :: LispName("x-clear-area")
+xCopyArea :: LispName("x-copy-area")
+xCopyPlane :: LispName("x-copy-plane")
+xDrawPoint :: LispName("x-draw-point")
+xDrawPoints :: LispName("x-draw-points")
+xDrawLine :: LispName("x-draw-line")
+xDrawLines :: LispName("x-draw-lines")
+xDrawSegments :: LispName("x-draw-segments")
+xDrawRectangle :: LispName("x-draw-rectangle")
+xDrawRectangles :: LispName("x-draw-rectangles")
+xDrawArc :: LispName("x-draw-arc")
+xDrawArcs :: LispName("x-draw-arcs")
+xDrawGlyph :: LispName("x-draw-glyph")
+xDrawGlyphs :: LispName("x-draw-glyphs")
+xDrawImageGlyph :: LispName("x-draw-image-glyph")
+xDrawImageGlyphs :: LispName("x-draw-image-glyphs")
+
+-- IMAGES
+
+xImageBlueMask :: LispName("xlib:image-blue-mask")
+xImageDepth :: LispName("xlib:image-depth")
+xImageGreenMask :: LispName("xlib:image-green-mask")
+xImageSize :: LispName("x-image-size")
+xImageName :: LispName("x-image-name")
+xSetImageName :: LispName("x-set-image-name")
+xImageRedMask :: LispName("xlib:image-red-mask")
+xImageHotSpot :: LispName("x-image-hot-spot")
+xSetImageHotSpot :: LispName("x-set-image-hot-spot")
+
+-- XY-format images
+
+xImageXYBitmaps :: LispName("xlib:image-xy-bitmap-list")
+xSetImageXYBitmaps :: LispName("x-set-image-xy-bitmap-list")
+
+-- Z-format images
+
+xImageZBitsPerPixel :: LispName("xlib:image-z-bits-per-pixel")
+xsetImageZBitsPerPixel :: LispName("x-set-image-z-bits-per-pixel")
+xImageZPixarray :: LispName("xlib:image-z-pixarray")
+xSetImageZPixarray :: LispName("x-set-image-z-pixarray")
+
+-- image functions
+
+xCreateImage :: LispName("x-create-image")
+xCopyImage :: LispName("x-copy-image")
+xGetImage :: LispName("x-get-image")
+xPutImage :: LispName("x-put-image")
+
+-- image files
+
+xReadBitmapFile :: LispName("xlib:read-bitmap-file")
+xWriteBitmapFile :: LispName("xlib:write-bitmap-file")
+
+-- direct image transfer
+
+xGetRawImage :: LispName("x-get-raw-image")
+xPutRawImage :: LispName("x-put-raw-image")
+
+-- FONTS
+
+-- opening fonts
+
+xOpenFont :: LispName ("xlib:open-font")
+xCloseFont :: LispName ("xlib:close-font")
+xDiscardFontInfo :: LispName ("xlib:discard-font-info")
+
+-- listing fonts
+
+xFontPath :: LispName ("xlib:font-path")
+xListFontNames :: LispName ("xlib:list-font-names")
+xListFonts :: LispName ("xlib:list-fonts")
+
+-- font attriburtes
+
+xFontAllCharExistsP :: LispName ("xlib:font-all-chars-exist-p")
+xFontAscent :: LispName ("xlib:font-ascent")
+xFontDefaultChar :: LispName ("xlib:font-default-char")
+xFontDescent :: LispName ("xlib:font-descent")
+xFontDirection :: LispName ("xlib:font-direction")
+xFontDisplay :: LispName ("xlib:font-display")
+xFontEqual :: LispName ("xlib:font-equal")
+xFontId :: LispName ("xlib:font-id")
+
+xFontMaxByte1 :: LispName ("xlib:font-max-byte1")
+xFontMaxByte2 :: LispName ("xlib:font-max-byte2")
+xFontMaxChar :: LispName ("xlib:font-max-char")
+xFontMinByte1 :: LispName ("xlib:font-min-byte1")
+xFontMinByte2 :: LispName ("xlib:font-min-byte2")
+xFontMinChar :: LispName ("xlib:font-min-char")
+
+xFontName :: LispName ("x-font-name")
+
+xFontMaxCharAscent :: LispName ("xlib:max-char-ascent")
+xFontMaxCharAttributes :: LispName ("xlib:max-char-attributes")
+xFontMaxCharDescent :: LispName ("xlib:max-char-descent")
+xFontMaxCharLeftBearing :: LispName ("xlib:max-char-left-bearing")
+xFontMaxCharRightBearing :: LispName ("xlib:max-char-right-bearing")
+xFontMaxCharWidth :: LispName ("xlib:max-char-width")
+xFontMinCharAscent :: LispName ("xlib:min-char-ascent")
+xFontMinCharAttributes :: LispName ("xlib:min-char-attributes")
+xFontMinCharDescent :: LispName ("xlib:min-char-descent")
+xFontMinCharLeftBearing :: LispName ("xlib:min-char-left-bearing")
+xFontMinCharRightBearing :: LispName ("xlib:min-char-right-bearing")
+xFontMinCharWidth :: LispName ("xlib:min-char-width")
+
+-- char attributes
+
+xCharAscent :: LispName ("xlib:char-ascent")
+xCharAttributes :: LispName ("xlib:char-attributes")
+xCharDescent :: LispName ("xlib:char-descent")
+xCharLeftBearing :: LispName ("xlib:char-left-bearing")
+xCharRightBearing :: LispName ("xlib:char-right-bearing")
+xCharWidth :: LispName ("xlib:char-width")
+
+-- querying text size
+
+xTextWidth :: LispName ("xlib:text-width")
+
+-- COLORS
+
+-- creating colormaps
+
+xCreateColormap :: LispName ("xlib:create-colormap")
+xCopyColormapAndFree :: LispName ("xlib:copy-colormap-and-free")
+xFreeColormap :: LispName ("xlib:free-colormap")
+
+-- installing colormaps
+
+xInstallColormap :: LispName ("xlib:install-colormap")
+xInstalledColormaps :: LispName ("xlib:installed-colormaps")
+xUnInstallColormap :: LispName ("xlib:uninstall-colormap")
+
+-- allocating colors
+
+xAllocColor :: LispName ("x-alloc-color")
+xAllocColorCells :: LispName ("x-alloc-color-cells")
+xAllocColorPlanes :: LispName ("x-alloc-color-planes")
+
+xFreeColors :: LispName ("xlib:free-colors")
+
+-- finding colors
+
+xLookupColor :: LispName ("x-lookup-color")
+xQueryColors :: LispName ("xlib:query-colors")
+
+-- changing colors
+
+xStoreColor :: LispName ("xlib:store-color")
+xStoreColors :: LispName ("x-store-colors")
+
+-- colormap attributes
+
+xColormapDisplay :: LispName ("xlib:colormap-display")
+xColormapEqual :: LispName ("xlib:colormap-equal")
+
+-- CURSORS
+
+xCreateCursor :: LispName ("x-create-cursor")
+xCreateGlyphCursor :: LispName ("x-create-glyph-cursor")
+xFreeCursor :: LispName ("xlib:free-cursor")
+
+xQueryBestCursor :: LispName ("x-query-best-cursor")
+xRecolorCursor :: LispName ("xlib:recolor-cursor")
+
+xCursorDisplay :: LispName ("xlib:cursor-display")
+xCursorEqual :: LispName ("xlib:cursor-equal")
+
+-- ATOMS, PROPERTIES, AND SELECTIONS
+
+-- atoms
+
+xAtomName :: LispName ("xlib:atom-name")
+xFindAtom :: LispName ("xlib:find-atom")
+xInternAtom :: LispName ("xlib:intern-atom")
+
+-- properties
+
+xChangeProperty :: LispName ("x-change-property")
+xDeleteProperty :: LispName ("xlib:delete-property")
+xGetProperty :: LispName ("x-get-property")
+xListProperties :: LispName ("xlib:list-properties")
+xRotateProperties :: LispName ("xlib:rotate-properties")
+
+-- selections
+
+xConvertSelection :: LispName ("x-convert-selection")
+xSelectionOwner :: LispName ("xlib:selection-owner")
+xSetSelectionOwner :: LispName ("x-set-selection-owner")
+
+-- EVENT
+
+-- Wait for the next event
+
+xGetEvent :: LispName ("x-get-event")
+
+-- managing the event queue
+
+xQueueEvent :: LispName ("x-queue-event")
+xEventListen :: LispName ("x-event-listen")
+
+-- sending events
+
+xSendEvent :: LispName ("x-send-event")
+
+-- pointer position
+
+xGlobalPointerPosition :: LispName ("x-global-pointer-position")
+xPointerPosition :: LispName ("x-pointer-position")
+xMotionEvents :: LispName ("x-motion-events")
+xWarpPointer :: LispName ("x-warp-pointer")
+
+-- keyboard input focus
+
+xSetInputFocus :: LispName ("x-set-input-focus")
+xInputFucus :: LispName ("x-input-focus")
+
+-- grabbing the pointer
+
+xGrabPointer :: LispName ("x-grab-pointer")
+xUngrabPointer :: LispName ("x-ungrab-pointer")
+xChangeActivePointerGrab :: LispName ("x-change-active-pointer-grab")
+
+-- grabbing a button
+
+xGrabButton :: LispName ("x-grab-button")
+xUngrabButton :: LispName ("x-ungrab-button")
+
+-- grabbing the keyboard
+
+xGrabKeyboard :: LispName ("x-grab-keyboard")
+xUngrabkeyboard :: LispName ("x-ungrab-keyboard")
+
+-- grabbing a key
+
+xGrabKey :: LispName ("x-grab-key")
+xUngrabKey :: LispName ("x-ungrab-key")
+
+-- CONTROL FUNCTIONS
+
+-- grabbing the server
+
+xGrabServer :: LispName ("xlib:grab-server")
+xUngrabServer :: LispName ("xlib:ungrab-server")
+
+-- pointer control
+
+xSetPointerAcceleration :: LispName ("x-set-pointer-acceleration")
+xSetPointerThreshold :: LispName ("x-set-pointer-threshold")
+xPointerAcceleration :: LispName ("x-pointer-acceleration")
+xPointerThreshold :: LispName ("x-pointer-threshold")
+xSetPointerMapping :: LispName ("x-set-pointer-mapping")
+xPointerMapping :: LispName ("xlib:pointer-mapping")
+
+-- keyboard control
+
+xBell :: LispName ("xlib:bell")
+
+xSetKeyboardKeyClickPercent :: LispName ("x-set-keyboard-key-click-percent")
+xSetKeyboardBellPercent :: LispName ("x-set-keyboard-bell-percent")
+xSetKeyboardBellPitch :: LispName ("x-set-keyboard-bell-pitch")
+xSetKeyboardBellDuration :: LispName ("x-set-keyboard-bell-duration")
+xSetKeyboardLed :: LispName ("x-set-keyboard-led")
+xSetKeyboardAutoRepeatMode :: LispName ("x-set-keyboard-auto-repeat-mode")
+
+xKeyboardKeyClickPercent :: LispName ("x-keyboard-key-click-percent")
+xKeyboardBellPercent :: LispName ("x-keyboard-bell-percent")
+xKeyboardBellPitch :: LispName ("x-keyboard-bell-pitch")
+xKeyboardBellDuration :: LispName ("x-keyboard-bell-duration")
+xKeyboardLed :: LispName ("x-keyboard-led")
+xKeyboardAutoRepeatMode :: LispName ("x-keyboard-auto-repeat-mode")
+
+xModifierMapping :: LispName ("x-modifier-mapping")
+xSetModifierMapping :: LispName ("x-set-modifier-mapping")
+xQueryKeymap :: LispName ("xlib:query-keymap")
+
+-- keyboard mapping
+
+xChangeKeyboardMapping :: LispName ("xlib:change-keyboard-mapping")
+xKeyboardMapping :: LispName ("xlib:keyboard-mapping")
+
+xKeycodeKeysym :: LispName ("xlib:keycode->keysym")
+xKeysymCharacter :: LispName ("x-keysym-character")
+xKeycodeCharacter :: LispName ("x-keycode-character")
+
+-- client termination
+
+xAddToSaveSet :: LispName ("xlib:add-to-save-set")
+xCloseDownMode :: LispName ("xlib:close-down-mode")
+xSetCloseDownMode :: LispName ("x-set-close-down-mode")
+xKillClient :: LispName ("xlib:kill-client")
+xKillTemporaryClients :: LispName ("xlib:kill-temporary-clients")
+xRemoveFromSaveSet :: LispName ("xlib:remove-from-save-set")
+
+-- managing host access
+
+xAccessControl :: LispName ("xlib:access-control")
+xSetAccessControl :: LispName ("x-set-access-control")
+xAccessHosts :: LispName ("xlib:access-hosts")
+xAddAccessHost :: LispName ("xlib:add-access-host")
+xRemoveAccessHost :: LispName ("xlib:remove-access-host")
+
+-- screen saver
+
+xActivateScreenSaver :: LispName ("xlib:activate-screen-saver")
+xResetScreenSaver :: LispName ("xlib:reset-screen-saver")
+xScreenSaver :: LispName ("x-screen-saver")
+xSetScreenSaver :: LispName ("x-set-screen-saver")
+
+#-}
+
+data XMArray a
+
+xMArrayCreate :: [a] -> IO (XMArray a)
+xMArrayLookup :: XMArray a -> Int -> IO a
+xMArrayUpdate :: XMArray a -> Int -> a -> IO ()
+xMArrayLength :: XMArray a -> Int
+
+{-#
+xMArrayCreate :: LispName("x-mutable-array-create")
+xMArrayLookup :: LispName("x-mutable-array-lookup")
+xMArrayUpdate :: LispName("x-mutable-array-update")
+xMArrayLength :: LispName("x-mutable-array-length")
+#-}
+
+
+xprint :: a -> IO ()
+{-#
+xprint :: LispName ("x-print")
+#-}
+
+-- decoded time format:
+-- ([second, minute, hour, date, month, year, day-of-week],
+-- daylight-saving-time-p)
+-- time format to encode:
+-- [second, minute, hour, date, month, year]
+
+data TimeZone = WestOfGMT Int {-# STRICT #-}
+ | CurrentZone
+
+getTime :: IO Integer
+getTimeZone :: IO Int
+decodeTime :: Integer -> TimeZone -> ([Int], Bool)
+encodeTime :: [Int] -> TimeZone -> Integer
+getRunTime :: IO Float
+getElapsedTime :: IO Float
+sleep :: Int -> IO ()
+
+{-#
+ImportLispType (TimeZone (WestOfGMT ("number?", "identity", "identity")))
+ImportLispType (TimeZone (CurrentZone ("null?", "'()")))
+
+getTime :: LispName("lisp:get-universal-time")
+getTimeZone :: LispName("get-time-zone")
+decodeTime :: LispName("decode-time")
+encodeTime :: LispName("encode-time")
+getRunTime :: LispName("get-run-time")
+getElapsedTime :: LispName("get-elapsed-time")
+sleep :: LispName("lisp:sleep")
+
+#-}
+
+xWmName :: XWindow -> IO String
+xSetWmName :: XWindow -> String -> IO ()
+
+xWmIconName :: XWindow -> IO String
+xSetWmIconName :: XWindow -> String -> IO ()
+
+{-#
+xWmName :: LispName ("xlib:wm-name")
+xSetWmName :: LispName ("x-set-wm-name")
+
+xWmIconName :: LispName ("xlib:wm-icon-name")
+xSetWmIconName :: LispName ("x-set-wm-icon-name")
+#-}
diff --git a/progs/lib/X11/xlibprims.hu b/progs/lib/X11/xlibprims.hu
new file mode 100644
index 0000000..38138d4
--- /dev/null
+++ b/progs/lib/X11/xlibprims.hu
@@ -0,0 +1,5 @@
+:output $LIBRARYBIN/
+:stable
+:o= all
+xlibclx.scm
+xlibprims.hi