CVS: sml-dist/src/eXene/lib/protocol xdisplay.sml,1.4,1.5 xevttypes.sml,1.2,1.3 xreply.sml,1.5,1.6
Matthias Blume <[email protected]>
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/eXene/lib/protocol
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32471/lib/protocol
Modified Files:
xdisplay.sml xevttypes.sml xreply.sml
Log Message:
merge Kansas changes to eXene into repository
Index: xdisplay.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/eXene/lib/protocol/xdisplay.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** xdisplay.sml 2 Nov 2005 22:24:38 -0000 1.4
--- xdisplay.sml 3 Mar 2006 03:33:15 -0000 1.5
***************
*** 9,55 ****
datatype xdisplay = XDPY of {
! conn : XIo.connection, (* the connection to the server *)
! name : string, (* "host:display.scr" *)
! vendor : string, (* the name of the server's vendor *)
! default_scr : int, (* the number of the default screen *)
! screens : xscreen list, (* the screens attached to this display. *)
! pixmap_formats : XProtTypes.pixmap_format list,
! max_req_len : int,
! image_byte_order : XProtTypes.order,
! bitmap_bit_order : XProtTypes.order,
! bitmap_scanline_unit : XProtTypes.raw_format,
! bitmap_scanline_pad : XProtTypes.raw_format,
! min_keycode : XProtTypes.keycode,
! max_keycode : XProtTypes.keycode,
! nextXId : unit -> XProtTypes.xid (* resource id allocator *)
}
and xscreen = XSCR of {
! id : int, (* the number of this screen *)
! root : XProtTypes.win_id, (* the root window id of this screen *)
! cmap : XProtTypes.colormap_id, (* the default colormap *)
! white : XProtTypes.pixel, (* White and Black pixel values *)
! black : XProtTypes.pixel,
! root_input_mask : XProtTypes.event_mask,
! (* initial root input mask *)
! sz_in_pixels : Geometry.size, (* the width and height in pixels *)
! sz_in_mm : Geometry.size, (* the width and height in millimeters *)
! min_installed_cmaps : int,
! max_installed_cmaps : int,
! root_visual : XProtTypes.visual_depth,
! backing_store : XProtTypes.backing_store,
! save_unders : bool,
! visualdepths : XProtTypes.visual_depth list
}
val openXDisplay : {
! dpyName : string,
! auth : XProtTypes.authentication option
! } -> xdisplay
val closeDisplay : xdisplay -> unit
val depthOfVisual : XProtTypes.visual_depth -> int
val displayClassOfVisual : XProtTypes.visual_depth
! -> XProtTypes.display_class option
end = struct
--- 9,55 ----
datatype xdisplay = XDPY of {
! conn : XIo.connection, (* the connection to the server *)
! name : string, (* "host:display.scr" *)
! vendor : string, (* the name of the server's vendor *)
! default_scr : int, (* the number of the default screen *)
! screens : xscreen list, (* the screens attached to this display. *)
! pixmap_formats : XProtTypes.pixmap_format list,
! max_req_len : int,
! image_byte_order : XProtTypes.order,
! bitmap_bit_order : XProtTypes.order,
! bitmap_scanline_unit : XProtTypes.raw_format,
! bitmap_scanline_pad : XProtTypes.raw_format,
! min_keycode : XProtTypes.keycode,
! max_keycode : XProtTypes.keycode,
! nextXId : unit -> XProtTypes.xid (* resource id allocator *)
}
and xscreen = XSCR of {
! id : int, (* the number of this screen *)
! root : XProtTypes.win_id, (* the root window id of this screen *)
! cmap : XProtTypes.colormap_id, (* the default colormap *)
! white : XProtTypes.pixel, (* White and Black pixel values *)
! black : XProtTypes.pixel,
! root_input_mask : XProtTypes.event_mask,
! (* initial root input mask *)
! sz_in_pixels : Geometry.size, (* the width and height in pixels *)
! sz_in_mm : Geometry.size, (* the width and height in millimeters *)
! min_installed_cmaps : int,
! max_installed_cmaps : int,
! root_visual : XProtTypes.visual_depth,
! backing_store : XProtTypes.backing_store,
! save_unders : bool,
! visualdepths : XProtTypes.visual_depth list
}
val openXDisplay : {
! dpyName : string,
! auth : XProtTypes.authentication option
! } -> xdisplay
val closeDisplay : xdisplay -> unit
val depthOfVisual : XProtTypes.visual_depth -> int
val displayClassOfVisual : XProtTypes.visual_depth
! -> XProtTypes.display_class option
end = struct
***************
*** 65,99 ****
datatype xdisplay = XDPY of {
! conn : XIo.connection, (* the connection to the server *)
! name : string, (* "host:display.scr" *)
! vendor : string, (* the name of the server's vendor *)
! default_scr : int, (* the number of the default screen *)
! screens : xscreen list, (* the screens attached to this display. *)
! pixmap_formats : XTy.pixmap_format list,
! max_req_len : int,
! image_byte_order : XTy.order,
! bitmap_bit_order : XTy.order,
! bitmap_scanline_unit : XTy.raw_format,
! bitmap_scanline_pad : XTy.raw_format,
! min_keycode : XTy.keycode,
! max_keycode : XTy.keycode,
! nextXId : unit -> XTy.xid (* resource id allocator *)
}
and xscreen = XSCR of {
! id : int, (* the number of this screen *)
! root : XTy.win_id, (* the root window id of this screen *)
! cmap : XTy.colormap_id, (* the default colormap *)
! white : XTy.pixel, (* White and Black pixel values *)
! black : XTy.pixel,
! root_input_mask : XTy.event_mask, (* initial root input mask *)
! sz_in_pixels : G.size, (* the width and height in pixels *)
! sz_in_mm : G.size, (* the width and height in millimeters *)
! min_installed_cmaps : int,
! max_installed_cmaps : int,
! root_visual : XTy.visual_depth,
! backing_store : XTy.backing_store,
! save_unders : bool,
! visualdepths : XTy.visual_depth list
}
--- 65,99 ----
datatype xdisplay = XDPY of {
! conn : XIo.connection, (* the connection to the server *)
! name : string, (* "host:display.scr" *)
! vendor : string, (* the name of the server's vendor *)
! default_scr : int, (* the number of the default screen *)
! screens : xscreen list, (* the screens attached to this display. *)
! pixmap_formats : XTy.pixmap_format list,
! max_req_len : int,
! image_byte_order : XTy.order,
! bitmap_bit_order : XTy.order,
! bitmap_scanline_unit : XTy.raw_format,
! bitmap_scanline_pad : XTy.raw_format,
! min_keycode : XTy.keycode,
! max_keycode : XTy.keycode,
! nextXId : unit -> XTy.xid (* resource id allocator *)
}
and xscreen = XSCR of {
! id : int, (* the number of this screen *)
! root : XTy.win_id, (* the root window id of this screen *)
! cmap : XTy.colormap_id, (* the default colormap *)
! white : XTy.pixel, (* White and Black pixel values *)
! black : XTy.pixel,
! root_input_mask : XTy.event_mask, (* initial root input mask *)
! sz_in_pixels : G.size, (* the width and height in pixels *)
! sz_in_mm : G.size, (* the width and height in millimeters *)
! min_installed_cmaps : int,
! max_installed_cmaps : int,
! root_visual : XTy.visual_depth,
! backing_store : XTy.backing_store,
! save_unders : bool,
! visualdepths : XTy.visual_depth list
}
***************
*** 102,112 ****
*)
fun ffs 0w0 = MLXError.xerror "bogus resource mask"
! | ffs w = let
! fun lp (w, i) =
! if (Word.andb(w, 0w1) = 0w0)
! then lp(Word.>>(w, 0w1), i+0w1) else i
! in
! lp (w, 0w1)
! end
(* initialize a connection by sending a connection request *)
--- 102,112 ----
*)
fun ffs 0w0 = MLXError.xerror "bogus resource mask"
! | ffs w = let
! fun lp (w, i) =
! if (Word.andb(w, 0w1) = 0w0)
! then lp(Word.>>(w, 0w1), i+0w1) else i
! in
! lp (w, 0w1)
! end
(* initialize a connection by sending a connection request *)
***************
*** 117,130 ****
])
(*-DEBUG*)
! val connectMsg = XRequest.encodeConnectionReq {
! minorVersion = 0,
! auth = auth
! }
! val _ = SockUtil.sendVec (sock, connectMsg)
(*+DEBUG*)
val _ = XDebug.trace(XDebug.ioTM, fn () => ["reading connection reply header\n"])
(*-DEBUG*)
! val hdr = SockUtil.recvVec (sock, 8)
! val len = 4 * LargeWord.toIntX(PackWord16Big.subVec(hdr, 3))
(*+DEBUG*)
val _ = XDebug.trace(XDebug.ioTM, fn () => [
--- 117,136 ----
])
(*-DEBUG*)
! val connectMsg = XRequest.encodeConnectionReq {
! minorVersion = 0,
! auth = auth
! }
! val _ = SockUtil.sendVec (sock, connectMsg)
(*+DEBUG*)
val _ = XDebug.trace(XDebug.ioTM, fn () => ["reading connection reply header\n"])
(*-DEBUG*)
! (* ddeboer, fall 2004: error in ssh tunneling happens in following line
! modified to retry on exception *)
! fun sleep n = CML.sync(CML.timeOutEvt(Time.fromSeconds n))
! fun retry 0 ts = SockUtil.recvVec (sock,8)
! | retry n ts = SockUtil.recvVec (sock,8) handle _ => (sleep ts; (retry (n-1) (ts*2)))
! val hdr = retry 2 1
! (* original: val hdr = SockUtil.recvVec (sock,8) *)
! val len = 4 * LargeWord.toIntX(PackWord16Big.subVec(hdr, 3))
(*+DEBUG*)
val _ = XDebug.trace(XDebug.ioTM, fn () => [
***************
*** 132,279 ****
])
(*-DEBUG*)
! val reply = SockUtil.recvVec (sock, len)
! fun getMsg () = Byte.unpackStringVec(Word8VectorSlice.slice(
! reply,
! 0,
! SOME(Word8.toIntX(W8V.sub(hdr, 1)))))
! fun error msg = (Socket.close sock; MLXError.xerror msg)
! in
! case W8V.sub(hdr, 0)
! of 0w0 => error ("connection refused: " ^ getMsg())
! | 0w1 => let
! val info = XReply.decodeConnectReqReply (hdr, reply)
! val conn = XIo.openConn sock
! in
! (conn, info, name, scrNum)
! end
! | 0w2 => error "connection requires more authentication"
! | _ => error "unknown connection reply"
! (* end case *)
! end
(* Parse the address and open the appropriate kind of connection *)
fun connect (s, auth) = let
! val {addr, dpy_name, screen} = XServerAddr.getServerAddr s
! fun repeat connFn = let
! fun loop 0 = connFn()
! | loop n = (connFn() handle _ => loop(n-1))
! in
! loop 4 (* try upto five times *)
! end
! handle (OS.SysErr(s, _)) => raise (BadAddr s)
! fun inetConn (addr, port) = let
val _ = TraceCML.trace (XD.ioTM, fn () => [
"inetConn: addr = \"", NDB.toString addr, "\", port = ",
Int.toString port, "\n"
])
! val sock = INetSock.TCP.socket ()
! in
! repeat (fn () =>
! Socket.connect (sock, INetSock.toAddr(addr, port)));
! initConnection (sock, auth, dpy_name, screen)
! end
! in
! case addr
! of XServerAddr.UNIX path => let
! val sock = UnixSock.Strm.socket ()
! in
! repeat (fn () => Socket.connect (sock, UnixSock.toAddr path));
! initConnection (sock, auth, dpy_name, screen)
! end
! | XServerAddr.INET_Addr(host, port) => (
! case NDB.fromString host
! of (SOME addr) => inetConn (addr, port)
! | NONE => raise BadAddr "bad IP address format"
! (* end case *))
! | XServerAddr.INET_Hostname(host, port) => (
! case NDB.getByName host
! of (SOME entry) => inetConn (NDB.addr entry, port)
! | NONE => raise BadAddr "host not found"
! (* end case *))
! (* end case *)
! end
(* build a resource-id allocation function *)
fun mkResourceFn (base, mask) = let
! val resCh = CML.channel()
! val incr = ffs(mask)
! fun loop i = (CML.send(resCh, XTy.XID i); loop(i+incr))
! in
! (* CML.spawn (fn () => (loop base)); *)
! XDebug.xspawn ("ResourceIdAlloc", fn () => (loop base));
! fn () => (CML.recv resCh)
! end
fun mkScreen (scr_num) {
! root_win, cmap, white, black, input_masks, pixel_wid, pixel_ht,
! mm_wid, mm_ht, installed_maps = {min, max}, root_visualid,
! backing_store, save_unders, root_depth, visualdepths
! } = let
! fun getRootVisual [] = (MLXError.xerror "cannot find root visual")
! | getRootVisual ((XTy.Depth _) :: r) = getRootVisual r
! | getRootVisual ((v as XTy.VisualDepth{id, depth, ...}) :: r) =
! if ((id = root_visualid) andalso (depth = root_depth))
! then v
! else (getRootVisual r)
! in
! XSCR{
! id = scr_num,
! root = root_win,
! cmap = cmap,
! white = white,
! black = black,
! root_input_mask = input_masks,
! sz_in_pixels = G.SIZE{wid = pixel_wid, ht = pixel_ht},
! sz_in_mm = G.SIZE{wid = mm_wid, ht = mm_ht},
! min_installed_cmaps = min,
! max_installed_cmaps = max,
! root_visual = getRootVisual visualdepths,
! backing_store = backing_store,
! save_unders = save_unders,
! visualdepths = visualdepths
! }
! end (* mkScreen *)
fun mkScreens info_list = let
! fun mkS (i, []) = []
! | mkS (i, info::r) = (mkScreen i info) :: mkS(i+1, r)
! in
! mkS (0, info_list)
! end
fun openXDisplay {dpyName, auth} = let
! val (conn, info, name, scrNum) = connect (dpyName, auth)
! val _ = XShutdown.logConnection conn
! val screens = mkScreens (#roots info)
! val (dpy as (XDPY dpyrec)) = XDPY{
! conn = conn,
! name = name,
! vendor = #vendor info,
! screens = screens,
! default_scr = scrNum,
! pixmap_formats = #formats info,
! max_req_len = #max_req_len info,
! image_byte_order = #im_byte_order info,
! bitmap_bit_order = #bitmap_order info,
! bitmap_scanline_unit = #bitmap_scanline_unit info,
! bitmap_scanline_pad = #bitmap_scanline_pad info,
! min_keycode = #min_keycode info,
! max_keycode = #max_keycode info,
! nextXId = mkResourceFn (#rsrc_id_base info, #rsrc_id_mask info)
! }
! fun errHandler () = let
! val (seqn, errMsg) = XIo.readXError conn
! in
! TraceCML.trace (XD.errorTM, fn () => [
! "Error on request #", Word.fmt StringCvt.DEC seqn,
! ": ", XPrint.xerrorToString(XReply.decodeError errMsg),
! "\n"
! ]);
! errHandler ()
! end
! in
! XDebug.xspawn("errHandler", errHandler);
! dpy
! end
(* closeDisplay : xdisplay -> unit *)
--- 138,307 ----
])
(*-DEBUG*)
! (* following lines rewritten, ddeboer, Jan 2005:
! * I'm not sure that this is what is causing the problems I'm trying to fix,
! * but if the reply status (W8V.sub(hdr,0)) is Authenticate (0w2),
! * the following previous code appears to block waiting for
! * len bytes to be received into reply:
! val reply = SockUtil.recvVec (sock, len)
! fun getMsg () = Byte.unpackStringVec(Word8VectorSlice.slice(
! reply,
! 0,
! SOME(Word8.toIntX(W8V.sub(hdr, 1)))))
! fun error msg = (Socket.close sock; MLXError.xerror msg)
! in
! case W8V.sub(hdr, 0)
! of 0w0 => error ("connection refused: " ^ getMsg())
! | 0w1 => let
! val info = XReply.decodeConnectReqReply (hdr, reply)
! val conn = XIo.openConn sock
! in
! (conn, info, name, scrNum)
! end
! | 0w2 => error "connection requires more authentication"
! | _ => error "unknown connection reply" *)
! fun getReply (len) = SockUtil.recvVec (sock, len)
! fun getMsg (reply) = Byte.unpackStringVec(Word8VectorSlice.slice(
! reply,
! 0,
! SOME(Word8.toIntX(W8V.sub(hdr, 1)))))
! fun error msg = (Socket.close sock; MLXError.xerror msg)
! in
! case W8V.sub(hdr, 0)
! of 0w0 => error ("connection refused: " ^ getMsg(getReply(len)))
! | 0w1 => let
! val info = XReply.decodeConnectReqReply (hdr,getReply(len))
! val conn = XIo.openConn sock
! in
! (conn, info, name, scrNum)
! end
! | 0w2 => error "connection requires more authentication"
! | _ => error "unknown connection reply"
! (* end case *)
! end
(* Parse the address and open the appropriate kind of connection *)
fun connect (s, auth) = let
! val {addr, dpy_name, screen} = XServerAddr.getServerAddr s
! fun repeat connFn = let
! fun loop 0 = connFn()
! | loop n = (connFn() handle _ => loop(n-1))
! in
! loop 4 (* try upto five times *)
! end
! handle (OS.SysErr(s, _)) => raise (BadAddr s)
! fun inetConn (addr, port) = let
val _ = TraceCML.trace (XD.ioTM, fn () => [
"inetConn: addr = \"", NDB.toString addr, "\", port = ",
Int.toString port, "\n"
])
! val sock = INetSock.TCP.socket ()
! in
! repeat (fn () =>
! Socket.connect (sock, INetSock.toAddr(addr, port)));
! initConnection (sock, auth, dpy_name, screen)
! end
! in
! case addr
! of XServerAddr.UNIX path => let
! val sock = UnixSock.Strm.socket ()
! in
! repeat (fn () => Socket.connect (sock, UnixSock.toAddr path));
! initConnection (sock, auth, dpy_name, screen)
! end
! | XServerAddr.INET_Addr(host, port) => (
! case NDB.fromString host
! of (SOME addr) => inetConn (addr, port)
! | NONE => raise BadAddr "bad IP address format"
! (* end case *))
! | XServerAddr.INET_Hostname(host, port) => (
! case NDB.getByName host
! of (SOME entry) => inetConn (NDB.addr entry, port)
! | NONE => raise BadAddr "host not found"
! (* end case *))
! (* end case *)
! end
(* build a resource-id allocation function *)
fun mkResourceFn (base, mask) = let
! val resCh = CML.channel()
! val incr = ffs(mask)
! fun loop i = (CML.send(resCh, XTy.XID i); loop(i+incr))
! in
! (* CML.spawn (fn () => (loop base)); *)
! XDebug.xspawn ("ResourceIdAlloc", fn () => (loop base));
! fn () => (CML.recv resCh)
! end
fun mkScreen (scr_num) {
! root_win, cmap, white, black, input_masks, pixel_wid, pixel_ht,
! mm_wid, mm_ht, installed_maps = {min, max}, root_visualid,
! backing_store, save_unders, root_depth, visualdepths
! } = let
! fun getRootVisual [] = (MLXError.xerror "cannot find root visual")
! | getRootVisual ((XTy.Depth _) :: r) = getRootVisual r
! | getRootVisual ((v as XTy.VisualDepth{id, depth, ...}) :: r) =
! if ((id = root_visualid) andalso (depth = root_depth))
! then v
! else (getRootVisual r)
! in
! XSCR{
! id = scr_num,
! root = root_win,
! cmap = cmap,
! white = white,
! black = black,
! root_input_mask = input_masks,
! sz_in_pixels = G.SIZE{wid = pixel_wid, ht = pixel_ht},
! sz_in_mm = G.SIZE{wid = mm_wid, ht = mm_ht},
! min_installed_cmaps = min,
! max_installed_cmaps = max,
! root_visual = getRootVisual visualdepths,
! backing_store = backing_store,
! save_unders = save_unders,
! visualdepths = visualdepths
! }
! end (* mkScreen *)
fun mkScreens info_list = let
! fun mkS (i, []) = []
! | mkS (i, info::r) = (mkScreen i info) :: mkS(i+1, r)
! in
! mkS (0, info_list)
! end
fun openXDisplay {dpyName, auth} = let
! val (conn, info, name, scrNum) = connect (dpyName, auth)
! val _ = XShutdown.logConnection conn
! val screens = mkScreens (#roots info)
! val (dpy as (XDPY dpyrec)) = XDPY{
! conn = conn,
! name = name,
! vendor = #vendor info,
! screens = screens,
! default_scr = scrNum,
! pixmap_formats = #formats info,
! max_req_len = #max_req_len info,
! image_byte_order = #im_byte_order info,
! bitmap_bit_order = #bitmap_order info,
! bitmap_scanline_unit = #bitmap_scanline_unit info,
! bitmap_scanline_pad = #bitmap_scanline_pad info,
! min_keycode = #min_keycode info,
! max_keycode = #max_keycode info,
! nextXId = mkResourceFn (#rsrc_id_base info, #rsrc_id_mask info)
! }
! fun errHandler () = let
! val (seqn, errMsg) = XIo.readXError conn
! in
! TraceCML.trace (XD.errorTM, fn () => [
! "Error on request #", Word.fmt StringCvt.DEC seqn,
! ": ", XPrint.xerrorToString(XReply.decodeError errMsg),
! "\n"
! ]);
! errHandler ()
! end
! in
! XDebug.xspawn("errHandler", errHandler);
! dpy
! end
(* closeDisplay : xdisplay -> unit *)
***************
*** 283,288 ****
])
end;
! XIo.closeConn conn;
! XShutdown.unlogConnection conn)
fun depthOfVisual (XTy.Depth d) = d
--- 311,316 ----
])
end;
! XIo.closeConn conn;
! XShutdown.unlogConnection conn)
fun depthOfVisual (XTy.Depth d) = d
Index: xevttypes.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/eXene/lib/protocol/xevttypes.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** xevttypes.sml 1 Jun 2000 18:33:40 -0000 1.2
--- xevttypes.sml 3 Mar 2006 03:33:15 -0000 1.3
***************
*** 46,94 ****
(* The types of the information carried by some XEvents *)
! type key_xevtinfo = { (* KeyPress and KeyRelease *)
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! keycode : keycode, (* the keycode of the depressed key *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
! type button_xevtinfo = { (* ButtonPress and ButtonRelease *)
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! button : mbutton, (* the button that was pressed *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
! type inout_xevtinfo = { (* EnterNotify and LeaveNotify *)
! root : win_id, (* the root window for the pointer position *)
! event : win_id, (* the event window *)
! child : win_id option, (* the child of event containing the pointer *)
! same_screen : bool, (* *)
! root_pt : point, (* final pointer position in root coords *)
! event_pt : point, (* final pointer position in event coords *)
! mode : focus_mode, (* *)
! detail : focus_detail, (* *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! focus : bool, (* true, if event is the focus *)
! time : XTime.time
! }
! type focus_xevtinfo = { (* FocusIn and FocusOut *)
! event : win_id, (* the window that gained the focus *)
! mode : focus_mode,
! detail : focus_detail
! }
--- 46,94 ----
(* The types of the information carried by some XEvents *)
! type key_xevtinfo = { (* KeyPress and KeyRelease *)
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! keycode : keycode, (* the keycode of the depressed key *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
! type button_xevtinfo = { (* ButtonPress and ButtonRelease *)
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! button : mbutton, (* the button that was pressed *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
! type inout_xevtinfo = { (* EnterNotify and LeaveNotify *)
! root : win_id, (* the root window for the pointer position *)
! event : win_id, (* the event window *)
! child : win_id option, (* the child of event containing the pointer *)
! same_screen : bool, (* *)
! root_pt : point, (* final pointer position in root coords *)
! event_pt : point, (* final pointer position in event coords *)
! mode : focus_mode, (* *)
! detail : focus_detail, (* *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! focus : bool, (* true, if event is the focus *)
! time : XTime.time
! }
! type focus_xevtinfo = { (* FocusIn and FocusOut *)
! event : win_id, (* the window that gained the focus *)
! mode : focus_mode,
! detail : focus_detail
! }
***************
*** 100,115 ****
| ButtonReleaseXEvt of button_xevtinfo
| MotionNotifyXEvt of {
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! hint : bool, (* true, if PointerMotionHint is selected *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
| EnterNotifyXEvt of inout_xevtinfo
| LeaveNotifyXEvt of inout_xevtinfo
--- 100,115 ----
| ButtonReleaseXEvt of button_xevtinfo
| MotionNotifyXEvt of {
! root : win_id, (* the root of the source window *)
! event : win_id, (* the window in which this was generated *)
! child : win_id option, (* the child of the event window that is the *)
! (* ancestor of the source window *)
! same_screen : bool, (* *)
! root_pt : point, (* event coords in the root window *)
! event_pt : point, (* event coords in the event window *)
! hint : bool, (* true, if PointerMotionHint is selected *)
! mod_state : modkey_state, (* the modifier-key state *)
! mbut_state : mbutton_state, (* the mouse button state *)
! time : XTime.time
! }
| EnterNotifyXEvt of inout_xevtinfo
| LeaveNotifyXEvt of inout_xevtinfo
***************
*** 118,293 ****
| KeymapNotifyXEvt of {}
| ExposeXEvt of {
! window : win_id, (* the exposed window *)
! rects : rect list, (* the exposed rectangle. This is a list, so *)
! (* that multiple events can be packed *)
! count : int (* number of subsequent expose events *)
! }
| GraphicsExposeXEvt of {
! drawable : drawable_id,
! rect : rect, (* the obscured rectangle. *)
! count : int, (* the # of additional GraphicsExpose events *)
! major_opcode : word, (* the graphics operation code *)
! minor_opcode : word (* always 0 for core protocol *)
! }
| NoExposeXEvt of {
! drawable : drawable_id,
! major_opcode : word, (* the graphics operation code *)
! minor_opcode : word (* always 0 for core protocol *)
! }
| VisibilityNotifyXEvt of {
! window : win_id, (* the window with changed visibility state *)
! state : visibility (* the new visibility state *)
! }
| CreateNotifyXEvt of {
! parent : win_id, (* the created window's parent *)
! window : win_id, (* the created window *)
! rect : rect, (* the window's rectangle *)
! border_wid : int, (* the width of the border *)
! override_redirect : bool (* *)
! }
| DestroyNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id (* the destroyed window *)
! }
| UnmapNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being unmapped *)
! from_config : bool (* true, if parent was resized *)
! }
| MapNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being mapped *)
! override_redirect : bool (* *)
! }
| MapRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id (* the mapped window *)
! }
| ReparentNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! parent : win_id, (* the new parent *)
! window : win_id, (* the re-rooted window *)
! corner : point, (* the upper-left corner *)
! override_redirect : bool (* *)
! }
| ConfigureNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the reconfigured window *)
! sibling : win_id option, (* the sibling that window is above (if any) *)
! rect : rect, (* the window's rectangle *)
! border_wid : int, (* the width of the border *)
! override_redirect : bool (* *)
! }
| ConfigureRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id, (* the window to reconfigure *)
! sibling : win_id option, (* the new sibling (if any) *)
! x : int option, (* the window's rectangle *)
! y : int option,
! wid : int option,
! ht : int option,
! border_wid : int option, (* the width of the border *)
! stack_mode : stack_mode option (* the mode for stacking windows *)
! }
| GravityNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being moved *)
! corner : point (* upper-left corner of window *)
! }
| ResizeRequestXEvt of {
! window : win_id, (* the window to resize *)
! req_sz : size (* the requested new size *)
! }
| CirculateNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being circulated *)
! parent : win_id, (* the parent *)
! place : stack_pos (* the new place *)
! }
| CirculateRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id, (* the window to circulate *)
! place : stack_pos (* the place to circulate the window to *)
! }
| PropertyNotifyXEvt of {
! window : win_id, (* the window with the changed property *)
! atom : atom, (* the affected property *)
! time : XTime.time, (* when the property was changed *)
! deleted : bool (* true, if the property was deleted *)
! }
| SelectionClearXEvt of {
! owner : win_id, (* the current owner of the selection *)
! selection : atom, (* the selection *)
! time : XTime.time (* the last-change time *)
! }
| SelectionRequestXEvt of {
! owner : win_id, (* the owner of the selection *)
! selection : atom, (* the selection *)
! target : atom, (* the requested type for the selection *)
! requestor : win_id, (* the requesting window *)
! property : atom option, (* the property to store the selection in *)
! time : timestamp (* *)
! }
| SelectionNotifyXEvt of {
! requestor : win_id, (* the requestor of the selection *)
! selection : atom, (* the selection *)
! target : atom, (* the requested type of the selection *)
! property : atom option, (* the property to store the selection in *)
! time : timestamp (* *)
! }
| ColormapNotifyXEvt of {
! window : win_id, (* the affected window *)
! cmap : colormap_id option, (* the colormap *)
! new : bool, (* true, if the colormap attribute is changed *)
! installed : bool (* true, if the colormap is installed *)
! }
| ClientMessageXEvt of {
! window : win_id, (* *)
! typ : atom, (* the type of the message *)
! value : raw_data (* the message value *)
! }
! | ModifierMappingNotifyXEvt (* really a MappingNotify event *)
! | KeyboardMappingNotifyXEvt of { (* really a MappingNotify event *)
! first_keycode : keycode,
! count : int
! }
! | PointerMappingNotifyXEvt (* really a MappingNotify event *)
! fun maskOfXEvt XEVT_KeyPress = XEVTMASK(0w1 << 0w0)
! | maskOfXEvt XEVT_KeyRelease = XEVTMASK(0w1 << 0w1)
! | maskOfXEvt XEVT_ButtonPress = XEVTMASK(0w1 << 0w2)
! | maskOfXEvt XEVT_ButtonRelease = XEVTMASK(0w1 << 0w3)
! | maskOfXEvt XEVT_EnterWindow = XEVTMASK(0w1 << 0w4)
! | maskOfXEvt XEVT_LeaveWindow = XEVTMASK(0w1 << 0w5)
! | maskOfXEvt XEVT_PointerMotion = XEVTMASK(0w1 << 0w6)
! | maskOfXEvt XEVT_PointerMotionHint = XEVTMASK(0w1 << 0w7)
! | maskOfXEvt XEVT_Button1Motion = XEVTMASK(0w1 << 0w8)
! | maskOfXEvt XEVT_Button2Motion = XEVTMASK(0w1 << 0w9)
! | maskOfXEvt XEVT_Button3Motion = XEVTMASK(0w1 << 0w10)
! | maskOfXEvt XEVT_Button4Motion = XEVTMASK(0w1 << 0w11)
! | maskOfXEvt XEVT_Button5Motion = XEVTMASK(0w1 << 0w12)
! | maskOfXEvt XEVT_ButtonMotion = XEVTMASK(0w1 << 0w13)
! | maskOfXEvt XEVT_KeymapState = XEVTMASK(0w1 << 0w14)
! | maskOfXEvt XEVT_Exposure = XEVTMASK(0w1 << 0w15)
! | maskOfXEvt XEVT_VisibilityChange = XEVTMASK(0w1 << 0w16)
! | maskOfXEvt XEVT_StructureNotify = XEVTMASK(0w1 << 0w17)
! | maskOfXEvt XEVT_ResizeRedirect = XEVTMASK(0w1 << 0w18)
! | maskOfXEvt XEVT_SubstructureNotify = XEVTMASK(0w1 << 0w19)
! | maskOfXEvt XEVT_SubstructureRedirect = XEVTMASK(0w1 << 0w20)
! | maskOfXEvt XEVT_FocusChange = XEVTMASK(0w1 << 0w21)
! | maskOfXEvt XEVT_PropertyChange = XEVTMASK(0w1 << 0w22)
! | maskOfXEvt XEVT_ColormapChange = XEVTMASK(0w1 << 0w23)
! | maskOfXEvt XEVT_OwnerGrabButton = XEVTMASK(0w1 << 0w24)
fun maskOfXEvtList l = let
! fun f ([], m) = XEVTMASK m
! | f (xevt::r, m) = let
! val (XEVTMASK m') = maskOfXEvt xevt
! in
! f (r, m ++ m')
! end
! in
! f (l, 0w0)
! end
fun unionXEvtMasks (XEVTMASK m1, XEVTMASK m2) = XEVTMASK(m1 ++ m2)
--- 118,293 ----
| KeymapNotifyXEvt of {}
| ExposeXEvt of {
! window : win_id, (* the exposed window *)
! rects : rect list, (* the exposed rectangle. This is a list, so *)
! (* that multiple events can be packed *)
! count : int (* number of subsequent expose events *)
! }
| GraphicsExposeXEvt of {
! drawable : drawable_id,
! rect : rect, (* the obscured rectangle. *)
! count : int, (* the # of additional GraphicsExpose events *)
! major_opcode : word, (* the graphics operation code *)
! minor_opcode : word (* always 0 for core protocol *)
! }
| NoExposeXEvt of {
! drawable : drawable_id,
! major_opcode : word, (* the graphics operation code *)
! minor_opcode : word (* always 0 for core protocol *)
! }
| VisibilityNotifyXEvt of {
! window : win_id, (* the window with changed visibility state *)
! state : visibility (* the new visibility state *)
! }
| CreateNotifyXEvt of {
! parent : win_id, (* the created window's parent *)
! window : win_id, (* the created window *)
! rect : rect, (* the window's rectangle *)
! border_wid : int, (* the width of the border *)
! override_redirect : bool (* *)
! }
| DestroyNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id (* the destroyed window *)
! }
| UnmapNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being unmapped *)
! from_config : bool (* true, if parent was resized *)
! }
| MapNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being mapped *)
! override_redirect : bool (* *)
! }
| MapRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id (* the mapped window *)
! }
| ReparentNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! parent : win_id, (* the new parent *)
! window : win_id, (* the re-rooted window *)
! corner : point, (* the upper-left corner *)
! override_redirect : bool (* *)
! }
| ConfigureNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the reconfigured window *)
! sibling : win_id option, (* the sibling that window is above (if any) *)
! rect : rect, (* the window's rectangle *)
! border_wid : int, (* the width of the border *)
! override_redirect : bool (* *)
! }
| ConfigureRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id, (* the window to reconfigure *)
! sibling : win_id option, (* the new sibling (if any) *)
! x : int option, (* the window's rectangle *)
! y : int option,
! wid : int option,
! ht : int option,
! border_wid : int option, (* the width of the border *)
! stack_mode : stack_mode option (* the mode for stacking windows *)
! }
| GravityNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being moved *)
! corner : point (* upper-left corner of window *)
! }
| ResizeRequestXEvt of {
! window : win_id, (* the window to resize *)
! req_sz : size (* the requested new size *)
! }
| CirculateNotifyXEvt of {
! event : win_id, (* the window on which this was generated *)
! window : win_id, (* the window being circulated *)
! parent : win_id, (* the parent *)
! place : stack_pos (* the new place *)
! }
| CirculateRequestXEvt of {
! parent : win_id, (* the parent *)
! window : win_id, (* the window to circulate *)
! place : stack_pos (* the place to circulate the window to *)
! }
| PropertyNotifyXEvt of {
! window : win_id, (* the window with the changed property *)
! atom : atom, (* the affected property *)
! time : XTime.time, (* when the property was changed *)
! deleted : bool (* true, if the property was deleted *)
! }
| SelectionClearXEvt of {
! owner : win_id, (* the current owner of the selection *)
! selection : atom, (* the selection *)
! time : XTime.time (* the last-change time *)
! }
| SelectionRequestXEvt of {
! owner : win_id, (* the owner of the selection *)
! selection : atom, (* the selection *)
! target : atom, (* the requested type for the selection *)
! requestor : win_id, (* the requesting window *)
! property : atom option, (* the property to store the selection in *)
! time : timestamp (* *)
! }
| SelectionNotifyXEvt of {
! requestor : win_id, (* the requestor of the selection *)
! selection : atom, (* the selection *)
! target : atom, (* the requested type of the selection *)
! property : atom option, (* the property to store the selection in *)
! time : timestamp (* *)
! }
| ColormapNotifyXEvt of {
! window : win_id, (* the affected window *)
! cmap : colormap_id option, (* the colormap *)
! new : bool, (* true, if the colormap attribute is changed *)
! installed : bool (* true, if the colormap is installed *)
! }
| ClientMessageXEvt of {
! window : win_id, (* *)
! typ : atom, (* the type of the message *)
! value : raw_data (* the message value *)
! }
! | ModifierMappingNotifyXEvt (* really a MappingNotify event *)
! | KeyboardMappingNotifyXEvt of { (* really a MappingNotify event *)
! first_keycode : keycode,
! count : int
! }
! | PointerMappingNotifyXEvt (* really a MappingNotify event *)
! fun maskOfXEvt XEVT_KeyPress = XEVTMASK(0w1 << 0w0)
! | maskOfXEvt XEVT_KeyRelease = XEVTMASK(0w1 << 0w1)
! | maskOfXEvt XEVT_ButtonPress = XEVTMASK(0w1 << 0w2)
! | maskOfXEvt XEVT_ButtonRelease = XEVTMASK(0w1 << 0w3)
! | maskOfXEvt XEVT_EnterWindow = XEVTMASK(0w1 << 0w4)
! | maskOfXEvt XEVT_LeaveWindow = XEVTMASK(0w1 << 0w5)
! | maskOfXEvt XEVT_PointerMotion = XEVTMASK(0w1 << 0w6)
! | maskOfXEvt XEVT_PointerMotionHint = XEVTMASK(0w1 << 0w7)
! | maskOfXEvt XEVT_Button1Motion = XEVTMASK(0w1 << 0w8)
! | maskOfXEvt XEVT_Button2Motion = XEVTMASK(0w1 << 0w9)
! | maskOfXEvt XEVT_Button3Motion = XEVTMASK(0w1 << 0w10)
! | maskOfXEvt XEVT_Button4Motion = XEVTMASK(0w1 << 0w11)
! | maskOfXEvt XEVT_Button5Motion = XEVTMASK(0w1 << 0w12)
! | maskOfXEvt XEVT_ButtonMotion = XEVTMASK(0w1 << 0w13)
! | maskOfXEvt XEVT_KeymapState = XEVTMASK(0w1 << 0w14)
! | maskOfXEvt XEVT_Exposure = XEVTMASK(0w1 << 0w15)
! | maskOfXEvt XEVT_VisibilityChange = XEVTMASK(0w1 << 0w16)
! | maskOfXEvt XEVT_StructureNotify = XEVTMASK(0w1 << 0w17)
! | maskOfXEvt XEVT_ResizeRedirect = XEVTMASK(0w1 << 0w18)
! | maskOfXEvt XEVT_SubstructureNotify = XEVTMASK(0w1 << 0w19)
! | maskOfXEvt XEVT_SubstructureRedirect = XEVTMASK(0w1 << 0w20)
! | maskOfXEvt XEVT_FocusChange = XEVTMASK(0w1 << 0w21)
! | maskOfXEvt XEVT_PropertyChange = XEVTMASK(0w1 << 0w22)
! | maskOfXEvt XEVT_ColormapChange = XEVTMASK(0w1 << 0w23)
! | maskOfXEvt XEVT_OwnerGrabButton = XEVTMASK(0w1 << 0w24)
fun maskOfXEvtList l = let
! fun f ([], m) = XEVTMASK m
! | f (xevt::r, m) = let
! val (XEVTMASK m') = maskOfXEvt xevt
! in
! f (r, m ++ m')
! end
! in
! f (l, 0w0)
! end
fun unionXEvtMasks (XEVTMASK m1, XEVTMASK m2) = XEVTMASK(m1 ++ m2)
Index: xreply.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/eXene/lib/protocol/xreply.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** xreply.sml 2 Nov 2005 22:24:38 -0000 1.5
--- xreply.sml 3 Mar 2006 03:33:15 -0000 1.6
***************
*** 32,41 ****
fun pad n = (case Word.andb(Word.fromInt n, 0w3)
! of 0w0 => n
! | r => (n + (4 - Word.toIntX r))
! (* end case *))
fun getString (bv, i, n) =
! Byte.unpackStringVec (Word8VectorSlice.slice (bv, i, SOME n))
val get8 = W8.toLargeWord o W8V.sub
[...1828 lines suppressed...]
! (* end case *))
in
val decodeSetModifierMappingReply = getSetMappingReply
***************
*** 988,994 ****
fun decodeTranslateCoordsReply msg = {
! child = getXIdOption(msg, 8),
! dst_pt = getPt(msg, 12)
! }
end (* local open XTypes *)
--- 989,995 ----
fun decodeTranslateCoordsReply msg = {
! child = getXIdOption(msg, 8),
! dst_pt = getPt(msg, 12)
! }
end (* local open XTypes *)
-------------------------------------------------------
This SF.Net email is sponsored by xPML, a groundbreaking scripting language
that extends applications into web and mobile media. Attend the live webcast
and join the prime developer group breaking into this new coding territory!
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=110944&bid=241720&dat=121642