From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001 From: Yale AI Dept Date: Wed, 14 Jul 1993 13:08:00 -0500 Subject: Import to github. --- progs/lib/X11/README | 11 + progs/lib/X11/clx-patch.lisp | 39 ++ progs/lib/X11/xlib.hs | 877 +++++++++++++++++++++++++ progs/lib/X11/xlib.hu | 5 + progs/lib/X11/xlibclx.scm | 1262 ++++++++++++++++++++++++++++++++++++ progs/lib/X11/xlibprims.hi | 1465 ++++++++++++++++++++++++++++++++++++++++++ progs/lib/X11/xlibprims.hu | 5 + 7 files changed, 3664 insertions(+) create mode 100644 progs/lib/X11/README create mode 100644 progs/lib/X11/clx-patch.lisp create mode 100644 progs/lib/X11/xlib.hs create mode 100644 progs/lib/X11/xlib.hu create mode 100644 progs/lib/X11/xlibclx.scm create mode 100644 progs/lib/X11/xlibprims.hi create mode 100644 progs/lib/X11/xlibprims.hu (limited to 'progs/lib/X11') 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 "<>" + +data XKeysymTable {-# STRICT #-} + = XKeysymTable [[Integer]] +instance Text(XKeysymTable) where + showsPrec p x = showString "<>" + +data XBitVec {-# STRICT #-} + = XBitVec [Int] +instance Text(XBitVec) where + showsPrec p x = showString "<>" + +data XPixarray {-# STRICT #-} + = XPixarray [[Integer]] +instance Text(XPixarray) where + showsPrec p x = showString "<>" + +data XByteVec {-# STRICT #-} + = XByteVec [Int] +instance Text(XByteVec) where + showsPrec p x = showString "<>" + + +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 -- cgit v1.2.3