(* xprint.sml
 *
 * COPYRIGHT (c) 1990,1991 by John H. Reppy.  See COPYRIGHT file for details.
 *)

structure XPrint : sig
    val xevtName : XEventTypes.xevent -> string
    val xerrorKind : XErrors.xerr_kind -> string
    val xerrorToString : XErrors.xerror -> string
    val xidToString : XProtTypes.xid -> string
  end = struct

    structure XEvt = XEventTypes
    structure XErr = XErrors

    fun xidToString (XProtTypes.XID n) = Word.toString n

    fun reqCodeToString (0w1 : Word8.word) = "CreateWindow"
      | reqCodeToString 0w2 = "ChangeWindowAttributes"
      | reqCodeToString 0w3 = "GetWindowAttributes"
      | reqCodeToString 0w4 = "DestroyWindow"
      | reqCodeToString 0w5 = "DestroySubwindows"
      | reqCodeToString 0w6 = "ChangeSaveSet"
      | reqCodeToString 0w7 = "ReparentWindow"
      | reqCodeToString 0w8 = "MapWindow"
      | reqCodeToString 0w9 = "MapSubwindows"
      | reqCodeToString 0w10 = "UnmapWindow"
      | reqCodeToString 0w11 = "UnmapSubwindows"
      | reqCodeToString 0w12 = "ConfigureWindow"
      | reqCodeToString 0w13 = "CirculateWindow"
      | reqCodeToString 0w14 = "GetGeometry"
      | reqCodeToString 0w15 = "QueryTree"
      | reqCodeToString 0w16 = "InternAtom"
      | reqCodeToString 0w17 = "GetAtomName"
      | reqCodeToString 0w18 = "ChangeProperty"
      | reqCodeToString 0w19 = "DeleteProperty"
      | reqCodeToString 0w20 = "GetProperty"
      | reqCodeToString 0w21 = "ListProperties"
      | reqCodeToString 0w22 = "SetSelectionOwner"
      | reqCodeToString 0w23 = "GetSelectionOwner"
      | reqCodeToString 0w24 = "ConvertSelection"
      | reqCodeToString 0w25 = "SendEvent"
      | reqCodeToString 0w26 = "GrabPointer"
      | reqCodeToString 0w27 = "UngrabPointer"
      | reqCodeToString 0w28 = "GrabButton"
      | reqCodeToString 0w29 = "UngrabButton"
      | reqCodeToString 0w30 = "ChangeActivePointerGrab"
      | reqCodeToString 0w31 = "GrabKeyboard"
      | reqCodeToString 0w32 = "UngrabKeyboard"
      | reqCodeToString 0w33 = "GrabKey"
      | reqCodeToString 0w34 = "UngrabKey"
      | reqCodeToString 0w35 = "AllowEvents"
      | reqCodeToString 0w36 = "GrabServer"
      | reqCodeToString 0w37 = "UngrabServer"
      | reqCodeToString 0w38 = "QueryPointer"
      | reqCodeToString 0w39 = "GetMotionEvents"
      | reqCodeToString 0w40 = "TranslateCoords"
      | reqCodeToString 0w41 = "WarpPointer"
      | reqCodeToString 0w42 = "SetInputFocus"
      | reqCodeToString 0w43 = "GetInputFocus"
      | reqCodeToString 0w44 = "QueryKeymap"
      | reqCodeToString 0w45 = "OpenFont"
      | reqCodeToString 0w46 = "CloseFont"
      | reqCodeToString 0w47 = "QueryFont"
      | reqCodeToString 0w48 = "QueryTextExtents"
      | reqCodeToString 0w49 = "ListFonts"
      | reqCodeToString 0w50 = "ListFontsWithInfo"
      | reqCodeToString 0w51 = "SetFontPath"
      | reqCodeToString 0w52 = "GetFontPath"
      | reqCodeToString 0w53 = "CreatePixmap"
      | reqCodeToString 0w54 = "FreePixmap"
      | reqCodeToString 0w55 = "CreateGC"
      | reqCodeToString 0w56 = "ChangeGC"
      | reqCodeToString 0w57 = "CopyGC"
      | reqCodeToString 0w58 = "SetDashes"
      | reqCodeToString 0w59 = "SetClipRectangles"
      | reqCodeToString 0w60 = "FreeGC"
      | reqCodeToString 0w61 = "ClearArea"
      | reqCodeToString 0w62 = "CopyArea"
      | reqCodeToString 0w63 = "CopyPlane"
      | reqCodeToString 0w64 = "PolyPoint "
      | reqCodeToString 0w65 = "PolyLine"
      | reqCodeToString 0w66 = "PolySegment"
      | reqCodeToString 0w67 = "PolyRectangle"
      | reqCodeToString 0w68 = "PolyArc"
      | reqCodeToString 0w69 = "FillPoly"
      | reqCodeToString 0w70 = "PolyFillRectangle"
      | reqCodeToString 0w71 = "PolyFillArc"
      | reqCodeToString 0w72 = "PutImage"
      | reqCodeToString 0w73 = "GetImage"
      | reqCodeToString 0w74 = "PolyText8"
      | reqCodeToString 0w75 = "PolyText16"
      | reqCodeToString 0w76 = "ImageText8"
      | reqCodeToString 0w77 = "ImageText16"
      | reqCodeToString 0w78 = "CreateColormap"
      | reqCodeToString 0w79 = "FreeColormap"
      | reqCodeToString 0w80 = "CopyColormapAndFree"
      | reqCodeToString 0w81 = "InstallColormap"
      | reqCodeToString 0w82 = "UninstallColormap"
      | reqCodeToString 0w83 = "ListInstalledColormaps"
      | reqCodeToString 0w84 = "AllocColor"
      | reqCodeToString 0w85 = "AllocNamedColor"
      | reqCodeToString 0w86 = "AllocColorCells"
      | reqCodeToString 0w87 = "AllocColorPlanes"
      | reqCodeToString 0w88 = "FreeColors"
      | reqCodeToString 0w89 = "StoreColors"
      | reqCodeToString 0w90 = "StoreNamedColor"
      | reqCodeToString 0w91 = "QueryColors"
      | reqCodeToString 0w92 = "LookupColor"
      | reqCodeToString 0w93 = "CreateCursor"
      | reqCodeToString 0w94 = "CreateGlyphCursor"
      | reqCodeToString 0w95 = "FreeCursor"
      | reqCodeToString 0w96 = "RecolorCursor"
      | reqCodeToString 0w97 = "QueryBestSize"
      | reqCodeToString 0w98 = "QueryExtension"
      | reqCodeToString 0w99 = "ListExtensions"
      | reqCodeToString 0w100 = "ChangeKeyboardMapping"
      | reqCodeToString 0w101 = "GetKeyboardMapping"
      | reqCodeToString 0w102 = "ChangeKeyboardControl"
      | reqCodeToString 0w103 = "GetKeyboardControl"
      | reqCodeToString 0w104 = "Bell"
      | reqCodeToString 0w105 = "ChangePointerControl"
      | reqCodeToString 0w106 = "GetPointerControl"
      | reqCodeToString 0w107 = "SetScreenSaver"
      | reqCodeToString 0w108 = "GetScreenSaver"
      | reqCodeToString 0w109 = "ChangeHosts"
      | reqCodeToString 0w110 = "ListHosts"
      | reqCodeToString 0w111 = "SetAccessControl"
      | reqCodeToString 0w112 = "SetCloseDownMode"
      | reqCodeToString 0w113 = "KillClient"
      | reqCodeToString 0w114 = "RotateProperties"
      | reqCodeToString 0w115 = "ForceScreenSaver"
      | reqCodeToString 0w116 = "SetPointerMapping"
      | reqCodeToString 0w117 = "GetPointerMapping"
      | reqCodeToString 0w118 = "SetModifierMapping"
      | reqCodeToString 0w119 = "GetModifierMapping"
      | reqCodeToString 0w127 = "NoOperation"
      | reqCodeToString w = String.concat["CODE=", Word8.toString w]

    fun xerrorKind XErr.BadRequest = "BadRequest"
      | xerrorKind (XErr.BadValue v) = ("BadValue " ^ v)
      | xerrorKind (XErr.BadWindow xid) = ("BadWindow " ^ xidToString xid)
      | xerrorKind (XErr.BadPixmap xid) = ("BadPixmap " ^ xidToString xid)
      | xerrorKind (XErr.BadAtom xid) = ("BadAtom " ^ xidToString xid)
      | xerrorKind (XErr.BadCursor xid) = ("BadCursor " ^ xidToString xid)
      | xerrorKind (XErr.BadFont xid) = ("BadFont " ^ xidToString xid)
      | xerrorKind XErr.BadMatch = "BadMatch"
      | xerrorKind (XErr.BadDrawable xid) = ("BadDrawable " ^ xidToString xid)
      | xerrorKind XErr.BadAccess = "BadAccess"
      | xerrorKind XErr.BadAlloc = "BadAlloc"
      | xerrorKind (XErr.BadColor xid) = ("BadColor " ^ xidToString xid)
      | xerrorKind (XErr.BadGC xid) = ("BadGC " ^ xidToString xid)
      | xerrorKind (XErr.BadIDChoice xid) = ("BadIDChoice " ^ xidToString xid)
      | xerrorKind XErr.BadName = "BadName"
      | xerrorKind XErr.BadLength = "BadLength"
      | xerrorKind XErr.BadImplementation = "BadImplementation"

    fun xerrorToString (XErr.XErr{kind, major_op, minor_op}) = String.concat [
	     "<<", xerrorKind kind,
	     ", major = ", reqCodeToString major_op,
	      ", minor = ", Word.toString minor_op, ">>"
	    ]

    fun xevtName (XEvt.KeyPressXEvt _) = "KeyPress"
      | xevtName (XEvt.KeyReleaseXEvt _) = "KeyRelease"
      | xevtName (XEvt.ButtonPressXEvt _) = "ButtonPress"
      | xevtName (XEvt.ButtonReleaseXEvt _) = "ButtonRelease"
      | xevtName (XEvt.MotionNotifyXEvt _) = "MotionNotify"
      | xevtName (XEvt.EnterNotifyXEvt _) = "EnterNotify"
      | xevtName (XEvt.LeaveNotifyXEvt _) = "LeaveNotify"
      | xevtName (XEvt.FocusInXEvt _) = "FocusIn"
      | xevtName (XEvt.FocusOutXEvt _) = "FocusOut"
      | xevtName (XEvt.KeymapNotifyXEvt _) = "KeymapNotify"
      | xevtName (XEvt.ExposeXEvt _) = "Expose"
      | xevtName (XEvt.GraphicsExposeXEvt _) = "GraphicsExpose"
      | xevtName (XEvt.NoExposeXEvt _) = "NoExpose"
      | xevtName (XEvt.VisibilityNotifyXEvt _) = "VisibilityNotify"
      | xevtName (XEvt.CreateNotifyXEvt _) = "CreateNotify"
      | xevtName (XEvt.DestroyNotifyXEvt _) = "DestroyNotify"
      | xevtName (XEvt.UnmapNotifyXEvt _) = "UnmapNotify"
      | xevtName (XEvt.MapNotifyXEvt _) = "MapNotify"
      | xevtName (XEvt.MapRequestXEvt _) = "MapRequest"
      | xevtName (XEvt.ReparentNotifyXEvt _) = "ReparentNotify"
      | xevtName (XEvt.ConfigureNotifyXEvt _) = "ConfigureNotify"
      | xevtName (XEvt.ConfigureRequestXEvt _) = "ConfigureRequest"
      | xevtName (XEvt.GravityNotifyXEvt _) = "GravityNotify"
      | xevtName (XEvt.ResizeRequestXEvt _) = "ResizeRequest"
      | xevtName (XEvt.CirculateNotifyXEvt _) = "CirculateNotify"
      | xevtName (XEvt.CirculateRequestXEvt _) = "CirculateRequest"
      | xevtName (XEvt.PropertyNotifyXEvt _) = "PropertyNotify"
      | xevtName (XEvt.SelectionClearXEvt _) = "SelectionClear"
      | xevtName (XEvt.SelectionRequestXEvt _) = "SelectionRequest"
      | xevtName (XEvt.SelectionNotifyXEvt _) = "SelectionNotify"
      | xevtName (XEvt.ColormapNotifyXEvt _) = "ColormapNotify"
      | xevtName (XEvt.ClientMessageXEvt _) = "ClientMessage"
      | xevtName (XEvt.ModifierMappingNotifyXEvt ) = "ModifierMappingNotify"
      | xevtName (XEvt.KeyboardMappingNotifyXEvt _) = "KeyboardMappingNotify"
      | xevtName (XEvt.PointerMappingNotifyXEvt ) = "PointerMappingNotify"

  end (* XPrint *)
