1(*
2    Copyright (c) 2001-7, 2015
3        David C.J. Matthews
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License version 2.1 as published by the Free Software Foundation.
8    
9    This library is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12    Lesser General Public License for more details.
13    
14    You should have received a copy of the GNU Lesser General Public
15    License along with this library; if not, write to the Free Software
16    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17*)
18
19structure Window :
20sig
21    type HWND and HINSTANCE and HMENU
22    type POINT = { x: int, y: int }
23    type RECT =  { left: int, top: int, right: int, bottom: int }
24
25    structure Style:
26    sig
27        include BIT_FLAGS
28        val WS_OVERLAPPED: flags and WS_POPUP: flags and WS_CHILD: flags and WS_MINIMIZE: flags
29        and WS_VISIBLE: flags and WS_DISABLED:flags and WS_CLIPSIBLINGS:flags
30        and WS_CLIPCHILDREN:flags and WS_MAXIMIZE:flags and WS_CAPTION:flags
31        and WS_BORDER:flags and WS_DLGFRAME:flags and WS_VSCROLL:flags and WS_HSCROLL:flags
32        and WS_SYSMENU:flags and WS_THICKFRAME:flags and WS_GROUP:flags and WS_TABSTOP:flags
33        and WS_MINIMIZEBOX:flags and WS_MAXIMIZEBOX:flags and WS_TILED:flags and WS_ICONIC:flags
34        and WS_SIZEBOX:flags and WS_OVERLAPPEDWINDOW:flags and WS_TILEDWINDOW:flags
35        and WS_POPUPWINDOW:flags and WS_CHILDWINDOW:flags
36    end
37    
38    structure ExStyle:
39    sig
40        include BIT_FLAGS
41        val WS_EX_DLGMODALFRAME: flags and WS_EX_NOPARENTNOTIFY: flags and WS_EX_TOPMOST: flags
42        and WS_EX_ACCEPTFILES : flags and WS_EX_TRANSPARENT: flags and WS_EX_MDICHILD: flags
43        and WS_EX_TOOLWINDOW: flags and WS_EX_WINDOWEDGE: flags and WS_EX_CLIENTEDGE: flags
44        and WS_EX_CONTEXTHELP: flags and WS_EX_RIGHT: flags and WS_EX_LEFT: flags
45        and WS_EX_RTLREADING: flags and WS_EX_LTRREADING: flags and WS_EX_LEFTSCROLLBAR: flags
46        and WS_EX_RIGHTSCROLLBAR: flags and WS_EX_CONTROLPARENT: flags and WS_EX_STATICEDGE: flags
47        and WS_EX_APPWINDOW: flags and WS_EX_OVERLAPPEDWINDOW: flags and WS_EX_PALETTEWINDOW: flags
48    end
49
50    datatype WindowPositionStyle =
51            SWP_ASYNCWINDOWPOS
52        |   SWP_DEFERERASE
53        |   SWP_FRAMECHANGED
54        |   SWP_HIDEWINDOW
55        |   SWP_NOACTIVATE
56        |   SWP_NOCOPYBITS
57        |   SWP_NOMOVE
58        |   SWP_NOOWNERZORDER
59        |   SWP_NOREDRAW
60        |   SWP_NOSENDCHANGING
61        |   SWP_NOSIZE
62        |   SWP_NOZORDER
63        |   SWP_SHOWWINDOW
64        |   SWP_OTHER of Word32.word
65
66    datatype ShowWindowOptions =
67        SW_HIDE
68    |   SW_MAXIMIZE
69    |   SW_MINIMIZE
70    |   SW_RESTORE
71    |   SW_SHOW
72    |   SW_SHOWDEFAULT
73    |   SW_SHOWMAXIMIZED
74    |   SW_SHOWMINIMIZED
75    |   SW_SHOWMINNOACTIVE
76    |   SW_SHOWNA
77    |   SW_SHOWNOACTIVATE
78    |   SW_SHOWNORMAL
79
80    val SW_NORMAL: ShowWindowOptions
81    val SW_MAX: ShowWindowOptions
82
83    val ShowWindow: HWND * ShowWindowOptions -> bool
84
85    datatype GetWindowFlags =
86        GW_CHILD
87    |   GW_HWNDFIRST
88    |   GW_HWNDLAST
89    |   GW_HWNDNEXT
90    |   GW_HWNDPREV
91    |   GW_OWNER
92
93    datatype ParentType =
94          ChildWindow of {id: int, parent: HWND}
95        | PopupWindow of HMENU
96        | PopupWithClassMenu
97
98    val GWL_EXSTYLE : int
99    val GWL_HINSTANCE : int
100    val GWL_HWNDPARENT : int
101    val GWL_ID : int
102    val GWL_STYLE : int
103    val GWL_USERDATA : int
104
105    val AdjustWindowRect : RECT * Style.flags * bool -> RECT
106    val AdjustWindowRectEx :  RECT * Style.flags * bool * int -> RECT
107    val ArrangeIconicWindows : HWND -> int
108    val BringWindowToTop : HWND -> unit
109    val CW_USEDEFAULT : int
110    val ChildWindowFromPoint : HWND * POINT -> HWND option
111    val CloseWindow : HWND -> unit
112    val CreateWindow :
113       {x: int, y: int, init: 'a, name: string, class: 'a Class.ATOM,
114         style: Style.flags, width: int, height: int,
115         instance: HINSTANCE, relation: ParentType} -> HWND
116    val CreateWindowEx :
117       {x: int, y: int, init: 'a, name: string, class: 'a Class.ATOM,
118         style: Style.flags, width: int, height: int,
119         instance: HINSTANCE, relation: ParentType, exStyle: ExStyle.flags} -> HWND
120    val CreateMDIClient: {
121            relation: ParentType, style: Style.flags, instance: HINSTANCE, windowMenu: HMENU,
122            idFirstChild: int} -> HWND
123    val DefWindowProc: HWND * Message.Message -> Message.LRESULT
124    val DefFrameProc: HWND * HWND * Message.Message -> Message.LRESULT
125    val DefMDIChildProc: HWND * Message.Message -> Message.LRESULT
126    val DestroyWindow: HWND -> unit
127    val FindWindow: string option * string option -> HWND
128    val FindWindowEx: HWND option * HWND option * string option * string option -> HWND
129    val GetClassName : HWND -> string
130    val GetClientRect : HWND -> RECT
131    val GetDesktopWindow : unit -> HWND
132    val GetForegroundWindow : unit -> HWND
133    val GetLastActivePopup : HWND -> HWND
134    val GetNextWindow : HWND * GetWindowFlags -> HWND
135    val GetParent : HWND -> HWND option
136    val GetTopWindow : HWND option -> HWND option
137    val GetWindow : HWND * GetWindowFlags -> HWND option
138    val GetWindowContextHelpId : HWND -> int
139    val GetWindowLongPtr : HWND * int -> int
140    val GetWindowRect : HWND -> RECT
141    val GetWindowText : HWND -> string
142    val GetWindowTextLength : HWND -> int
143    val IsChild : HWND * HWND -> bool
144    val IsIconic : HWND -> bool
145    val IsWindow : HWND -> bool
146    val IsWindowVisible : HWND -> bool
147    val IsZoomed : HWND -> bool
148    val MoveWindow : {x: int, y: int, hWnd: HWND, width: int, height: int, repaint: bool} -> unit
149    val OpenIcon : HWND -> unit
150    val SetForegroundWindow : HWND -> bool
151    val SetParent : HWND * HWND option -> HWND
152    val SetWindowContextHelpId : HWND * int -> unit
153    val SetWindowLongPtr : HWND * int * int -> int
154    val SetWindowPos : HWND * HWND * int * int * int * int * WindowPositionStyle list -> unit
155    val SetWindowText : HWND * string -> unit
156    val SubclassWindow :
157       HWND *
158       (HWND * Message.Message * 'a -> Message.LRESULT * 'a) * 'a ->
159           (HWND  * Message.Message) -> Message.LRESULT
160    val WindowFromPoint : POINT -> HWND option
161
162end =
163struct
164local
165    open Foreign
166    open Globals
167    open Base
168    open Resource
169    open Class
170
171    fun checkWindow c = (checkResult(not(isHNull c)); c)
172in
173    type HWND = HWND and HINSTANCE = HINSTANCE and RECT = RECT and POINT = POINT
174    and HMENU = HMENU
175
176    open WinBase (* Get Style and SetWindowPositionStyle *)
177
178    datatype ShowWindowOptions =
179        SW_HIDE
180    |   SW_MAXIMIZE
181    |   SW_MINIMIZE
182    |   SW_RESTORE
183    |   SW_SHOW
184    |   SW_SHOWDEFAULT
185    |   SW_SHOWMAXIMIZED
186    |   SW_SHOWMINIMIZED
187    |   SW_SHOWMINNOACTIVE
188    |   SW_SHOWNA
189    |   SW_SHOWNOACTIVATE
190    |   SW_SHOWNORMAL
191
192    val SW_NORMAL = SW_SHOWNORMAL
193    val SW_MAX = SW_SHOWDEFAULT
194
195    local
196        val showWindow = winCall2 (user "ShowWindow")(cHWND,cInt) (cBool)
197    in
198        fun ShowWindow (win, opt) = 
199        let
200            val cmd =
201                case opt of
202                    SW_HIDE             => 0
203                |   SW_SHOWNORMAL       => 1
204                |   SW_SHOWMINIMIZED    => 2
205                |   SW_SHOWMAXIMIZED    => 3
206                |   SW_MAXIMIZE         => 3
207                |   SW_SHOWNOACTIVATE   => 4
208                |   SW_SHOW             => 5
209                |   SW_MINIMIZE         => 6
210                |   SW_SHOWMINNOACTIVE  => 7
211                |   SW_SHOWNA           => 8
212                |   SW_RESTORE          => 9
213                |   SW_SHOWDEFAULT      => 10
214    
215        in
216            showWindow (win, cmd)
217        end
218    end
219
220    val CloseWindow =
221        winCall1 (user "CloseWindow") (cHWND) (successState "CloseWindow")
222    val FindWindow =
223        checkWindow o
224        winCall2 (user "FindWindowA") (STRINGOPT, STRINGOPT) cHWND
225    val FindWindowEx =
226        checkWindow o
227        winCall4 (user "FindWindowExA") (cHWNDOPT, cHWNDOPT, STRINGOPT, STRINGOPT) cHWND
228    val GetDesktopWindow       = winCall0 (user "GetDesktopWindow") () cHWND
229    val GetForegroundWindow    = winCall0 (user "GetForegroundWindow") () cHWND
230    val GetLastActivePopup     = winCall1 (user "GetLastActivePopup") cHWND cHWND
231    val GetParent              = winCall1 (user "GetParent") cHWND cHWNDOPT
232    val GetTopWindow           = winCall1 (user "GetTopWindow") cHWNDOPT cHWNDOPT
233
234    val GetWindowTextLength    = winCall1 (user "GetWindowTextLengthA") cHWND cInt
235    val SetWindowText          =
236        winCall2 (user "SetWindowTextA") (cHWND, cString) (successState "SetWindowText")
237
238    local
239        val getTextCall = winCall3 (user "GetWindowTextA") (cHWND, cPointer, cInt) cInt
240    in
241        fun GetWindowText(hwnd: HWND): string =
242        let
243            val baseLen = GetWindowTextLength hwnd
244            (* The length returned by GetWindowTextLength may be larger than the text
245               but we have to add one for the terminating null. *)
246               open Memory
247            val buff = malloc (Word.fromInt(baseLen+1))
248            val size = getTextCall(hwnd, buff, baseLen+1)
249        in
250            (if size = 0 then ""
251            else fromCstring buff) before free buff
252        end
253    end
254
255    (* Get the class name of a window. *)
256    local
257        val getClassName = winCall3 (user "GetClassNameA") (cHWND, cPointer, cInt) cInt
258    in
259        (* Unfortunately we can't pass NULL here to get the length. *)
260        fun GetClassName hwnd =
261            getStringCall(fn (v, i) => getClassName(hwnd, v, i))
262    end
263
264    datatype GetWindowFlags =
265        GW_CHILD
266    |   GW_HWNDFIRST
267    |   GW_HWNDLAST
268    |   GW_HWNDNEXT
269    |   GW_HWNDPREV
270    |   GW_OWNER
271
272    local
273        fun winFlag GW_HWNDFIRST        = 0
274        |   winFlag GW_HWNDLAST         = 1
275        |   winFlag GW_HWNDNEXT         = 2
276        |   winFlag GW_HWNDPREV         = 3
277        |   winFlag GW_OWNER            = 4
278        |   winFlag GW_CHILD            = 5
279
280        val getWindow = winCall2 (user "GetWindow") (cHWND, cUint) cHWNDOPT
281        val getNextWindow = winCall2 (user "GetNextWindow") (cHWND,cUint) cHWND
282    in
283        fun GetWindow (win, gwFlag) = getWindow (win, winFlag gwFlag)
284        (* Only GW_HWNDNEXT and GW_HWNDPREV are allowed here but it's probably not
285           worth making it a special case. *)
286        fun GetNextWindow(win: HWND, gwFlag) =
287            checkWindow (getNextWindow (win, winFlag gwFlag))
288    end
289
290    val IsChild                = winCall2 (user "IsChild") (cHWND,cHWND) cBool
291    val IsIconic               = winCall1 (user "IsIconic") (cHWND) cBool
292    val IsWindow               = winCall1 (user "IsWindow") (cHWND) cBool
293    val IsWindowVisible        = winCall1 (user "IsWindowVisible") (cHWND) cBool
294    val IsZoomed               = winCall1 (user "IsZoomed") (cHWND) cBool
295
296    local
297        val getClientRect = winCall2 (user "GetClientRect") (cHWND, cStar cRect) cBool
298        and getWindowRect = winCall2 (user "GetWindowRect") (cHWND, cStar cRect) cBool
299        and adjustWindowRect = winCall3 (user "AdjustWindowRect") (cStar cRect, cDWORD, cBool) cBool
300        and adjustWindowRectEx = winCall4 (user "AdjustWindowRectEx") (cStar cRect, cDWORD, cBool, cDWORD) cBool
301    in
302        fun GetClientRect(hWnd: HWND): RECT =
303        let
304            val v =  ref{bottom=0, top=0, left=0, right=0}
305            val res = getClientRect (hWnd, v)
306        in
307            checkResult res;
308            !v
309        end
310
311        fun GetWindowRect(hWnd: HWND): RECT =
312        let
313            val v =  ref{bottom=0, top=0, left=0, right=0}
314            val res = getWindowRect (hWnd, v)
315        in
316            checkResult res;
317            !v
318        end
319
320        fun AdjustWindowRect(rect: RECT, style: Style.flags, bMenu: bool): RECT =
321        let
322            val v = ref rect
323            val res = adjustWindowRect(v, LargeWord.toInt(Style.toWord style), bMenu)
324        in
325            checkResult res;
326            !v
327        end
328
329        fun AdjustWindowRectEx(rect: RECT, style: Style.flags, bMenu: bool, exStyle: int): RECT =
330        let
331            val v = ref rect
332            val res = adjustWindowRectEx(v, LargeWord.toInt(Style.toWord style), bMenu, exStyle)
333        in
334            checkResult res;
335            !v
336        end
337    end
338
339    val ArrangeIconicWindows = winCall1 (user "ArrangeIconicWindows") (cHWND) cUint
340    val BringWindowToTop =
341        winCall1 (user "BringWindowToTop") (cHWND) (successState "BringWindowToTop")
342    val OpenIcon = winCall1 (user "OpenIcon") (cHWND) (successState "OpenIcon")
343    val SetForegroundWindow = winCall1 (user "SetForegroundWindow") (cHWND) cBool
344
345    local
346        val setParent = winCall2 (user "SetParent") (cHWND, cHWND) cHWND
347    in
348        fun SetParent(child: HWND, new: HWND option): HWND =
349        let
350            val old = setParent(child, getOpt(new, hwndNull))
351        in
352            checkResult(not(isHNull old));
353            old
354        end
355    end
356
357    local
358        val createWindowEx = 
359            winCall12 (user "CreateWindowExA") (cDWORD, cString, cString, cDWORD, cInt, cInt, cInt, cInt,
360                    cHWND, cPointer, cHINSTANCE, cPointer) cHWND
361    in
362        fun CreateWindowEx{class: 'a Class.ATOM, (* Window class *)
363                         name: string, (* Window name *)
364                         style: Style.flags, (* window style *)
365                         exStyle: ExStyle.flags, (* extended style *)
366                         x: int, (* horizontal position of window *)
367                         y: int, (* vertical position of window *)
368                         width: int, (* window width *)
369                         height: int, (* window height *)
370                         relation: ParentType, (* parent or owner window *)
371                         instance: HINSTANCE, (* application instance *)
372                         init: 'a}: HWND =
373        let
374            (* Set up a winCallback for ML classes and return the class name. *)
375            val className: string =
376                case class of
377                    Registered { proc, className} =>
378                        (Message.setCallback(proc, init);  className)
379                |   SystemClass s => s
380
381            val (parent, menu, styleWord) = WinBase.unpackWindowRelation(relation, style)
382
383            (* Create a window. *)
384            val res = createWindowEx
385                    (LargeWord.toInt(ExStyle.toWord exStyle), className, name, LargeWord.toInt styleWord,
386                     x, y, width, height, parent, menu, instance, Memory.null)
387        in
388            checkResult(not(isHNull res));
389            res
390        end
391    end
392
393    fun CreateWindow{class: 'a Class.ATOM, name: string, style: Style.flags, x: int,
394                     y: int, width: int, height: int, relation: ParentType, instance: HINSTANCE,
395                     init: 'a}: HWND =
396        CreateWindowEx{exStyle=ExStyle.flags[], class=class, name=name, style=style, x=x,
397                       y=y, width=width, height=height,relation=relation, instance=instance,
398                       init=init}
399
400    local
401        val cCLIENTCREATESTRUCT = cStruct2(cHMENU, cUint)
402        val createMDIClient =
403            winCall12 (user "CreateWindowExA") (cDWORD, cString, cPointer, cDWORD, cInt, cInt, cInt, cInt,
404                    cHWND, cPointer, cHINSTANCE, cConstStar cCLIENTCREATESTRUCT) cHWND
405    in
406        fun CreateMDIClient{
407                relation: ParentType, (* This should always be ChildWindow *)
408                style: Style.flags,
409                instance: HINSTANCE,  (* application instance *)
410                windowMenu: HMENU,    (* Window menu to which children are added. *)
411                idFirstChild: int     (* Id of first child when it's created. *)
412                }: HWND =
413        let
414            val (parent, menu, styleWord) =
415                unpackWindowRelation(relation, style)
416            val createS = (windowMenu, idFirstChild)
417            val res = createMDIClient
418                    (0, "MDICLIENT", Memory.null, LargeWord.toInt styleWord, 0, 0, 0, 0, parent, menu,
419                     instance, createS)
420        in
421            checkResult(not(isHNull res));
422            res
423        end
424    end
425
426    local
427        val defWindowProc =
428                winCall4 (user "DefWindowProcA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
429        and defFrameProc =
430            winCall5 (user "DefFrameProcA") (cHWND, cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
431        and defMDIChildProc =
432            winCall4 (user "DefMDIChildProcA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
433    in 
434        fun DefWindowProc (hWnd: HWND, msg: Message.Message): Message.LRESULT  =
435        let
436            val (wMsg, wParam, lParam, freeMsg) = Message.compileMessage msg
437            val res = defWindowProc(hWnd, wMsg, wParam, lParam)
438        in
439            Message.messageReturnFromParams(msg, wParam, lParam, res)
440                before freeMsg()
441        end
442
443        fun DefFrameProc (hWnd: HWND, hWndMDIClient: HWND, msg: Message.Message): Message.LRESULT  =
444        let
445            val (wMsg, wParam, lParam, freeMsg) = Message.compileMessage msg
446            val res = defFrameProc(hWnd, hWndMDIClient, wMsg, wParam, lParam)
447        in
448            (* Write back any changes the function has made. *)
449            Message.messageReturnFromParams(msg, wParam, lParam, res)
450                before freeMsg()
451        end
452
453        fun DefMDIChildProc (hWnd: HWND, msg: Message.Message): Message.LRESULT =
454        let
455            val (wMsg, wParam, lParam, freeMsg) = Message.compileMessage msg
456            val res = defMDIChildProc(hWnd, wMsg, wParam, lParam)
457        in
458            Message.messageReturnFromParams(msg, wParam, lParam, res)
459                before freeMsg()
460        end
461    end
462
463    val CW_USEDEFAULT = ~0x80000000 (* Default value for size and/ot position. *)
464
465    local
466        val destroyWindow = winCall1 (user "DestroyWindow") (cHWND) (successState "DestroyWindow")
467    in
468        fun DestroyWindow(hWnd: HWND) =
469        (
470            destroyWindow hWnd;
471            Message.removeCallback hWnd
472        )
473    end
474
475    (*val GWL_WNDPROC         = ~4*)
476    val GWL_HINSTANCE       = ~6
477    val GWL_HWNDPARENT      = ~8
478    val GWL_STYLE           = ~16
479    val GWL_EXSTYLE         = ~20
480    val GWL_USERDATA        = ~21
481    val GWL_ID              = ~12
482
483    val GetWindowLongPtr = winCall2 (user "GetWindowLongPtrA") (cHWND, cInt) cLONG_PTR
484
485    (* SetWindowLong is a dangerous function to export. *)
486    val SetWindowLongPtr = winCall3 (user "SetWindowLongPtrA") (cHWND, cInt, cLONG_PTR) cLONG_PTR
487
488    (* ML extension.  This replaces the GetWindowLong and SetWindowLong calls. *)
489    val SubclassWindow = Message.subclass
490
491    local
492        val moveWindow =
493            winCall6(user "MoveWindow") (cHWND,cInt,cInt,cInt,cInt,cBool) (successState "MoveWindow")
494    in
495        fun MoveWindow{hWnd: HWND, x: int, y: int, height: int, width: int, repaint: bool} =
496                moveWindow(hWnd, x, y, width, height, repaint)
497    end
498
499    val SetWindowPos = winCall7 (user "SetWindowPos")
500        (cHWND, cHWND, cInt, cInt, cInt, cInt, cWINDOWPOSITIONSTYLE)
501            (successState "SetWindowPos")
502
503    val SetWindowContextHelpId =
504            winCall2 (user "SetWindowContextHelpId") (cHWND, cDWORD)
505                (successState "SetWindowContextHelpId")
506
507    val GetWindowContextHelpId = winCall1 (user "GetWindowContextHelpId") (cHWND) cDWORD
508
509    val ChildWindowFromPoint =
510        winCall2 (user "ChildWindowFromPoint") (cHWND, cPoint) cHWNDOPT
511    and WindowFromPoint =
512        winCall1 (user "WindowFromPoint") (cPoint) cHWNDOPT
513(*
514TODO:
515AnimateWindow    - Only Win98/NT 5.0
516BeginDeferWindowPos  
517CascadeWindows  
518ChildWindowFromPointEx  
519DeferWindowPos  
520EndDeferWindowPos  
521EnumChildProc  
522EnumChildWindows  
523EnumThreadWindows  
524EnumThreadWndProc  
525EnumWindows  
526EnumWindowsProc  
527GetWindowPlacement        
528GetWindowThreadProcessId        
529IsWindowUnicode                
530SetWindowPlacement    
531ShowOwnedPopups    
532ShowWindowAsync  
533TileWindows  
534*)
535
536end
537end;
538
539(* Because we're using opaque matching we have to install pretty printers
540   outside the structure. *)
541local
542    open Window.Style
543
544    val flagTable =
545        [(WS_POPUP,             "WS_POPUP"),
546         (WS_CHILD,             "WS_CHILD"),
547         (WS_MINIMIZE,          "WS_MINIMIZE"),
548         (WS_VISIBLE,           "WS_VISIBLE"),
549         (WS_DISABLED,          "WS_DISABLED"),
550         (WS_CLIPSIBLINGS,      "WS_CLIPSIBLINGS"),
551         (WS_CLIPCHILDREN,      "WS_CLIPCHILDREN"),
552         (WS_MAXIMIZE,          "WS_MAXIMIZE"),
553         (WS_CAPTION,           "WS_CAPTION"),
554         (WS_BORDER,            "WS_BORDER"),
555         (WS_DLGFRAME,          "WS_DLGFRAME"),
556         (WS_VSCROLL,           "WS_VSCROLL"),
557         (WS_HSCROLL,           "WS_HSCROLL"),
558         (WS_SYSMENU,           "WS_SYSMENU"),
559         (WS_THICKFRAME,        "WS_THICKFRAME"),
560         (WS_GROUP,             "WS_GROUP"),
561         (WS_TABSTOP,           "WS_TABSTOP"),
562         (WS_MINIMIZEBOX,       "WS_MINIMIZEBOX"),
563         (WS_MAXIMIZEBOX,       "WS_MAXIMIZEBOX")]
564
565    structure FlagP = FlagPrint(structure BITS = Window.Style)
566in
567    val _ = PolyML.addPrettyPrinter (FlagP.createFlagPrinter flagTable)
568end;
569