Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/eXene/lib/protocol/xsendevt.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/protocol/xsendevt.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 704 - (view) (download)

1 : monnier 2 (* xsendevt.sml
2 :     *
3 :     * COPYRIGHT (c) 1992 by AT&T. See COPYRIGHT file for details.
4 :     *
5 :     * Functions to encode SendEvent messages.
6 :     *)
7 :    
8 :     structure XSendEvent =
9 :     struct
10 :     local
11 :     structure G = Geometry
12 :     structure XTy = XProtTypes
13 :    
14 :     structure W8A = Word8Array
15 :     structure W8V = Word8Vector
16 :    
17 :     (* we need to treat requests as arrays for initialization purposes, but
18 :     * we don't want them to be modifiable afterwords.
19 :     *)
20 :     val v2a : Word8Vector.vector -> Word8Array.array = Unsafe.cast
21 :    
22 :     val encodeSendEvent = XRequest.encodeSendEvent
23 :     val eventOffset = 12
24 :    
25 :     fun put8 (buf, i, w)= W8A.update(v2a buf, i+eventOffset, w)
26 :     fun putSigned8 (buf, i, x) = put8(buf, i, Word8.fromInt x)
27 :    
28 :     fun put16 (buf, i, x) =
29 :     Pack16Big.update(v2a buf, i div 2 + eventOffset div 2, x)
30 :     fun putSigned16 (buf, i, x) = put16(buf, i, LargeWord.fromInt x)
31 :    
32 :     fun put32 (buf, i, x) =
33 :     Pack32Big.update(v2a buf, i div 4 + eventOffset div 4, x)
34 :     fun putWord32 (buf, i, x) = put32(buf, i, Word.toLargeWord x)
35 :     fun putSigned32 (buf, i, x) = put32(buf, i, LargeWord.fromInt x)
36 :    
37 :     fun putBool (buf, i, false) = put8 (buf, i, 0w0)
38 :     | putBool (buf, i, true) = put8 (buf, i, 0w1)
39 :    
40 :     fun putXId (buf, i, XTy.XID n) = putWord32 (buf, i, n)
41 :     fun putXIdOption (buf, i, NONE) = putWord32 (buf, i, 0w0)
42 :     | putXIdOption (buf, i, SOME(XTy.XID n)) = putWord32 (buf, i, n)
43 :    
44 :     fun putAtom (buf, i, XTy.XAtom n) = putWord32 (buf, i, n)
45 :     fun putAtomOption (buf, i, NONE) = putWord32 (buf, i, 0w0)
46 :     | putAtomOption (buf, i, SOME(XTy.XAtom n)) = putWord32 (buf, i, n)
47 :    
48 :     fun putTS (buf, i, XTy.CurrentTime) = put32(buf, i, 0w0)
49 :     | putTS (buf, i, XTy.TimeStamp(XTime.XT t)) = put32(buf, i, t)
50 :    
51 :     (* event codes *)
52 :     val evtKeyPressXEvt = 0w2 : Word8.word
53 :     val evtKeyReleaseXEvt = 0w3 : Word8.word
54 :     val evtButtonPressXEvt = 0w4 : Word8.word
55 :     val evtButtonReleaseXEvt = 0w5 : Word8.word
56 :     val evtdecodeMotionNotify = 0w6 : Word8.word
57 :     val evtEnterNotifyXEvt = 0w7 : Word8.word
58 :     val evtLeaveNotifyXEvt = 0w8 : Word8.word
59 :     val evtFocusInXEvt = 0w9 : Word8.word
60 :     val evtFocusOutXEvt = 0w10 : Word8.word
61 :     val evtKeymapNotify = 0w11 : Word8.word
62 :     val evtExpose = 0w12 : Word8.word
63 :     val evtGraphicsExpose = 0w13 : Word8.word
64 :     val evtNoExpose = 0w14 : Word8.word
65 :     val evtVisibilityNotify = 0w15 : Word8.word
66 :     val evtCreateNotify = 0w16 : Word8.word
67 :     val evtDestroyNotify = 0w17 : Word8.word
68 :     val evtUnmapNotify = 0w18 : Word8.word
69 :     val evtMapNotify = 0w19 : Word8.word
70 :     val evtMapRequest = 0w20 : Word8.word
71 :     val evtReparentNotify = 0w21 : Word8.word
72 :     val evtConfigureNotify = 0w22 : Word8.word
73 :     val evtConfigureRequest = 0w23 : Word8.word
74 :     val evtGravityNotify = 0w24 : Word8.word
75 :     val evtResizeRequest = 0w25 : Word8.word
76 :     val evtCirculateNotify = 0w26 : Word8.word
77 :     val evtCirculateRequest = 0w27 : Word8.word
78 :     val evtPropertyNotify = 0w28 : Word8.word
79 :     val evtSelectionClear = 0w29 : Word8.word
80 :     val evtSelectionRequest = 0w30 : Word8.word
81 :     val evtSelectionNotify = 0w31 : Word8.word
82 :     val evtColormapNotify = 0w32 : Word8.word
83 :     val evtClientMessage = 0w33 : Word8.word
84 :     val evtMappingNotify = 0w34 : Word8.word
85 :    
86 :     fun putEventCode (msg, code) = put8(msg, 0, code)
87 :    
88 :     in
89 :    
90 :     fun encodeSendSelectionNotify
91 :     { dst, propagate, evt_mask, requestor, selection, target, property, time } = let
92 :     val msg = encodeSendEvent {
93 :     dst = dst, propagate = propagate, evt_mask = evt_mask
94 :     }
95 :     in
96 :     putEventCode (msg, evtSelectionNotify);
97 : jhr 704 putTS (msg, 4, time);
98 : monnier 2 putXId (msg, 8, requestor);
99 :     putAtom (msg, 12, selection);
100 :     putAtom (msg, 16, target);
101 :     putAtomOption (msg, 20, property);
102 :     msg
103 :     end
104 :    
105 :     fun encodeSendUnmapNotify
106 :     { dst, propagate, evt_mask, event, window, from_configure } = let
107 :     val msg = encodeSendEvent {
108 :     dst = dst, propagate = propagate, evt_mask = evt_mask
109 :     }
110 :     in
111 :     putEventCode (msg, evtUnmapNotify);
112 :     putXId (msg, 4, event);
113 :     putXId (msg, 8, window);
114 :     putBool (msg, 12, from_configure);
115 :     msg
116 :     end
117 :    
118 :     end (* local *)
119 :     end (* XSendEvent *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0