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

SCM Repository

[smlnj] Diff of /sml/trunk/src/eXene/widgets/simple/scrollbar.sml
ViewVC logotype

Diff of /sml/trunk/src/eXene/widgets/simple/scrollbar.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1187, Wed Apr 17 01:56:13 2002 UTC revision 1188, Wed Apr 17 15:17:31 2002 UTC
# Line 1  Line 1 
1  (* scrollbar.sml  (* scrollbar.sml
2   *   *
3   * COPYRIGHT (c) 1994 by AT&T Bell Laboratories  See COPYRIGHT file for details.   * COPYRIGHT (c) 1994, 2002 by AT&T Bell Laboratories  See COPYRIGHT file for details.
4   *   *
5   * Scrollbar widget.   * Scrollbar widget.
6     *
7     * CHANGE LOG
8     *
9     * 12 Mar 02 - Allen Stoughton - Changed widget so that, when it's
10     * trying to communicate a value to the application on the scroll_evt
11     * channel, it's still willing to process the application's setvals
12     * operations.  (This was necessary to avoid deadlock.)  Also modified
13     * widget to cope with resize events during ScrStart, ..., ScrMove, ...,
14     * ScrEnd, sequences.  (Previously, the user would lose control of the
15     * mouse, and a ScrEnd event wouldn't be generated.)
16   *)   *)
17    
18  structure Scrollbar : SCROLLBAR = struct  structure Scrollbar : SCROLLBAR =
19      struct
20    
21    structure CML = CML    structure CML = CML
22    structure W = Widget    structure W = Widget
23    
24    open CML Geometry EXeneBase Interact Widget ScrollView    open CML Geometry EXeneBase Interact Widget ScrollView
25    
26        type scroll_state = {  (* since not exported from ScrollView; the variable "data" *)
27          size : int,          (* ranges over this type *)
28          coord : Geometry.point -> int,
29          draw : int * int -> unit,
30          move : int * int * int * int -> unit
31        }
32    
33      val min = Int.min      val min = Int.min
34      val max = Int.max      val max = Int.max
35    
36    datatype scroll_evt =      datatype scroll_evt
37      ScrUp of real        = ScrUp of real
38    | ScrDown of real    | ScrDown of real
39    | ScrStart of real    | ScrStart of real
40    | ScrMove of real    | ScrMove of real
41    | ScrEnd of real    | ScrEnd of real
42    
43    datatype scrollbar =      datatype scrollbar = Scrollbar of {
     Scrollbar of {  
44        widget : Widget.widget,        widget : Widget.widget,
45        evt : scroll_evt CML.event,        evt : scroll_evt CML.event,
46        setvals : {top : real option, sz : real option } -> unit        setvals : {top : real option, sz : real option } -> unit
47      }      }
48    
49    datatype mseMsg =      datatype mseMsg
50      Grab of point        = Grab of point
51    | Move of point    | Move of point
52    | Ungrab of point    | Ungrab of point
53    | UpGrab of point    | UpGrab of point
# Line 38  Line 55 
55    | DownGrab of point    | DownGrab of point
56    | DownUngrab of point    | DownUngrab of point
57    
58    datatype rqst =      datatype rqst
59      SetVals of {top : real option, sz : real option }        = SetVals of {top : real option, sz : real option }
60    | DoRealize of {    | DoRealize of {
61        env : in_env,        env : in_env,
62        win : window,        win : window,
63        sz : size        sz : size
64      }      }
65    
66    type scroll = {      type scroll = {  (* the variable "me" ranges over this type *)
67      curx : int,      curx : int,
68      swid : int      swid : int
69    }    }
# Line 54  Line 71 
71    val initSize = 1000    val initSize = 1000
72    val minSwid = 8    val minSwid = 8
73    
74    fun newVals (me as {curx, swid}, size, arg) =      fun newVals (me as {curx, swid}, size, arg) = (case arg
75      case arg of            of {top=NONE, sz=NONE} => me
76        {top=NONE, sz=NONE} => me             | {top=SOME top, sz=NONE} => {
77      | {top=SOME top, sz=NONE} =>                   curx=min(size-swid,max(0,floor(top * (real size)))),
78          {curx=min(size-swid,max(0,floor(top * (real size)))),swid=swid}                   swid=swid
79      | {top=NONE, sz=SOME sz} =>                 }
80          {curx=curx,swid=min(size-curx,max(minSwid,ceil(sz * (real size))))}             | {top=NONE, sz=SOME sz} => {
81      | {top=SOME top, sz=SOME sz} =>                   curx=curx,
82        let                   swid=min(size-curx,max(minSwid,ceil(sz * (real size))))
83                   }
84               | {top=SOME top, sz=SOME sz} => let
85          val sz' = min(size,max(minSwid,ceil(sz * (real size))))          val sz' = min(size,max(minSwid,ceil(sz * (real size))))
86          val top' = min(size-sz',max(0,floor(top * (real size))))          val top' = min(size-sz',max(0,floor(top * (real size))))
87        in        in
88          {curx=top',swid=sz'}          {curx=top',swid=sz'}
89        end        end
90              (* end case *))
91    
92    fun mkScroll (root, dim, color, bg, {bounds_of, realize} : scroll_view) = let    fun mkScroll (root, dim, color, bg, {bounds_of, realize} : scroll_view) = let
93      val _ = if dim < 4      val _ = if dim < 4
# Line 81  Line 101 
101      val reqevt = recvEvt reqchan      val reqevt = recvEvt reqchan
102    
103           (* mouse reader *)           (* mouse reader *)
104      fun mseP m = let            fun mseProc m = let
   
