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/widgets/text/str-edit.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/widgets/text/str-edit.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* str-edit.sml
2 :     *
3 :     * COPYRIGHT (c) 1991 by AT&T Bell Laboratories See COPYRIGHT file for details.
4 :     *
5 :     * String edit widget.
6 :     *)
7 :    
8 :     signature STREDIT =
9 :     sig
10 :    
11 :     structure W : WIDGET
12 :    
13 :     type str_edit
14 :    
15 :     val mkStrEdit : W.root -> {
16 :     foregrnd : W.EXB.color option,
17 :     backgrnd : W.EXB.color option,
18 :     initval : string,
19 :     minlen : int
20 :     } -> str_edit
21 :    
22 :     val setString : str_edit -> string -> unit
23 :     val getString : str_edit -> string
24 :     val shiftWin : str_edit -> int -> unit
25 :     val widgetOf : str_edit -> W.widget
26 :    
27 :     end (* STREDIT *)
28 :    
29 :     structure StrEdit : STREDIT =
30 :     struct
31 :    
32 :     structure EXB = EXeneBase
33 :     structure W = Widget
34 :    
35 :     open CML Geometry EXeneWin Interact Drawing
36 :    
37 :     val min = Int.min
38 :     val max = Int.max
39 :    
40 :     datatype rqst
41 :     = GetString
42 :     | GetBounds
43 :     | SetString of string
44 :     | ShiftWin of int
45 :     | DoRealize of {
46 :     env : Interact.in_env,
47 :     win : EXB.window,
48 :     sz : size
49 :     }
50 :     datatype reply
51 :     = Bnds of W.bounds
52 :     | Str of string
53 :    
54 :     datatype input
55 :     = MoveC of int
56 :     | Insert of char
57 :     | Erase
58 :     | Kill
59 :    
60 :     fun keyP (k, inputc) = let
61 :     val lookup = lookupString defaultTranslation
62 :     fun isErase c = (c = #"\^H")
63 :     fun isKill c = (c = #"\^X")
64 :    
65 :     fun doChars s = let
66 :     val slen = size s
67 :     fun doChar i =
68 :     if i = slen then ()
69 :     else let
70 :     val c = String.sub(s,i)
71 :     in
72 :     (* NOTE: 0xa0 = (ord #" " + 128) *)
73 :     if ((c >= #" ") andalso ((c <= #"~") orelse (Char.ord c >= 0xa0)))
74 :     then (send (inputc, Insert c); doChar (i+1))
75 :     else if isErase c
76 :     then (send (inputc, Erase); doChar (i+1))
77 :     else if isKill c
78 :     then (send (inputc, Kill); doChar (i+1))
79 :     else doChar(i+1)
80 :     end
81 :     in
82 :     doChar 0
83 :     end
84 :    
85 :     fun loop () =
86 :     case msgBodyOf (sync k) of
87 :     KEY_Press key => (
88 :     doChars (lookup key) handle KeysymNotFound => ();
89 :     loop ()
90 :     )
91 :     | _ => loop ()
92 :     in
93 :     loop ()
94 :     end
95 :    
96 :     fun mseP (m, mchan, pttopos) = let
97 :     val waitUp = whileMouseState mbutSomeSet
98 :     val mevt = wrap (m, fn evt => msgBodyOf evt)
99 :    
100 :     fun loop () =
101 :     case msgBodyOf (sync m) of
102 :     MOUSE_FirstDown {pt,but,...} => (
103 :     send (mchan, MoveC (pttopos pt));
104 :     waitUp (mkButState [but], mevt);
105 :     loop ()
106 :     )
107 :     | _ => loop ()
108 :     in
109 :     loop ()
110 :     end
111 :    
112 :     val dfltMinchars = 4
113 :    
114 :     datatype str_edit = StrEdit of (W.widget * rqst chan * reply chan)
115 :    
116 :     fun mkStrEdit root {
117 :     foregrnd : color option,
118 :     backgrnd : color option,
119 :     initval : string,
120 :     minlen : int
121 :     } =
122 :     let
123 :    
124 :     val minchars = max(minlen, dfltMinchars)
125 :     val (bndf, pttopos, realize) = TxtWin.mkTxtWin root (foregrnd, backgrnd)
126 :     val reqChan = channel () and repChan = channel ()
127 :     val inputc = channel ()
128 :     val SIZE{wid=minlen,...} = bndf minchars
129 :    
130 :     fun getbnds slen = let
131 :     val SIZE{wid,ht} = bndf (max(minchars,slen))
132 :     val x_dim = W.DIM{base=0, incr=1, min=minlen, nat=wid, max=NONE}
133 :     in
134 :     {x_dim=x_dim, y_dim= W.fixDim ht}
135 :     end
136 :    
137 :     fun initOff (slen, winlen) =
138 :     if slen <= winlen then 0
139 :     else slen - (winlen div 2)
140 :    
141 :     fun realizeStrEdit {env=InEnv{m,k,ci,co}, win, sz} initStr = let
142 :     val my_win = win
143 :     val {set_size, set_cur_pos, set_cursor,
144 :     insert, reset, deletec} = realize (my_win, sz)
145 :    
146 :     fun main winLen me = let
147 :    
148 :     fun isCurVisible (_,pos,woff) =
149 :     (woff <= pos) andalso (pos <= woff+winLen)
150 :    
151 :     fun redraw (me as (str,pos,woff)) = (
152 :     reset ();
153 :     insert (ExtStr.es_subs(str,woff,winLen));
154 :     if isCurVisible me then (
155 :     set_cur_pos (pos - woff);
156 :     set_cursor true
157 :     )
158 :     else ()
159 :     )
160 :    
161 :     fun rightShift (v, me as (str,pos,woff)) =
162 :     if v = 0 then me
163 :     else let
164 :     val me' = (str, pos, woff + v)
165 :     in
166 :     if v = 1 then (
167 :     set_cursor false;
168 :     set_cur_pos 1;
169 :     deletec (ExtStr.es_subs(str,woff+winLen,1) handle ExtStr.BadIndex _ => "");
170 :     if isCurVisible me' then (
171 :     set_cur_pos (pos - woff - 1);
172 :     set_cursor true
173 :     )
174 :     else ()
175 :     )
176 :     else redraw me';
177 :     me'
178 :     end
179 :    
180 :     fun leftShift (v, me as (str,pos,woff)) =
181 :     if v = 0 then me
182 :     else let
183 :     val me' = (str, pos, woff - v)
184 :     in
185 :     if v = 1 then (
186 :     set_cursor false;
187 :     set_cur_pos 0;
188 :     insert (ExtStr.es_subs(str,woff-1,1));
189 :     if isCurVisible me' then (
190 :     set_cur_pos (pos - woff + 1);
191 :     set_cursor true
192 :     )
193 :     else ()
194 :     )
195 :     else redraw me';
196 :     me'
197 :     end
198 :    
199 :     fun shiftWin (v, me as (str,_,woff)) =
200 :     if v <= 0 then (
201 :     if woff = 0 then W.ringBell root 0 else ();
202 :     leftShift (min(~v,woff),me)
203 :     )
204 :     else rightShift (min(v,(ExtStr.es_len str)-woff), me)
205 :    
206 :     fun mkCurVis (me as (str, pos, woff)) =
207 :     if isCurVisible me then me
208 :     else if pos < woff then
209 :     leftShift (woff-max(0,pos - (winLen div 2)),me)
210 :     else
211 :     rightShift (pos - (winLen div 2) - woff,me)
212 :    
213 :     fun insertc (c, me as (str, pos, woff)) =
214 :     if pos - woff = winLen then
215 :     let
216 :     val woff' = max(pos-1,pos+1-winLen)
217 :     val me' = (ExtStr.es_ins (str,pos,c),pos+1,woff')
218 :     in
219 :     if ExtStr.es_len str = winLen then sync(co CO_ResizeReq) else ();
220 :     redraw me';
221 :     me'
222 :     end
223 :     else (
224 :     if ExtStr.es_len str = winLen then sync(co CO_ResizeReq) else ();
225 :     insert (String.str c);
226 :     (ExtStr.es_ins (str, pos, c), pos+1,woff)
227 :     )
228 :    
229 :     fun erasec (me as (str, pos, woff)) =
230 :     if pos = 0 then (
231 :     W.ringBell root 0;
232 :     me
233 :     )
234 :     else if pos = woff andalso woff > 0 then
235 :     let
236 :     val woff' = max(0,pos+1-winLen)
237 :     val me' = (ExtStr.es_del (str,pos),pos-1,woff')
238 :     in
239 :     if ExtStr.es_len str > winLen then sync(co CO_ResizeReq) else ();
240 :     redraw me';
241 :     me'
242 :     end
243 :     else (
244 :     if (ExtStr.es_len str <= (winLen+3)) andalso (winLen < ExtStr.es_len str) then
245 :     sync(co CO_ResizeReq)
246 :     else ();
247 :     deletec (ExtStr.es_subs(str,woff+winLen,1) handle ExtStr.BadIndex _ => "");
248 :     (ExtStr.es_del(str,pos),pos-1,woff)
249 :     )
250 :    
251 :     fun kill (str,_,_) = let
252 :     val me' = (ExtStr.mkExtStr "", 0, 0)
253 :     in
254 :     if ExtStr.es_len str > winLen then sync(co CO_ResizeReq) else ();
255 :     redraw me';
256 :     me'
257 :     end
258 :    
259 :     fun handleInput (MoveC p,(str,pos,woff)) =
260 :     let
261 :     val pos' = min(ExtStr.es_len str,woff+p)
262 :     in
263 :     if pos <> pos' then (
264 :     set_cur_pos (pos' - woff);
265 :     set_cursor true
266 :     )
267 :     else ();
268 :     (str,pos',woff)
269 :     end
270 :     | handleInput (Insert c, me) = insertc(c, mkCurVis me)
271 :     | handleInput (Erase, me) = erasec (mkCurVis me)
272 :     | handleInput (Kill, me) = kill me
273 :    
274 :     fun handleCI (CI_Resize (RECT{wid,ht,...}), (str,pos,_)) =
275 :     initMain (SIZE{wid=wid,ht=ht},str,pos)
276 :     | handleCI (CI_Redraw _, me) = (redraw me; me)
277 :     | handleCI (_,me) = me
278 :    
279 :     fun handleReq (GetString,me as (str,_,_)) =
280 :     (send(repChan, Str (ExtStr.es_gets str));me)
281 :     | handleReq (ShiftWin arg,me as (str,_,_)) =
282 :     shiftWin (arg, me)
283 :     | handleReq (GetBounds,me as (str,_,_)) =
284 :     (send(repChan, Bnds (getbnds (ExtStr.es_len str)));me)
285 :     | handleReq (SetString s,_) =
286 :     let
287 :     val slen = size s
288 :     val me' = (ExtStr.mkExtStr s, slen, initOff(slen, winLen))
289 :     in
290 :     sync(co CO_ResizeReq);
291 :     redraw me';
292 :     me'
293 :     end
294 :     | handleReq (DoRealize _,me) = me
295 :    
296 :     fun loop me =
297 :     loop (select [
298 :     wrap (ci, fn evt => handleCI (msgBodyOf evt,me)),
299 :     wrap (recvEvt reqChan, fn evt => handleReq (evt,me)),
300 :     wrap (recvEvt inputc, fn evt => handleInput (evt,me))
301 :     ])
302 :    
303 :     in
304 :     loop me
305 :     end
306 :    
307 :     and initMain (sz,str,pos) = let
308 :     val winlen = set_size sz
309 :     in
310 :     main winlen (str, pos, initOff(pos,winlen))
311 :     end
312 :    
313 :     in
314 :     spawn (fn () => mseP (m, inputc, pttopos));
315 :     spawn (fn () => keyP (k, inputc));
316 :     initMain (sz, ExtStr.mkExtStr initStr, size initStr)
317 :     end
318 :    
319 :     fun initLoop str =
320 :     case recv reqChan of
321 :     GetString => (send(repChan, Str str); initLoop str)
322 :     | GetBounds => (send(repChan, Bnds (getbnds (size str))); initLoop str)
323 :     | SetString str' => initLoop str'
324 :     | DoRealize arg => realizeStrEdit arg str
325 :     | ShiftWin _ => initLoop str
326 :    
327 :     in
328 :     spawn (fn () => (initLoop initval;()));
329 :     StrEdit (
330 :     W.mkWidget{
331 :     root=root,
332 :     args= fn () => {background = NONE},
333 :     boundsOf = fn () => (
334 :     send (reqChan, GetBounds);
335 :     case recv repChan of
336 :     Bnds b => b
337 :     | Str _ => raise LibBase.Impossible "StrEdit.mkStrEdit"
338 :     ),
339 :     realize = (fn arg => (send (reqChan, DoRealize arg)))
340 :     },
341 :     reqChan,
342 :     repChan
343 :     )
344 :     end
345 :    
346 :     fun widgetOf (StrEdit(widget,_,_)) = widget
347 :    
348 :     fun setString (StrEdit(_,reqc,_)) arg = (send (reqc, SetString arg))
349 :    
350 :     fun shiftWin (StrEdit(_,reqc,_)) arg = (send (reqc, ShiftWin arg))
351 :    
352 :     fun getString (StrEdit(_,reqc,repc)) = (
353 :     send (reqc, GetString);
354 :     case recv repc of
355 :     Bnds _ => raise LibBase.Impossible "StrEdit.getString"
356 :     | Str s => s
357 :     )
358 :    
359 :     end (* StrEdit *)
360 :    

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