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/iccc/xprops.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/iccc/xprops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 2 (* xprops.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     *
5 :     * Support for the standard X properties and types as defined in
6 :     * version 1.0 of the ICCCM. These routines can be used to build
7 :     * various property values (including the standard ones).
8 :     *)
9 :    
10 :     structure XProps : sig
11 :    
12 :     (* Hints about the window size *)
13 :     datatype size_hints
14 :     = HINT_USPosition
15 :     | HINT_PPosition
16 :     | HINT_USSize
17 :     | HINT_PSize
18 :     | HINT_PMinSize of Geometry.size
19 :     | HINT_PMaxSize of Geometry.size
20 :     | HINT_PResizeInc of Geometry.size
21 :     | HINT_PAspect of { min : (int * int), max : (int * int) }
22 :     | HINT_PBaseSize of Geometry.size
23 :     | HINT_PWinGravity of XProtTypes.gravity
24 :    
25 :     (* Window manager hints *)
26 :     datatype wm_hints
27 :     = HINT_Input of bool (* does this application rely on the *)
28 :     (* window manager to get keyboard input? *)
29 :     (* Initial window state (choose one) *)
30 :     | HINT_WithdrawnState (* for windows that are not mapped *)
31 :     | HINT_NormalState (* most applications want to start *)
32 :     (* this way *)
33 :     | HINT_IconicState (* application wants to start as an *)
34 :     (* icon *)
35 :     | HINT_IconTile of DrawTypes.tile (* tile to be used as icon *)
36 :     | HINT_IconPixmap of DrawTypes.pixmap (* pixmap to be used as icon *)
37 :     | HINT_IconWindow of DrawTypes.window (* window to be used as icon *)
38 :     | HINT_IconMask of DrawTypes.pixmap (* icon mask bitmap *)
39 :     | HINT_IconPosition of Geometry.point (* initial position of icon *)
40 :     | HINT_WindowGroup of DrawTypes.window(* the group leader *)
41 :    
42 :     val makeStringProp : string -> XProtTypes.prop_val
43 :     (* Build a property value of type STRING *)
44 :    
45 :     val makeAtomProp : XProtTypes.atom -> XProtTypes.prop_val
46 :     (* Build a property value of type ATOM *)
47 :    
48 :     val makeWMSizeHints : size_hints list -> XProtTypes.prop_val
49 :     val makeWMHints : wm_hints list -> XProtTypes.prop_val
50 :    
51 :     val makeCommandHints : string list -> XProtTypes.prop_val
52 :     (* Build a command-line argument property *)
53 :    
54 :     val makeTransientHint : DrawTypes.window -> XProtTypes.prop_val
55 :    
56 :     end = struct
57 :    
58 :     structure G = Geometry
59 :     structure XA = XAtoms
60 :     structure A = StdAtoms
61 :     structure XTy = XProtTypes
62 :     structure D = DrawTypes
63 :    
64 :     structure W8V = Word8Vector
65 :    
66 :     val ++ = Word.orb
67 :     infix ++
68 :    
69 :     fun wordToVec x = let
70 :     val w = Word.toLargeWord x
71 :     fun get8 n = Word8.fromLargeWord(LargeWord.>>(w, n))
72 :     in
73 :     W8V.fromList [get8 0w24, get8 0w16, get8 0w8, get8 0w0]
74 :     end
75 :    
76 :     (* convert an array of words to a Word8Vector.vector. *)
77 :     fun arrToVec arr = let
78 :     fun f (0, l) = W8V.fromList l
79 :     | f (i, l) = let
80 :     val i = i-1
81 :     val w = Word.toLargeWord(Array.sub(arr, i))
82 :     fun get8 n = Word8.fromLargeWord(LargeWord.>>(w, n))
83 :     val b0 = get8 0w0
84 :     val b1 = get8 0w8
85 :     val b2 = get8 0w16
86 :     val b3 = get8 0w24
87 :     in
88 :     f (i, b3::b2::b1::b0::l)
89 :     end
90 :     in
91 :     f (Array.length arr, [])
92 :     end
93 :    
94 :     (* map a list of hints to a word array, with position 0 containing
95 :     * the field mask, and the other positions containing the field values.
96 :     *)
97 :     fun mkHintData (sz, putHint) lst = let
98 :     val data = Array.array(sz, 0w0)
99 :     val put1 = putHint (fn (i, x) => Array.update(data, i, x))
100 :     fun put ([], m) = m
101 :     | put (x::r, m) = put(r, put1(x, m))
102 :     val mask = put (lst, 0w0)
103 :     in
104 :     Array.update(data, 0, mask);
105 :     arrToVec data
106 :     end
107 :    
108 :     (* Hints about the window size *)
109 :     datatype size_hints
110 :     = HINT_USPosition
111 :     | HINT_PPosition
112 :     | HINT_USSize
113 :     | HINT_PSize
114 :     | HINT_PMinSize of G.size
115 :     | HINT_PMaxSize of G.size
116 :     | HINT_PResizeInc of G.size
117 :     | HINT_PAspect of { min : (int * int), max : (int * int) }
118 :     | HINT_PBaseSize of G.size
119 :     | HINT_PWinGravity of XTy.gravity
120 :    
121 :     (* Window manager hints *)
122 :     datatype wm_hints
123 :     = HINT_Input of bool (* does this application rely on the window *)
124 :     (* manager to get keyboard input? *)
125 :     (* Initial window state (choose one) *)
126 :     | HINT_WithdrawnState (* for windows that are not mapped *)
127 :     | HINT_NormalState (* most applications want to start this way *)
128 :     | HINT_IconicState (* application wants to start as an icon *)
129 :     | HINT_IconTile of D.tile (* tile to be used as icon *)
130 :     | HINT_IconPixmap of D.pixmap (* pixmap to be used as icon *)
131 :     | HINT_IconWindow of D.window (* window to be used as icon *)
132 :     | HINT_IconMask of D.pixmap (* icon mask bitmap *)
133 :     | HINT_IconPosition of G.point (* initial position of icon *)
134 :     | HINT_WindowGroup of D.window (* the group leader *)
135 :    
136 :     (* Build a property value of type STRING *)
137 :     fun makeStringProp data = XTy.PROP_VAL {
138 :     typ = A.atom_STRING,
139 :     value = XTy.RAW_DATA{format = XTy.Raw8, data = Byte.stringToBytes data}
140 :     }
141 :    
142 :     (* Build a property value of type ATOM *)
143 :     fun makeAtomProp (XTy.XAtom v) = XTy.PROP_VAL {
144 :     typ = A.atom_ATOM,
145 :     value = XTy.RAW_DATA{format = XTy.Raw32, data = wordToVec v}
146 :     }
147 :    
148 :     local
149 :     val sizeHintsData = let
150 :     fun putHint upd = let
151 :     fun putSz (i, G.SIZE{wid, ht}) = (
152 :     upd(i, Word.fromInt wid); upd(i+1, Word.fromInt ht))
153 :     fun put1 (HINT_USPosition, m) = (m ++ 0w1)
154 :     | put1 (HINT_PPosition, m) = (m ++ 0w2)
155 :     | put1 (HINT_USSize, m) = (m ++ 0w4)
156 :     | put1 (HINT_PSize, m) = (m ++ 0w8)
157 :     | put1 (HINT_PMinSize sz, m) = (putSz(5, sz); m ++ 0w16)
158 :     | put1 (HINT_PMaxSize sz, m) = (putSz(7, sz); m ++ 0w32)
159 :     | put1 (HINT_PResizeInc sz, m) = (putSz(9, sz); m ++ 0w64)
160 :     | put1 (HINT_PAspect{min=(x1, y1), max=(x2, y2)}, m) = (
161 :     upd(11, Word.fromInt x1); upd(12, Word.fromInt y1);
162 :     upd(13, Word.fromInt x2); upd(14, Word.fromInt y2);
163 :     m ++ 0w128)
164 :     | put1 (HINT_PBaseSize sz, m) = (putSz(15, sz); m ++ 0w256)
165 :     | put1 (HINT_PWinGravity g, m) = (
166 :     upd(17, XCvtFuns.gravityToWire g); m ++ 0w512)
167 :     in
168 :     put1
169 :     end
170 :     in
171 :     mkHintData (18, putHint)
172 :     end
173 :     in
174 :     fun makeWMSizeHints lst = XTy.PROP_VAL {
175 :     typ = A.atom_WM_SIZE_HINTS,
176 :     value = XTy.RAW_DATA{format = XTy.Raw32, data = sizeHintsData lst}
177 :     }
178 :     end (* local *)
179 :    
180 :     local
181 :     val wmHintsData = let
182 :     fun putHint upd (hint, m) = (case hint
183 :     of (HINT_Input true) => (upd(1, 0w1); m ++ 0w1)
184 :     | HINT_WithdrawnState => (upd(2, 0w0); m ++ 0w2)
185 :     | HINT_NormalState => (upd(2, 0w1); m ++ 0w2)
186 :     | HINT_IconicState => (upd(2, 0w3); m ++ 0w2)
187 :     | (HINT_IconTile(D.TILE(D.PM{id=XTy.XID pix, ...}))) => (
188 :     upd(3, pix); m ++ 0w4)
189 :     | (HINT_IconPixmap(D.PM{id=XTy.XID pix, ...})) => (
190 :     upd(3, pix); m ++ 0w4)
191 :     | (HINT_IconWindow(D.WIN{id=XTy.XID win, ...})) => (
192 :     upd(4, win); m ++ 0w8)
193 :     | (HINT_IconPosition(G.PT{x, y})) => (
194 :     upd(5, Word.fromInt x); upd(6, Word.fromInt y); m ++ 0w16)
195 :     | (HINT_IconMask(D.PM{id=XTy.XID pix, ...})) => (
196 :     upd(7, pix); m ++ 0w32)
197 :     | (HINT_WindowGroup(D.WIN{id=XTy.XID win, ...})) => (
198 :     upd(8, win); m ++ 0w64)
199 :     | _ => raise (MLXError.XERROR "Bad WM Hint"))
200 :     in
201 :     mkHintData (9, putHint)
202 :     end
203 :     in
204 :     fun makeWMHints lst = XTy.PROP_VAL {
205 :     typ = A.atom_WM_HINTS,
206 :     value = XTy.RAW_DATA{format = XTy.Raw32, data = wmHintsData lst}
207 :     }
208 :     end (* local *)
209 :    
210 :     (* Build a command-line argument property *)
211 :     fun makeCommandHints args =
212 :     makeStringProp (String.concat (map (fn s => s^"\000") args))
213 :    
214 :     fun makeTransientHint (D.WIN{id=XTy.XID win, ...}) = XTy.PROP_VAL {
215 :     typ = A.atom_WINDOW,
216 :     value = XTy.RAW_DATA{format = XTy.Raw32, data = wordToVec win}
217 :     }
218 :    
219 :     end (* XProps *)

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