105        fun downLoop (movef,upf) = let        fun downLoop (movef,upf) = let
106          fun loop () =                        fun loop () = (case msgBodyOf (sync m)
107            case msgBodyOf (sync m) of                              of MOUSE_LastUp {pt,...} => upf pt
             MOUSE_LastUp {pt,...} => upf pt  
108            | MOUSE_Motion {pt,...} => (movef pt;loop ())            | MOUSE_Motion {pt,...} => (movef pt;loop ())
109            | _ => loop ()            | _ => loop ()
110                                (* end case *))
111        in        in
112          loop ()          loop ()
113        end        end
114    
115        fun loop () =                  fun loop () = (case msgBodyOf (sync m)
116          case msgBodyOf (sync m) of                        of MOUSE_FirstDown {but=btn as MButton 1,pt,...} => (
           MOUSE_FirstDown {but=btn as MButton 1,pt,...} => (  
117              send (msechan, UpGrab pt);              send (msechan, UpGrab pt);
118              downLoop (fn _ => (), fn p => send(msechan, UpUngrab p));              downLoop (fn _ => (), fn p => send(msechan, UpUngrab p));
119              loop ()                             loop ())
           )  
120          | MOUSE_FirstDown {but=btn as (MButton 2),pt,...} => (          | MOUSE_FirstDown {but=btn as (MButton 2),pt,...} => (
121              send (msechan, Grab pt);              send (msechan, Grab pt);
122              downLoop (              downLoop (
123                fn p => send(msechan, Move p),                fn p => send(msechan, Move p),
124                fn p => send(msechan, Ungrab p)                fn p => send(msechan, Ungrab p)
125              );              );
126              loop ()                             loop ())
           )  
127          | MOUSE_FirstDown {but=btn as MButton 3,pt,...} => (          | MOUSE_FirstDown {but=btn as MButton 3,pt,...} => (
128              send (msechan, DownGrab pt);              send (msechan, DownGrab pt);
129              downLoop (fn _ => (),fn p => send(msechan, DownUngrab p));              downLoop (fn _ => (),fn p => send(msechan, DownUngrab p));
130              loop ()                             loop ())
           )  
131          | _ => loop ()          | _ => loop ()
132                          (* end case *))
133      in      in
134        loop ()        loop ()
135      end      end
# Line 124  Line 140 
140        val InEnv{m,ci,...} = Interact.ignoreKey inenv        val InEnv{m,ci,...} = Interact.ignoreKey inenv
141        val config = config (Drawing.drawableOfWin win)        val config = config (Drawing.drawableOfWin win)
142    
143                    (* returns (me, data) *)
144        fun reconfig ({curx,swid},size,sz,redraw) = let        fun reconfig ({curx,swid},size,sz,redraw) = let
145              val data as {size=size',draw,...} = config sz              val data as {size=size',draw,...} = config sz
146              val curx' = (curx*size') div size                        val scale = 1.0 / real size
147              val swid' = (swid*size') div size                        val size' = real size'
148                          val curx' = floor((scale * real curx) * size')
149                          val swid' = ceil((scale * real swid) * size')
150              in              in
151                if redraw then draw (curx',swid') else ();                if redraw then draw (curx',swid') else ();
152                cmdP ({curx=curx', swid=swid'}, data)                          ({curx=curx', swid=swid'}, data)
153              end              end
154    
155        and cmdP (me, {size,coord,draw,move}) = let                  (* returns (b, me', data'), where b is true iff scrollbar has been reconfigured *)
156                    fun handleCIEvt (evt, me : scroll, data as {size, draw, ...} : scroll_state) = (
157          fun sendVal (v, f) = send (valchan, f ((real v)/(real (size))))                        case msgBodyOf evt
158                            of CI_OwnDeath => (false, me, data)
159          fun moveSlide (me as {curx,swid}, x) = let                           | CI_Redraw _ => (draw (#curx me, #swid me); (false, me, data))
160            val curx' = min(size-swid,max(0,x))                           | CI_Resize (RECT{wid,ht,...}) => let
161          in                               val (me', data') = reconfig (me, size, SIZE{wid=wid,ht=ht}, true)
162            if curx' <> curx then let                               in (true, me', data') end
163                             | _ => (false, me, data)
164                            (* end case *))
165    
166                    fun handleReqEvt (SetVals arg,
167                                      me as {curx, swid},  (* application's version *)
168                                      me' as {curx = curx', swid = swid'},  (* scrollbar's version *)
169                                      {size, move, ...} : scroll_state) = let
170                          val me'' as {curx=curx'', swid=swid''} = newVals (me, size, arg)
171            in            in
172              move (curx, swid, curx', swid);                          if curx' <> curx'' orelse swid' <> swid''
173              {curx=curx',swid=swid}                          then move (curx', swid', curx'', swid'')
174            end                          else ();
175            else me                          me''
176          end          end
177                      | handleReqEvt (DoRealize _, _, me, _) = me
178    
179          fun handleCIEvt (evt, me : scroll) =                  fun sendValAbortOnReq (v, f, me,
180            case msgBodyOf evt of                                         data as {size, ...} : scroll_state) = let
181              CI_OwnDeath => me                        val v = min(size - 1, max(0, v))
182            | CI_Redraw _ => (draw (#curx me, #swid me); me)                        val valevt = sendEvt (valchan, f (real v / real size))
183            | CI_Resize (RECT{wid,ht,...}) =>                        in select [
184                reconfig (me, size, SIZE{wid=wid,ht=ht},true)                                wrap (valevt, fn () => me),
185            | _ => me                                wrap (reqevt, fn evt => handleReqEvt (evt, me, me, data))
186                               ]
         fun handleReqEvt (SetVals arg, me as {curx,swid}) =  
           let  
             val me' as {curx=curx',swid=swid'} = newVals (me, size, arg)  
           in  
             if curx <> curx' orelse swid <> swid' then  
                move (curx, swid, curx', swid')  
             else ();  
             me'  
187            end            end
           | handleReqEvt (DoRealize _,me) = me  
188    
189                    (* xoff, me is widget's view;
190                       x is new position of mouse pointer, relative to beginning of widget's window;
191                       returns (xoff', me') *)
192                    fun moveSlide (xoff, me as {curx, swid}, {size, move, ...} : scroll_state, x) = let
193                          val curx' = x - xoff
194                          val maxx = size - swid
195                          val (xoff', curx'') =
196                                if curx' < 0
197                                  then (x - curx, 0)
198                                else if curx' > maxx
199                                  then (x - curx, maxx)
200                                else (xoff, curx')
201                          in
202                            if curx'' <> curx
203                            then (move (curx, swid, curx'', swid);
204                                  (xoff', {curx=curx'',swid=swid}))
205                            else (xoff', me)
206                          end
207    
208          fun handleMEvt (Grab p, me as {curx,swid}) = let                  (* returns (me', data') *)
209                    fun handleMEvt (Grab p, me as {curx,swid}, data as {size, coord, ...}) = let
210            val x = coord p            val x = coord p
211            val maxx = size - swid            val maxx = size - swid
212            val (xoff, me') =            val (xoff, me') =
213              if curx <= x andalso x < curx + swid then ((x - curx), me)                            if curx <= x andalso x < curx + swid
214              else if 0 <= x andalso x < maxx+swid then                            then ((x - curx), me)
215                              else
216                let                let
217                  val curx' = min(maxx, max(0, x - (swid div 2)))                  val curx' = min(maxx, max(0, x - (swid div 2)))
218                in                in
219                  (x - curx', moveSlide (me, curx'))                                (x - curx', #2(moveSlide (0 (* irrelevant *), me, data, curx')))
220                end                end
             else if x < 0 then (swid div 2, moveSlide (me, 0))  
             else (swid div 2, moveSlide (me, maxx))  
221    
222            fun hMEvt (Ungrab x, me) =                      (* xoff, me are scrollbar's view, and tell us where mouse pointer was;
223              let                         me' is what application has asked that scroll be;
224                val me' = moveSlide (me, (coord x) - xoff)                         returns xoff relative to me' *)
225              in                      fun newxoff(xoff, me : scroll, me' : scroll) =
226                sendVal (#curx me', ScrEnd);                            #curx me + xoff - #curx me'
227                (false, me')  
228              end                      (* me is application's view;
229              | hMEvt (Move x, me) =                         xoff, me' are scrollbar's view;
230              let                         force is true iff insist on communication with application, even if
231                val me' = moveSlide (me, (coord x) - xoff)                           it makes request;
232              in                         returns (xoff', me''), shared by application and scrollbar *)
233                if (#curx me <> #curx me') then sendVal (#curx me', ScrMove)                      fun sendVal (me, xoff, me', f, force, data as {size, ...}) = let
234                else ();                            val v = #curx me'
235                (true, me')                            val valevt = sendEvt (valchan, f (real v / real size))
             end  
             | hMEvt (_, me) = (true, me)  (* protocol error *)  
236    
237            fun loop me = select [                            fun loop (me, xoff, me', valevt) =
238                wrap (reqevt,fn evt => loop (handleReqEvt (evt, me))),                                  select [
239                wrap (ci, fn evt => loop (handleCIEvt (evt, me))),                                      wrap (valevt, fn () => (xoff, me')),
240                                        wrap (reqevt, fn evt => let
241                                          val me'' = handleReqEvt (evt, me, me', data)
242                                          val xoff' = newxoff(xoff, me', me'')
243                                          in if force
244                                             then let val v' = #curx me''
245                                                      val valevt' =
246                                                            sendEvt (valchan, f (real v' / real size))
247                                                  in loop(me'', xoff', me'', valevt') end
248                                             else (xoff', me'')
249                                          end)
250                                      ]
251                              in loop(me, xoff, me', valevt) end
252    
253                        (* xoffOpt is NONE when we've lost track of where mouse was - which is
254                             when a CI_Resize has been processed;
255                           returns (b, (xoffOpt', me')), where b is true iff an Ungrab has been processed *)
256                        fun hMEvt (Ungrab x, xoffOpt, me, data) = (case xoffOpt
257                              of NONE => (false,
258                                          let val (_, me') =
259                                                    sendVal (me, 0 (* irrelevant *), me, ScrEnd, true, data)
260                                          in (NONE (* irrelevant *), me') end)
261                               | SOME xoff => let
262                                   val me' = #2(moveSlide (xoff, me, data, coord x))
263                                   in (false,
264                                       let val (_, me'') =
265                                                 sendVal (me, 0 (* irrelevant *), me', ScrEnd, true, data)
266                                       in (NONE (* irrelevant *), me'') end)
267                                   end
268                              (* end case *))
269                          | hMEvt (Move x, xoffOpt, me, data) = (case xoffOpt
270                              of NONE => (true, (SOME(coord x - #curx me), me))
271                               | SOME xoff => let
272                                   val (xoff', me') = moveSlide (xoff, me, data, coord x)
273                                   in if #curx me <> #curx me'
274                                      then (true,
275                                            let val (xoff'', me'') =
276                                                      sendVal (me, xoff', me', ScrMove, false, data)
277                                            in (SOME xoff'', me'') end)
278                                      else (true, (SOME xoff', me'))
279                                   end
280                              (* end case *))
281                          | hMEvt (_, xoffOpt, me, _) = (true, (xoffOpt, me))  (* protocol error *)
282    
283                        (* xoffOpt is NONE when we've lost track of where mouse was - which is
284                             when a CI_Resize has been processed;
285                           returns (me', data') *)
286                        fun loop (xoffOpt, me, data) = select [
287                                wrap (reqevt, fn evt => let
288                                        val me' = handleReqEvt (evt, me, me, data)
289                                        in case xoffOpt
290                                             of NONE => loop(NONE, me, data)
291                                              | SOME xoff => loop(SOME(newxoff(xoff, me, me')), me', data)
292                                           (* end case *)
293                                        end),
294                                wrap (ci, fn evt => let
295                                        val (reconf, me', data') = handleCIEvt (evt, me, data)
296                                        in if reconf
297                                           then loop (NONE, me', data')
298                                           else loop (xoffOpt, me', data')
299                                        end),
300                wrap (mevt, fn evt =>                wrap (mevt, fn evt =>
301                  case hMEvt (evt, me) of                                case hMEvt (evt, xoffOpt, me, data)
302                    (true, m) => loop m                                  of (true, (xoffOpt, me)) => loop(xoffOpt, me, data)
303                  | (false, m) => m)                                |    (false, (_, me)) => (me, data)
304                                  (* end case *))
305              ]              ]
306    
307                        val (xoff', me'') = sendVal(me, xoff, me', ScrStart, true, data)
308          in          in
309            sendVal (#curx me', ScrStart);                        loop (SOME xoff', me'', data)
310            loop me' end                      end
311          | handleMEvt (UpGrab _,me) = let                    | handleMEvt (UpGrab _, me, data) = let
312                          fun hMEvt (UpUngrab x, me, data as {coord, ...}) =
313            fun hMEvt (UpUngrab x, me) = (sendVal (coord x, ScrUp); (false, me))                              (false, sendValAbortOnReq (coord x, ScrUp, me, data))
314              | hMEvt (_, me) = (true, me)  (* protocol error *)                          | hMEvt (_, me, _) = (true, me)  (* protocol error *)
315    
316            fun loop me =                        fun loop (me, data) =
317              select [              select [
318                wrap (reqevt,fn evt => loop (handleReqEvt (evt, me))),                                wrap (reqevt, fn evt => loop (handleReqEvt (evt, me, me, data), data)),
319                wrap (ci, fn evt => loop (handleCIEvt (evt, me))),                                wrap (ci, fn evt => let
320                                          val (_, me', data') = handleCIEvt (evt, me, data)
321                                          in loop (me', data') end),
322                wrap (mevt, fn evt =>                wrap (mevt, fn evt =>
323                  case hMEvt (evt, me) of                                  case hMEvt (evt, me, data)
324                    (true, m) => loop m                                    of
325                  | (false, m) => m)                                       (true, me) => loop (me, data)
326                                       | (false, me) => (me, data)
327                                      (* end case *))
328              ]              ]
329            in            in
330              loop me                          loop (me, data)
331            end            end
332          | handleMEvt (DownGrab p,me) = let                    | handleMEvt (DownGrab p, me, data) = let
333                          fun hMEvt (DownUngrab x, me, data as {coord, ...}) =
334            fun hMEvt (DownUngrab x, me) = (sendVal (coord x, ScrDown); (false, me))                              (false, sendValAbortOnReq (coord x, ScrDown, me, data))
335              | hMEvt (_, me) = (true, me)  (* protocol error *)                          | hMEvt (_, me, _) = (true, me)  (* protocol error *)
336    
337            fun loop me =                        fun loop (me, data) =
338              select [              select [
339                wrap (reqevt,fn evt => loop (handleReqEvt (evt, me))),                                wrap (reqevt, fn evt => loop (handleReqEvt (evt, me, me, data), data)),
340                wrap (ci, fn evt => loop (handleCIEvt (evt, me))),                                wrap (ci, fn evt => let
341                                          val (_, me', data') = handleCIEvt (evt, me, data)
342                                          in loop(me', data') end),
343                wrap (mevt, fn evt =>                wrap (mevt, fn evt =>
344                  case hMEvt (evt, me) of                                  case hMEvt (evt, me, data)
345                    (true, m) => loop m                                    of (true, me) => loop (me, data)
346                  | (false, m) => m)                                     | (false, me) => (me, data)
347                                      (* end case *))
348              ]              ]
349            in            in
350              loop me                          loop (me, data)
351            end            end
352          | handleMEvt (_,me) = me   (* protocol error *)                    | handleMEvt (_, me, data) = (me, data)   (* protocol error *)
353    
354          fun cmdLoop me =                fun cmdProc (me, data) = cmdProc (select [
355            cmdLoop (select [                        wrap (reqevt, fn evt => (handleReqEvt (evt, me, me, data), data)),
356              wrap (reqevt, fn evt => handleReqEvt (evt, me)),                        wrap (mevt, fn evt => handleMEvt (evt, me, data)),
357              wrap (mevt, fn evt => handleMEvt (evt, me)),                        wrap (ci, fn evt => let
358              wrap (ci, fn evt => handleCIEvt (evt, me))                                val (_, me', data') = handleCIEvt (evt, me, data)
359                                  in (me', data') end)
360            ])            ])
361        in        in
362          cmdLoop me                  spawn (fn () => mseProc m);
363        end                  spawn (fn () => (cmdProc(reconfig (me, initSize, winsz, false)); ()));
     in  
       spawn (fn () => mseP m);  
       spawn (fn() => (reconfig (me, initSize, winsz,false);()));  
364        ()        ()
365      end                end (* realizeScroll *)
366              fun initLoop vals = case recv reqchan
367      fun initLoop vals =                   of SetVals arg => initLoop (newVals (vals, initSize, arg))
       case recv reqchan of  
         SetVals arg => initLoop (newVals (vals, initSize, arg))  
368        | DoRealize arg => realizeScroll arg vals        | DoRealize arg => realizeScroll arg vals
369                     (* end case *)
370    in    in
371      spawn (fn () => initLoop {curx=0,swid=initSize});      spawn (fn () => initLoop {curx=0,swid=initSize});
372      Scrollbar {      Scrollbar {
# Line 279  Line 380 
380        evt = recvEvt valchan,        evt = recvEvt valchan,
381        setvals = (fn arg => send (reqchan, SetVals arg))        setvals = (fn arg => send (reqchan, SetVals arg))
382      }      }
383    end            end (* mkScroll *)
384    
385    val attrs = [    val attrs = [
386        (Attrs.attr_width,          Attrs.AT_Int,     Attrs.AV_Int 12),        (Attrs.attr_width,          Attrs.AT_Int,     Attrs.AV_Int 12),
# Line 291  Line 392 
392          val attrs = W.findAttr (W.attrs(view,attrs,args))          val attrs = W.findAttr (W.attrs(view,attrs,args))
393          val sz = Attrs.getInt(attrs Attrs.attr_width)          val sz = Attrs.getInt(attrs Attrs.attr_width)
394          val bg = Attrs.getColor(attrs Attrs.attr_background)          val bg = Attrs.getColor(attrs Attrs.attr_background)
395          val color = case Attrs.getColorOpt(attrs Attrs.attr_color) of            val color = (case Attrs.getColorOpt(attrs Attrs.attr_color)
396                        NONE => bg                  of NONE => bg
397                      | SOME c => c                      | SOME c => c
398          in mkScroll(root,sz,color,SOME bg,scrollView) end                  (* end case *))
399              in
400                mkScroll(root, sz, color, SOME bg, scrollView)
401              end
402    
403    val hScrollbar = scrollbar horzScrollbar    val hScrollbar = scrollbar horzScrollbar
404    val vScrollbar = scrollbar vertScrollbar    val vScrollbar = scrollbar vertScrollbar
405    
406    fun mkHScrollbar root {sz, color} = let      fun mk scrollView root {sz, color} = let
407          val color = case color of            val color = (case color
408                        SOME c => c                  of SOME c => c
409                      | NONE => colorOfScr (screenOf root) (CMS_Name "gray")                      | NONE => colorOfScr (screenOf root) (CMS_Name "gray")
410          in mkScroll (root, sz, color, NONE, horzScrollbar) end                  (* end case *))
411              in
412                mkScroll (root, sz, color, NONE, scrollView)
413              end
414    
415    fun mkVScrollbar root {sz, color} = let      val mkHScrollbar = mk horzScrollbar
416          val color = case color of      val mkVScrollbar = mk vertScrollbar
                       SOME c => c  
                     | NONE => colorOfScr (screenOf root) (CMS_Name "gray")  
         in mkScroll (root, sz, color, NONE, vertScrollbar) end  
417    
418    fun widgetOf (Scrollbar {widget,...}) = widget    fun widgetOf (Scrollbar {widget,...}) = widget
419    fun evtOf (Scrollbar {evt,...}) = evt    fun evtOf (Scrollbar {evt,...}) = evt
420    fun setVals (Scrollbar{setvals,...}) arg = setvals arg    fun setVals (Scrollbar{setvals,...}) arg = setvals arg
421    
422  end (* ScrollBar *)  end (* ScrollBar *)
   
   

Legend:
Removed from v.1187  
changed lines
  Added in v.1188

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