1(*
2    Copyright (c) 2001-7, 2015, 2019
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 Message: MESSAGE =
20struct
21    local
22        open Foreign
23        open Memory
24        open Base
25        open Globals
26        open WinBase
27        fun user name = getSymbol(loadLibrary "user32.dll") name
28        
29        val toAddr = Memory.sysWord2VoidStar
30        and fromAddr = Memory.voidStar2Sysword
31
32        val RegisterMessage = winCall1 (user "RegisterWindowMessageA") cString cUint
33        
34        (* Used in WM_WINDOWPOSXXX and also WM_NCCALCSIZE *)
35        val WINDOWPOS = cStruct7(cHWND, cHWND, cInt, cInt, cInt, cInt, cWINDOWPOSITIONSTYLE)    
36
37        local (* WM_WINDOWPOSCHANGING and WM_WINDOWPOSCHANGED. The C structure is the same
38                 but WM_WINDOWPOSCHANGING has refs in the ML to allow the call-back to
39                 change the position. *)
40            val {load=fromCwindowpos, store=toCwindowpos, ctype={size=sizeCwp, ...}, ...} = breakConversion WINDOWPOS
41            type wmWINDOWPOSCHANGED =
42                { hwnd: HWND, front: HWND, x: int, y: int, width: int, height: int, flags: WindowPositionStyle list }
43            and wmWINDOWPOSCHANGING =
44                {
45                    hwnd: HWND, front: HWND ref, x: int ref, y: int ref,
46                    width: int ref, height: int ref, flags: WindowPositionStyle list ref
47                } 
48        in
49            fun cToMLWindowPosChanging{wp=_, lp}: wmWINDOWPOSCHANGING =
50            let
51                val (wh,front,x,y,width,height,flags) = fromCwindowpos(toAddr lp)
52            in
53                {hwnd = wh, front = ref front, x = ref x, y = ref y,
54                 width = ref width, height = ref height, flags = ref flags}
55            end
56            and cToMLWindowPosChanged{wp=_, lp}: wmWINDOWPOSCHANGED =
57            let
58                val (wh,front,x,y,width,height,flags) = fromCwindowpos(toAddr lp)
59            in
60                {hwnd = wh, front = front, x = x, y = y, width = width, height = height, flags = flags}
61            end
62
63            fun mlToCWindowPosChanging(msgNo, {hwnd, front=ref front, x=ref x, y=ref y,
64                                   width=ref width, height=ref height, flags=ref flags}: wmWINDOWPOSCHANGING) =
65            let
66                open Memory
67                val mem = malloc sizeCwp
68                val freeCwp = toCwindowpos(mem, (hwnd, front, x, y, width, height, flags))
69            in
70                (msgNo, 0w0, fromAddr mem, fn() => (freeCwp(); free mem))
71            end
72            and mlToCWindowPosChanged(msgNo, {hwnd, front, x, y, width, height, flags}: wmWINDOWPOSCHANGED) =
73            let
74                open Memory
75                val mem = malloc sizeCwp
76                val freeCwp = toCwindowpos(mem, (hwnd, front, x, y, width, height, flags))
77            in
78                (msgNo, 0w0, fromAddr mem, fn() => (freeCwp(); free mem))
79            end
80
81            fun updateCfromMLwmWindowPosChanging(
82                    {wp=_, lp}, { front, x, y, width, height, flags, ...}:wmWINDOWPOSCHANGING) =
83            let
84                val (_,newfront,newx,newy,newwidth,newheight,newflags) = fromCwindowpos(toAddr lp) 
85            in
86                front := newfront;
87                x := newx;
88                y := newy;
89                width := newwidth;
90                height := newheight;
91                flags := newflags
92            end
93            and updateWindowPosChangingParms({wp=_, lp}, { hwnd, front=ref front, x=ref x, y=ref y,
94                                                           width=ref width, height=ref height, flags=ref flags}) =
95               ignore(toCwindowpos(toAddr lp, (hwnd, front, x, y, width, height, flags)))
96        end
97
98        datatype ControlType = ODT_MENU | ODT_LISTBOX | ODT_COMBOBOX | ODT_BUTTON | ODT_STATIC
99        local
100            val 
101            tab = [
102                (ODT_MENU, 1),
103                (ODT_LISTBOX, 2),
104                (ODT_COMBOBOX, 3),
105                (ODT_BUTTON, 4),
106                (ODT_STATIC, 5)
107                ]
108        in
109            val cCONTROLTYPE = tableConversion(tab, NONE) cUint
110        end
111 
112        fun structAsAddr strConv =
113        let
114            val {load, store, ctype={size, ...}, ...} = breakConversion strConv
115
116            fun make v =
117            let
118                open Memory
119                val mem = malloc size
120                val freeS = store(mem, v)
121            in
122                (fromAddr mem, fn () => (freeS(); free mem))
123            end
124        in
125            (load o toAddr, make)
126        end
127        
128        val (_, makePointStructAddr) = structAsAddr cPoint
129
130        local
131            val MDICREATESTRUCT = cStruct9(cCLASS,cString,cHINSTANCE,cInt,cInt,cInt,cInt,cDWORD,cLPARAM)
132        in
133            val (toMdiCreate, fromMdiCreate) = structAsAddr MDICREATESTRUCT
134        end
135
136        local (* WM_COMPAREITEM *)
137            val COMPAREITEMSTRUCT = cStruct8(cCONTROLTYPE,cUint,cHWND,cUint,cUINT_PTRw,cUint,cUINT_PTRw, cDWORD)
138            val MEASUREITEMSTRUCT = cStruct6(cCONTROLTYPE,cUint,cUint,cUint,cUint,cULONG_PTR)
139            val DELETEITEMSTRUCT = cStruct5(cCONTROLTYPE,cUint,cUint,cHWND,cULONG_PTR)
140            val {store=toMeasureItem, ...} = breakConversion MEASUREITEMSTRUCT
141        in
142            val (toMLCompareItem, fromMLCompareItem) = structAsAddr COMPAREITEMSTRUCT
143            and (toMLMeasureItem, fromMLMeasureItem) = structAsAddr MEASUREITEMSTRUCT
144            and (toMLDeleteItem, fromMLDeleteItem) = structAsAddr DELETEITEMSTRUCT
145            
146            fun updateMeasureItemFromWpLp({itemWidth, itemHeight, ...}, {wp=_, lp}) =
147            let
148                val (_, _, _, iWidth, iHeight, _) = toMLMeasureItem lp
149            in
150                itemWidth := iWidth;
151                itemHeight := iHeight
152            end
153            and updateMeasureItemParms({wp=_, lp}, {itemWidth=ref itemWidth, itemHeight=ref itemHeight, ...}) =
154            let
155                val (ctlType, ctlID, itemID, _, _, itemData) = toMLMeasureItem lp
156            in
157                ignore(toMeasureItem(toAddr lp, (ctlType, ctlID, itemID, itemWidth, itemHeight, itemData)))
158            end
159        end
160
161        local (* WM_CREATE and WM_NCCREATE *)
162            val CREATESTRUCT = cStruct12(cPointer,cHINSTANCE,cHMENU,cHWND,cInt,cInt,cInt,cInt,cUlongw,cString,cCLASS,cDWORD)
163            val (toMLCreate, fromMLCreate) = structAsAddr CREATESTRUCT
164        in
165            fun decompileCreate{wp=_, lp} =
166            let
167                val (cp,inst,menu,parent, cy,cx,y,x, style, name,class, extendedstyle) = toMLCreate lp
168            in
169                { instance = inst, creation = cp, menu = menu, parent = parent, cy = cy, cx = cx,
170                  y = y, x = x, style = Style.fromWord(Word32.toLargeWord style), name = name,
171                  class = class, extendedstyle = extendedstyle }
172            end
173
174            and compileCreate(code, { instance, creation, menu, parent, cy, cx,
175                                y, x, style, name, class, extendedstyle}) =
176            let
177                val (addr, free) =
178                    fromMLCreate(creation, instance, menu, parent,
179                        cy, cx, y, x, Word32.fromLargeWord(Style.toWord style), name, class,
180                        extendedstyle)
181            in
182                (code, 0w0, addr, free)
183            end
184
185        end
186
187        local
188            val MINMAXINFO = cStruct5(cPoint,cPoint,cPoint,cPoint,cPoint)
189            val {store=toCminmaxinfo, ...} = breakConversion MINMAXINFO
190            val (toMLMinMax, fromMLMinMax) = structAsAddr MINMAXINFO
191        in
192            fun decompileMinMax{wp=_, lp} =
193            let  
194                val (_, ptms, ptmp, ptts, ptmts) = toMLMinMax lp
195            in
196                    { maxSize = ref ptms, maxPosition = ref ptmp,
197                      minTrackSize = ref ptts, maxTrackSize = ref ptmts}
198            end
199            and compileMinMax(code, { maxSize=ref maxSize, maxPosition=ref maxPosition,
200                                minTrackSize=ref minTrackSize, maxTrackSize=ref maxTrackSize}) =
201            let
202                val (addr, free) = fromMLMinMax({x=0,y=0}, maxSize, maxPosition, minTrackSize, maxTrackSize)
203            in
204                (code, 0w0, addr, free)
205            end
206            
207            fun updateMinMaxFromWpLp({maxSize, maxPosition, minTrackSize, maxTrackSize}, {wp=_, lp}) =
208            let
209                val (_, ptms, ptmp, ptts, ptmts) = toMLMinMax lp
210            in
211                maxSize := ptms;
212                maxPosition := ptmp;
213                minTrackSize := ptts;
214                maxTrackSize := ptmts
215            end
216            and updateMinMaxParms({wp=_, lp}, {maxSize=ref maxSize, maxPosition=ref maxPosition,
217                                               minTrackSize=ref minTrackSize, maxTrackSize=ref maxTrackSize}) =
218            let
219                val (ptres, _, _, _, _) = toMLMinMax lp
220            in
221                ignore(toCminmaxinfo(toAddr lp, (ptres, maxSize, maxPosition, minTrackSize, maxTrackSize)))
222            end
223        end
224
225        local
226            val DRAWITEMSTRUCT = cStruct9(cCONTROLTYPE,cUint,cUint,cUint,cUint,cHWND,cHDC,cRect,cULONG_PTR)
227        in
228            val (toMLDrawItem, fromMLDrawItem) = structAsAddr DRAWITEMSTRUCT
229        end
230
231        local (* WM_NCCALCSIZE *)
232            val NCCALCSIZE_PARAMS = cStruct4(cRect,cRect,cRect, cConstStar WINDOWPOS)
233            val {load=loadStruct, store=storeStruct, ctype={size=sizeStr, ...}, ...} = breakConversion NCCALCSIZE_PARAMS
234            val {load=loadRect, store=storeRect, ctype={size=sizeRect, ...}, ...} = breakConversion cRect
235        in
236            fun decompileNCCalcSize{wp=0w1, lp} =
237                let
238                    val (newrect,oldrect,oldclientarea,winpos) = loadStruct (toAddr lp)
239                    val (wh,front,x,y,cx,cy,style) = winpos 
240                in
241                    { validarea = true, newrect = ref newrect, oldrect = oldrect,
242                      oldclientarea = oldclientarea, hwnd = wh, insertAfter = front,
243                      x = x, y = y, cx = cx, cy = cy, style = style }
244                end
245
246            |   decompileNCCalcSize{wp=_, lp} =
247                let
248                    val newrect = loadRect (toAddr lp)
249                    val zeroRect = {left=0, top=0, right=0, bottom=0}
250                in 
251                    { validarea = false, newrect = ref newrect, oldrect = zeroRect,
252                      oldclientarea = zeroRect, insertAfter = hwndNull, hwnd = hwndNull,
253                      x = 0, y = 0, cx = 0, cy = 0, style = [] }
254                end
255
256            and compileNCCalcSize{validarea=true, newrect=ref newrect, oldrect, oldclientarea,
257                            hwnd, insertAfter, x, y, cx, cy, style} =
258            let
259                open Memory
260                val mem = malloc sizeStr
261                val freeRect =
262                    storeStruct(mem, (newrect,oldrect,oldclientarea,
263                                         (hwnd,insertAfter,x,y,cx,cy, style)))
264            in
265                (0x0083, 0w1, fromAddr mem, fn () => (freeRect(); free mem))
266            end    
267            |   compileNCCalcSize{validarea=false, newrect=ref newrect, ...} =
268            let
269                open Memory
270                val mem = malloc sizeRect
271                val () = ignore(storeRect(mem, newrect))
272            in
273                (0x0083, 0w0, fromAddr mem, fn () => free mem)
274            end    
275        end
276
277        local
278            val HELPINFO = cStruct6(cUint, cInt, cInt, cPointer (* HANDLE *), cDWORD, cPoint)
279            val {ctype={size=sizeHelpInfo, ...}, ...} = breakConversion HELPINFO
280            val (toHelpInfo, fromHelpInfo) = structAsAddr HELPINFO
281        in
282            datatype HelpHandle = MenuHandle of HMENU | WindowHandle of HWND
283
284            fun compileHelpInfo(code, {ctrlId, itemHandle, contextId, mousePos}) =
285            let
286                val (ctype, handl) =
287                    case itemHandle of
288                        MenuHandle m => (2, voidStarOfHandle m)
289                    |   WindowHandle w => (1, voidStarOfHandle w)
290                val (addr, free) =
291                    fromHelpInfo(Word.toInt sizeHelpInfo, ctype, ctrlId, handl, contextId, mousePos)
292            in
293                (code, 0w0, addr, free)
294            end
295            
296            and decompileHelpInfo{wp=_, lp} =
297            let
298                val (_, ctype, ctrlId, itemHandle, contextId, mousePos) = toHelpInfo lp
299                val hndl =
300                    if ctype = 2 then MenuHandle(handleOfVoidStar itemHandle)
301                    else WindowHandle(handleOfVoidStar itemHandle)
302            in
303                { ctrlId = ctrlId, itemHandle = hndl, contextId =  contextId, mousePos = mousePos}
304            end
305        end
306
307        local
308            val {store=storeScrollInfo, ctype = {size=sizeStruct, ...}, ...} =
309                breakConversion ScrollBase.cSCROLLINFOSTRUCT
310            val (toScrollInfoStruct, fromScrollInfoStruct) = structAsAddr ScrollBase.cSCROLLINFOSTRUCT
311        in
312            fun toScrollInfo lp =
313            let
314                val (_, options, minPos, maxPos, pageSize, pos, trackPos) = toScrollInfoStruct lp
315                val info = { minPos = minPos, maxPos = maxPos, pageSize = pageSize, pos = pos, trackPos = trackPos }
316            in
317                (info, options)
318            end
319            and fromScrollInfo({minPos, maxPos, pageSize, pos, trackPos}, options) =
320                fromScrollInfoStruct(Word.toInt sizeStruct, options, minPos, maxPos, pageSize, pos, trackPos)
321            and updateScrollInfo({wp=_, lp=lp}, {info=ref {minPos, maxPos, pageSize, pos, trackPos}, options}) =
322                ignore(storeScrollInfo(toAddr lp, (Word.toInt sizeStruct, options, minPos, maxPos, pageSize, pos, trackPos)))
323        end
324
325        local
326            val {store=storeWord, load=loadWord, ctype={size=sizeWord, ...}, ...} = breakConversion cWORD
327        in
328            (* We have to allocate a buffer big enough to receive the text and
329               set the first word to the length of the buffer. *)
330            fun compileGetLine {lineNo, size, ...} =
331            let
332                open Memory
333                (* Allocate one extra byte so there's space for a null terminator. *)
334                val vec = malloc (Word.max(Word.fromInt(size+1), sizeWord))
335            in
336                ignore(storeWord(vec, size+1));
337                (0x00C5, SysWord.fromInt lineNo, fromAddr vec, fn () => free vec)
338            end
339
340            and decompileGetLine{wp, lp} =
341            let
342                (* The first word is supposed to contain the length *)
343                val size = loadWord(toAddr lp)
344            in
345                { lineNo = SysWord.toInt wp, size = size(*-1 ? *), result = ref "" }
346            end
347        end
348
349        val {load=loadInt, store=storeInt, ctype={size=sizeInt, ...}, ...} = breakConversion cInt
350
351        local (* EM_SETTABSTOPS and LB_SETTABSTOPS *)
352            open Memory
353            infix 6 ++
354        in
355            fun decompileTabStops{wp, lp} =
356            let
357                val v = toAddr lp
358                fun getTab i = loadInt(v ++ Word.fromInt i * sizeInt)
359            in
360                IntVector.tabulate(SysWord.toInt wp, getTab)
361            end
362            and compileTabStops(code, tabs) =
363            let
364                val cTabs = IntVector.length tabs
365                val vec = malloc(Word.fromInt cTabs * sizeInt)
366                fun setVec(tab, addr) = (ignore(storeInt(addr, tab)); addr ++ sizeInt)
367                val _ = IntVector.foldl setVec vec tabs
368            in
369                (code, SysWord.fromInt cTabs, fromAddr vec, fn () => free vec)
370            end
371        end
372
373        local
374            open Memory IntArray
375            infix 6 ++
376        in
377            fun compileGetSelItems(code, {items}) =
378            (* Allocate a buffer to receive the items.  Set each element of the buffer
379               to ~1 so that the values are defined if not all of them are set. *)
380            let
381                open Memory IntArray
382                val itemCount = length items
383                infix 6 ++
384                val v = malloc(Word.fromInt itemCount * sizeInt)
385            in
386                appi(fn (i, s) => ignore(storeInt(v ++ Word.fromInt i * sizeInt, s))) items;
387                (code, SysWord.fromInt itemCount, fromAddr v, fn () => free v)
388            end
389
390            fun updateGetSelItemsParms({wp=_, lp=lp}, {items}) =
391            let
392                val v = toAddr lp
393            in
394                appi(fn (i, s) => ignore(storeInt(v ++ Word.fromInt i * sizeInt, s))) items
395            end
396            and updateGetSelItemsFromWpLp({items}, {wp=_, lp, reply}) =
397            let
398                (* The return value is the actual number of items copied *)
399                val nItems = SysWord.toIntX reply
400                val b = toAddr lp
401                open Memory
402                infix 6 ++
403                fun newValue (i, old) = if i < nItems then loadInt(b ++ sizeInt * Word.fromInt i) else old
404            in
405                IntArray.modifyi newValue items
406            end
407        end
408
409        (* Passed in the lpParam argument of a WM_NOTIFY message.
410           TODO: Many of these have additional information. *)
411        datatype Notification =
412            NM_OUTOFMEMORY
413        |   NM_CLICK
414        |   NM_DBLCLK
415        |   NM_RETURN
416        |   NM_RCLICK
417        |   NM_RDBLCLK
418        |   NM_SETFOCUS
419        |   NM_KILLFOCUS
420        |   NM_CUSTOMDRAW
421        |   NM_HOVER
422        |   NM_NCHITTEST
423        |   NM_KEYDOWN
424        |   NM_RELEASEDCAPTURE
425        |   NM_SETCURSOR
426        |   NM_CHAR
427        |   NM_TOOLTIPSCREATED
428        |   NM_LDOWN
429        |   NM_RDOWN
430        |   NM_THEMECHANGED
431        |   LVN_ITEMCHANGING
432        |   LVN_ITEMCHANGED
433        |   LVN_INSERTITEM
434        |   LVN_DELETEITEM
435        |   LVN_DELETEALLITEMS
436        |   LVN_BEGINLABELEDIT
437        |   LVN_ENDLABELEDIT
438        |   LVN_COLUMNCLICK
439        |   LVN_BEGINDRAG
440        |   LVN_BEGINRDRAG
441        |   LVN_GETDISPINFO
442        |   LVN_SETDISPINFO
443        |   LVN_KEYDOWN
444        |   LVN_GETINFOTIP
445        |   HDN_ITEMCHANGING
446        |   HDN_ITEMCHANGED
447        |   HDN_ITEMCLICK
448        |   HDN_ITEMDBLCLICK
449        |   HDN_DIVIDERDBLCLICK
450        |   HDN_BEGINTRACK
451        |   HDN_ENDTRACK
452        |   HDN_TRACK
453        |   HDN_ENDDRAG
454        |   HDN_BEGINDRAG
455        |   HDN_GETDISPINFO
456        |   TVN_SELCHANGING
457        |   TVN_SELCHANGED
458        |   TVN_GETDISPINFO
459        |   TVN_SETDISPINFO
460        |   TVN_ITEMEXPANDING
461        |   TVN_ITEMEXPANDED
462        |   TVN_BEGINDRAG
463        |   TVN_BEGINRDRAG
464        |   TVN_DELETEITEM
465        |   TVN_BEGINLABELEDIT
466        |   TVN_ENDLABELEDIT
467        |   TVN_KEYDOWN
468        |   TVN_GETINFOTIP
469        |   TVN_SINGLEEXPAND
470        |   TTN_GETDISPINFO of string ref
471        |   TTN_SHOW
472        |   TTN_POP
473        |   TCN_KEYDOWN
474        |   TCN_SELCHANGE
475        |   TCN_SELCHANGING
476        |   TBN_GETBUTTONINFO
477        |   TBN_BEGINDRAG
478        |   TBN_ENDDRAG
479        |   TBN_BEGINADJUST
480        |   TBN_ENDADJUST
481        |   TBN_RESET
482        |   TBN_QUERYINSERT
483        |   TBN_QUERYDELETE
484        |   TBN_TOOLBARCHANGE
485        |   TBN_CUSTHELP
486        |   TBN_DROPDOWN
487        |   TBN_HOTITEMCHANGE
488        |   TBN_DRAGOUT
489        |   TBN_DELETINGBUTTON
490        |   TBN_GETDISPINFO
491        |   TBN_GETINFOTIP
492        |   UDN_DELTAPOS
493        |   RBN_GETOBJECT
494        |   RBN_LAYOUTCHANGED
495        |   RBN_AUTOSIZE
496        |   RBN_BEGINDRAG
497        |   RBN_ENDDRAG
498        |   RBN_DELETINGBAND
499        |   RBN_DELETEDBAND
500        |   RBN_CHILDSIZE
501        |   CBEN_GETDISPINFO
502        |   CBEN_DRAGBEGIN
503        |   IPN_FIELDCHANGED
504        |   SBN_SIMPLEMODECHANGE
505        |   PGN_SCROLL
506        |   PGN_CALCSIZE
507        |   NM_OTHER of int (* Catch-all for other cases. *)
508
509        local
510            (* Notification structures *)
511            val NMHDR = cStruct3(cHWND, cUINT_PTR, cUint)
512            val (toMLNmhdr, fromMLNmhdr) = structAsAddr NMHDR
513            val CHARARRAY80 = cCHARARRAY 80
514            val NMTTDISPINFO =
515                cStruct6(NMHDR, cPointer (* String or resource id *), CHARARRAY80, cHINSTANCE, cUint, cLPARAM);
516            val (toMLNMTTDISPINFO, fromMLNMTTDISPINFO) = structAsAddr NMTTDISPINFO
517        in
518            fun compileNotification (from, idFrom, NM_OUTOFMEMORY) = fromMLNmhdr(from, idFrom, ~1)
519            |  compileNotification (from, idFrom, NM_CLICK) = fromMLNmhdr(from, idFrom, ~2)
520            |  compileNotification (from, idFrom, NM_DBLCLK) = fromMLNmhdr(from, idFrom, ~3)
521            |  compileNotification (from, idFrom, NM_RETURN) = fromMLNmhdr(from, idFrom, ~4)
522            |  compileNotification (from, idFrom, NM_RCLICK) = fromMLNmhdr(from, idFrom, ~5)
523            |  compileNotification (from, idFrom, NM_RDBLCLK) = fromMLNmhdr(from, idFrom, ~6)
524            |  compileNotification (from, idFrom, NM_SETFOCUS) = fromMLNmhdr(from, idFrom, ~7)
525            |  compileNotification (from, idFrom, NM_KILLFOCUS) = fromMLNmhdr(from, idFrom, ~8)
526            |  compileNotification (from, idFrom, NM_CUSTOMDRAW) = fromMLNmhdr(from, idFrom, ~12)
527            |  compileNotification (from, idFrom, NM_HOVER) = fromMLNmhdr(from, idFrom, ~13)
528            |  compileNotification (from, idFrom, NM_NCHITTEST) = fromMLNmhdr(from, idFrom, ~14)
529            |  compileNotification (from, idFrom, NM_KEYDOWN) = fromMLNmhdr(from, idFrom, ~15)
530            |  compileNotification (from, idFrom, NM_RELEASEDCAPTURE) = fromMLNmhdr(from, idFrom, ~16)
531            |  compileNotification (from, idFrom, NM_SETCURSOR) = fromMLNmhdr(from, idFrom, ~17)
532            |  compileNotification (from, idFrom, NM_CHAR) = fromMLNmhdr(from, idFrom, ~18)
533            |  compileNotification (from, idFrom, NM_TOOLTIPSCREATED) = fromMLNmhdr(from, idFrom, ~19)
534            |  compileNotification (from, idFrom, NM_LDOWN) = fromMLNmhdr(from, idFrom, ~20)
535            |  compileNotification (from, idFrom, NM_RDOWN) = fromMLNmhdr(from, idFrom, ~21)
536            |  compileNotification (from, idFrom, NM_THEMECHANGED) = fromMLNmhdr(from, idFrom, ~22)
537            |  compileNotification (from, idFrom, LVN_ITEMCHANGING) = fromMLNmhdr(from, idFrom, ~100)
538            |  compileNotification (from, idFrom, LVN_ITEMCHANGED) = fromMLNmhdr(from, idFrom, ~101)
539            |  compileNotification (from, idFrom, LVN_INSERTITEM) = fromMLNmhdr(from, idFrom, ~102)
540            |  compileNotification (from, idFrom, LVN_DELETEITEM) = fromMLNmhdr(from, idFrom, ~103)
541            |  compileNotification (from, idFrom, LVN_DELETEALLITEMS) = fromMLNmhdr(from, idFrom, ~104)
542            |  compileNotification (from, idFrom, LVN_BEGINLABELEDIT) = fromMLNmhdr(from, idFrom, ~105)
543            |  compileNotification (from, idFrom, LVN_ENDLABELEDIT) = fromMLNmhdr(from, idFrom, ~106)
544            |  compileNotification (from, idFrom, LVN_COLUMNCLICK) = fromMLNmhdr(from, idFrom, ~108)
545            |  compileNotification (from, idFrom, LVN_BEGINDRAG) = fromMLNmhdr(from, idFrom, ~109)
546            |  compileNotification (from, idFrom, LVN_BEGINRDRAG) = fromMLNmhdr(from, idFrom, ~111)
547            |  compileNotification (from, idFrom, LVN_GETDISPINFO) = fromMLNmhdr(from, idFrom, ~150)
548            |  compileNotification (from, idFrom, LVN_SETDISPINFO) = fromMLNmhdr(from, idFrom, ~151)
549            |  compileNotification (from, idFrom, LVN_KEYDOWN) = fromMLNmhdr(from, idFrom, ~155)
550            |  compileNotification (from, idFrom, LVN_GETINFOTIP) = fromMLNmhdr(from, idFrom, ~157)
551            |  compileNotification (from, idFrom, HDN_ITEMCHANGING) = fromMLNmhdr(from, idFrom, ~300)
552            |  compileNotification (from, idFrom, HDN_ITEMCHANGED) = fromMLNmhdr(from, idFrom, ~301)
553            |  compileNotification (from, idFrom, HDN_ITEMCLICK) = fromMLNmhdr(from, idFrom, ~302)
554            |  compileNotification (from, idFrom, HDN_ITEMDBLCLICK) = fromMLNmhdr(from, idFrom, ~303)
555            |  compileNotification (from, idFrom, HDN_DIVIDERDBLCLICK) = fromMLNmhdr(from, idFrom, ~305)
556            |  compileNotification (from, idFrom, HDN_BEGINTRACK) = fromMLNmhdr(from, idFrom, ~306)
557            |  compileNotification (from, idFrom, HDN_ENDTRACK) = fromMLNmhdr(from, idFrom, ~307)
558            |  compileNotification (from, idFrom, HDN_TRACK) = fromMLNmhdr(from, idFrom, ~308)
559            |  compileNotification (from, idFrom, HDN_ENDDRAG) = fromMLNmhdr(from, idFrom, ~311)
560            |  compileNotification (from, idFrom, HDN_BEGINDRAG) = fromMLNmhdr(from, idFrom, ~310)
561            |  compileNotification (from, idFrom, HDN_GETDISPINFO) = fromMLNmhdr(from, idFrom, ~309)
562            |  compileNotification (from, idFrom, TVN_SELCHANGING) = fromMLNmhdr(from, idFrom, ~401)
563            |  compileNotification (from, idFrom, TVN_SELCHANGED) = fromMLNmhdr(from, idFrom, ~402)
564            |  compileNotification (from, idFrom, TVN_GETDISPINFO) = fromMLNmhdr(from, idFrom, ~403)
565            |  compileNotification (from, idFrom, TVN_SETDISPINFO) = fromMLNmhdr(from, idFrom, ~404)
566            |  compileNotification (from, idFrom, TVN_ITEMEXPANDING) = fromMLNmhdr(from, idFrom, ~405)
567            |  compileNotification (from, idFrom, TVN_ITEMEXPANDED) = fromMLNmhdr(from, idFrom, ~406)
568            |  compileNotification (from, idFrom, TVN_BEGINDRAG) = fromMLNmhdr(from, idFrom, ~407)
569            |  compileNotification (from, idFrom, TVN_BEGINRDRAG) = fromMLNmhdr(from, idFrom, ~408)
570            |  compileNotification (from, idFrom, TVN_DELETEITEM) = fromMLNmhdr(from, idFrom, ~409)
571            |  compileNotification (from, idFrom, TVN_BEGINLABELEDIT) = fromMLNmhdr(from, idFrom, ~410)
572            |  compileNotification (from, idFrom, TVN_ENDLABELEDIT) = fromMLNmhdr(from, idFrom, ~411)
573            |  compileNotification (from, idFrom, TVN_KEYDOWN) = fromMLNmhdr(from, idFrom, ~412)
574            |  compileNotification (from, idFrom, TVN_GETINFOTIP) = fromMLNmhdr(from, idFrom, ~413)
575            |  compileNotification (from, idFrom, TVN_SINGLEEXPAND) = fromMLNmhdr(from, idFrom, ~415)
576            |  compileNotification (from, idFrom, TTN_GETDISPINFO(ref s)) =
577                   fromMLNMTTDISPINFO((from, idFrom, ~520), Memory.null, s, Globals.hNull, 0, 0)
578            |  compileNotification (from, idFrom, TTN_SHOW) = fromMLNmhdr(from, idFrom, ~521)
579            |  compileNotification (from, idFrom, TTN_POP) = fromMLNmhdr(from, idFrom, ~522)
580            |  compileNotification (from, idFrom, TCN_KEYDOWN) = fromMLNmhdr(from, idFrom, ~550)
581            |  compileNotification (from, idFrom, TCN_SELCHANGE) = fromMLNmhdr(from, idFrom, ~551)
582            |  compileNotification (from, idFrom, TCN_SELCHANGING) = fromMLNmhdr(from, idFrom, ~552)
583            |  compileNotification (from, idFrom, TBN_GETBUTTONINFO) = fromMLNmhdr(from, idFrom, ~700)
584            |  compileNotification (from, idFrom, TBN_BEGINDRAG) = fromMLNmhdr(from, idFrom, ~701)
585            |  compileNotification (from, idFrom, TBN_ENDDRAG) = fromMLNmhdr(from, idFrom, ~702)
586            |  compileNotification (from, idFrom, TBN_BEGINADJUST) = fromMLNmhdr(from, idFrom, ~703)
587            |  compileNotification (from, idFrom, TBN_ENDADJUST) = fromMLNmhdr(from, idFrom, ~704)
588            |  compileNotification (from, idFrom, TBN_RESET) = fromMLNmhdr(from, idFrom, ~705)
589            |  compileNotification (from, idFrom, TBN_QUERYINSERT) = fromMLNmhdr(from, idFrom, ~706)
590            |  compileNotification (from, idFrom, TBN_QUERYDELETE) = fromMLNmhdr(from, idFrom, ~707)
591            |  compileNotification (from, idFrom, TBN_TOOLBARCHANGE) = fromMLNmhdr(from, idFrom, ~708)
592            |  compileNotification (from, idFrom, TBN_CUSTHELP) = fromMLNmhdr(from, idFrom, ~709)
593            |  compileNotification (from, idFrom, TBN_DROPDOWN) = fromMLNmhdr(from, idFrom, ~710)
594            |  compileNotification (from, idFrom, TBN_HOTITEMCHANGE) = fromMLNmhdr(from, idFrom, ~713)
595            |  compileNotification (from, idFrom, TBN_DRAGOUT) = fromMLNmhdr(from, idFrom, ~714)
596            |  compileNotification (from, idFrom, TBN_DELETINGBUTTON) = fromMLNmhdr(from, idFrom, ~715)
597            |  compileNotification (from, idFrom, TBN_GETDISPINFO) = fromMLNmhdr(from, idFrom, ~716)
598            |  compileNotification (from, idFrom, TBN_GETINFOTIP) = fromMLNmhdr(from, idFrom, ~718)   
599            |  compileNotification (from, idFrom, UDN_DELTAPOS) = fromMLNmhdr(from, idFrom, ~722)
600            |  compileNotification (from, idFrom, RBN_GETOBJECT) = fromMLNmhdr(from, idFrom, ~832)
601            |  compileNotification (from, idFrom, RBN_LAYOUTCHANGED) = fromMLNmhdr(from, idFrom, ~833)
602            |  compileNotification (from, idFrom, RBN_AUTOSIZE) = fromMLNmhdr(from, idFrom, ~834)
603            |  compileNotification (from, idFrom, RBN_BEGINDRAG) = fromMLNmhdr(from, idFrom, ~835)
604            |  compileNotification (from, idFrom, RBN_ENDDRAG) = fromMLNmhdr(from, idFrom, ~836)
605            |  compileNotification (from, idFrom, RBN_DELETINGBAND) = fromMLNmhdr(from, idFrom, ~837)
606            |  compileNotification (from, idFrom, RBN_DELETEDBAND) = fromMLNmhdr(from, idFrom, ~838)
607            |  compileNotification (from, idFrom, RBN_CHILDSIZE) = fromMLNmhdr(from, idFrom, ~839)
608            |  compileNotification (from, idFrom, CBEN_GETDISPINFO) = fromMLNmhdr(from, idFrom, ~800)
609            |  compileNotification (from, idFrom, CBEN_DRAGBEGIN) = fromMLNmhdr(from, idFrom, ~808)
610            |  compileNotification (from, idFrom, IPN_FIELDCHANGED) = fromMLNmhdr(from, idFrom, ~860)
611            |  compileNotification (from, idFrom, SBN_SIMPLEMODECHANGE) = fromMLNmhdr(from, idFrom, ~880)
612            |  compileNotification (from, idFrom, PGN_SCROLL) = fromMLNmhdr(from, idFrom, ~901)
613            |  compileNotification (from, idFrom, PGN_CALCSIZE) = fromMLNmhdr(from, idFrom, ~902)
614
615            |  compileNotification (from, idFrom, NM_OTHER code) = fromMLNmhdr(from, idFrom, code)
616
617            local
618                fun decompileNotifyArg (_,   ~1) = NM_OUTOFMEMORY
619                 |  decompileNotifyArg (_,   ~2) = NM_CLICK
620                 |  decompileNotifyArg (_,   ~3) = NM_DBLCLK
621                 |  decompileNotifyArg (_,   ~4) = NM_RETURN
622                 |  decompileNotifyArg (_,   ~5) = NM_RCLICK
623                 |  decompileNotifyArg (_,   ~6) = NM_RDBLCLK
624                 |  decompileNotifyArg (_,   ~7) = NM_SETFOCUS
625                 |  decompileNotifyArg (_,   ~8) = NM_KILLFOCUS
626                 |  decompileNotifyArg (_,  ~12) = NM_CUSTOMDRAW
627                 |  decompileNotifyArg (_,  ~13) = NM_HOVER
628                 |  decompileNotifyArg (_,  ~14) = NM_NCHITTEST
629                 |  decompileNotifyArg (_,  ~15) = NM_KEYDOWN
630                 |  decompileNotifyArg (_,  ~16) = NM_RELEASEDCAPTURE
631                 |  decompileNotifyArg (_,  ~17) = NM_SETCURSOR
632                 |  decompileNotifyArg (_,  ~18) = NM_CHAR
633                 |  decompileNotifyArg (_,  ~19) = NM_TOOLTIPSCREATED
634                 |  decompileNotifyArg (_,  ~20) = NM_LDOWN
635                 |  decompileNotifyArg (_,  ~21) = NM_RDOWN
636                 |  decompileNotifyArg (_,  ~22) = NM_THEMECHANGED
637                 |  decompileNotifyArg (_, ~100) = LVN_ITEMCHANGING
638                 |  decompileNotifyArg (_, ~101) = LVN_ITEMCHANGED
639                 |  decompileNotifyArg (_, ~102) = LVN_INSERTITEM
640                 |  decompileNotifyArg (_, ~103) = LVN_DELETEITEM
641                 |  decompileNotifyArg (_, ~104) = LVN_DELETEALLITEMS
642                 |  decompileNotifyArg (_, ~105) = LVN_BEGINLABELEDIT
643                 |  decompileNotifyArg (_, ~106) = LVN_ENDLABELEDIT
644                 |  decompileNotifyArg (_, ~108) = LVN_COLUMNCLICK
645                 |  decompileNotifyArg (_, ~109) = LVN_BEGINDRAG
646                 |  decompileNotifyArg (_, ~111) = LVN_BEGINRDRAG
647                 |  decompileNotifyArg (_, ~150) = LVN_GETDISPINFO
648                 |  decompileNotifyArg (_, ~151) = LVN_SETDISPINFO
649                 |  decompileNotifyArg (_, ~155) = LVN_KEYDOWN
650                 |  decompileNotifyArg (_, ~157) = LVN_GETINFOTIP
651                 |  decompileNotifyArg (_, ~300) = HDN_ITEMCHANGING
652                 |  decompileNotifyArg (_, ~301) = HDN_ITEMCHANGED
653                 |  decompileNotifyArg (_, ~302) = HDN_ITEMCLICK
654                 |  decompileNotifyArg (_, ~303) = HDN_ITEMDBLCLICK
655                 |  decompileNotifyArg (_, ~305) = HDN_DIVIDERDBLCLICK
656                 |  decompileNotifyArg (_, ~306) = HDN_BEGINTRACK
657                 |  decompileNotifyArg (_, ~307) = HDN_ENDTRACK
658                 |  decompileNotifyArg (_, ~308) = HDN_TRACK
659                 |  decompileNotifyArg (_, ~311) = HDN_ENDDRAG
660                 |  decompileNotifyArg (_, ~310) = HDN_BEGINDRAG
661                 |  decompileNotifyArg (_, ~309) = HDN_GETDISPINFO
662                 |  decompileNotifyArg (_, ~401) = TVN_SELCHANGING
663                 |  decompileNotifyArg (_, ~402) = TVN_SELCHANGED
664                 |  decompileNotifyArg (_, ~403) = TVN_GETDISPINFO
665                 |  decompileNotifyArg (_, ~404) = TVN_SETDISPINFO
666                 |  decompileNotifyArg (_, ~405) = TVN_ITEMEXPANDING
667                 |  decompileNotifyArg (_, ~406) = TVN_ITEMEXPANDED
668                 |  decompileNotifyArg (_, ~407) = TVN_BEGINDRAG
669                 |  decompileNotifyArg (_, ~408) = TVN_BEGINRDRAG
670                 |  decompileNotifyArg (_, ~409) = TVN_DELETEITEM
671                 |  decompileNotifyArg (_, ~410) = TVN_BEGINLABELEDIT
672                 |  decompileNotifyArg (_, ~411) = TVN_ENDLABELEDIT
673                 |  decompileNotifyArg (_, ~412) = TVN_KEYDOWN
674                 |  decompileNotifyArg (_, ~413) = TVN_GETINFOTIP
675                 |  decompileNotifyArg (_, ~415) = TVN_SINGLEEXPAND
676                 |  decompileNotifyArg (lp, ~520) =
677                     let
678                         val nmt = toMLNMTTDISPINFO lp
679                         (* Just look at the byte data at the moment. *)
680                     in
681                         TTN_GETDISPINFO(ref(#3 nmt))
682                     end
683                 |  decompileNotifyArg (_, ~521) = TTN_SHOW
684                 |  decompileNotifyArg (_, ~522) = TTN_POP
685                 |  decompileNotifyArg (_, ~550) = TCN_KEYDOWN
686                 |  decompileNotifyArg (_, ~551) = TCN_SELCHANGE
687                 |  decompileNotifyArg (_, ~552) = TCN_SELCHANGING
688                 |  decompileNotifyArg (_, ~700) = TBN_GETBUTTONINFO
689                 |  decompileNotifyArg (_, ~701) = TBN_BEGINDRAG
690                 |  decompileNotifyArg (_, ~702) = TBN_ENDDRAG
691                 |  decompileNotifyArg (_, ~703) = TBN_BEGINADJUST
692                 |  decompileNotifyArg (_, ~704) = TBN_ENDADJUST
693                 |  decompileNotifyArg (_, ~705) = TBN_RESET
694                 |  decompileNotifyArg (_, ~706) = TBN_QUERYINSERT
695                 |  decompileNotifyArg (_, ~707) = TBN_QUERYDELETE
696                 |  decompileNotifyArg (_, ~708) = TBN_TOOLBARCHANGE
697                 |  decompileNotifyArg (_, ~709) = TBN_CUSTHELP
698                 |  decompileNotifyArg (_, ~710) = TBN_DROPDOWN
699                 |  decompileNotifyArg (_, ~713) = TBN_HOTITEMCHANGE
700                 |  decompileNotifyArg (_, ~714) = TBN_DRAGOUT
701                 |  decompileNotifyArg (_, ~715) = TBN_DELETINGBUTTON
702                 |  decompileNotifyArg (_, ~716) = TBN_GETDISPINFO
703                 |  decompileNotifyArg (_, ~718) = TBN_GETINFOTIP (*<<<*)
704                 |  decompileNotifyArg (_, ~722) = UDN_DELTAPOS
705                 |  decompileNotifyArg (_, ~832) = RBN_GETOBJECT
706                 |  decompileNotifyArg (_, ~833) = RBN_LAYOUTCHANGED
707                 |  decompileNotifyArg (_, ~834) = RBN_AUTOSIZE
708                 |  decompileNotifyArg (_, ~835) = RBN_BEGINDRAG
709                 |  decompileNotifyArg (_, ~836) = RBN_ENDDRAG
710                 |  decompileNotifyArg (_, ~837) = RBN_DELETINGBAND
711                 |  decompileNotifyArg (_, ~838) = RBN_DELETEDBAND
712                 |  decompileNotifyArg (_, ~839) = RBN_CHILDSIZE
713                 |  decompileNotifyArg (_, ~800) = CBEN_GETDISPINFO
714                 |  decompileNotifyArg (_, ~808) = CBEN_DRAGBEGIN
715                 |  decompileNotifyArg (_, ~860) = IPN_FIELDCHANGED
716                 |  decompileNotifyArg (_, ~880) = SBN_SIMPLEMODECHANGE
717                 |  decompileNotifyArg (_, ~901) = PGN_SCROLL
718                 |  decompileNotifyArg (_, ~902) = PGN_CALCSIZE     
719                 |  decompileNotifyArg (_, code) = NM_OTHER code
720            in
721                fun decompileNotify {wp, lp} =
722                let
723                    val (hwndFrom, idFrom, code) = toMLNmhdr lp
724                    val notification = decompileNotifyArg (lp, code)
725                in
726                    { idCtrl = SysWord.toInt wp, from = hwndFrom, idFrom = idFrom, notification = notification}
727                end
728            end
729
730        end
731        
732        local
733            val cFINDREPLACE =
734                cStruct11(cDWORD, cHWND, cHINSTANCE, FindReplaceFlags.cFindReplaceFlags, cString, cString,
735                          cWORD, cWORD, cPointer, cPointer, cPointer)
736            val {load=loadFindReplace, store=storeFindReplace, ctype={size=sizeFindReplace, ...}, ...} =
737                breakConversion cFINDREPLACE
738            type findMsg = { flags: FindReplaceFlags.flags, findWhat: string, replaceWith: string }
739        in
740            fun compileFindMsg({flags, findWhat, replaceWith}: findMsg) =
741            let
742                open Memory
743                val vec = malloc sizeFindReplace
744                (* Is this right?  It's supposed to create a buffer to store the result. *)
745                val freeFR =
746                    storeFindReplace(vec,
747                        (Word.toInt sizeFindReplace, hNull, hNull, flags,
748                         findWhat, replaceWith, 0, 0, null, null, null))
749            in
750                (RegisterMessage "commdlg_FindReplace", 0w0, fromAddr vec, fn() => (freeFR(); free vec))
751            end
752            
753            fun decompileFindMsg{wp=_, lp}: findMsg =
754            let
755                val (_, _, _, flags, findwhat, replace, _, _, _, _, _) =
756                    loadFindReplace(toAddr lp)
757                (* The argument is really a FINDREPLACE struct. *)
758            in
759                {flags=flags, findWhat=findwhat, replaceWith=replace}
760            end
761        end
762        
763        val toHMENU: SysWord.word -> HMENU = handleOfVoidStar o Memory.sysWord2VoidStar
764        and fromHMENU: HMENU -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
765        val toHWND: SysWord.word -> HWND = handleOfVoidStar o Memory.sysWord2VoidStar
766        and fromHWND: HWND -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
767        val toHDC: SysWord.word -> HDC = handleOfVoidStar o Memory.sysWord2VoidStar
768        and fromHDC: HDC -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
769        val toHFONT: SysWord.word -> HFONT = handleOfVoidStar o Memory.sysWord2VoidStar
770        and fromHFONT: HFONT -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
771        val toHRGN: SysWord.word -> HRGN = handleOfVoidStar o Memory.sysWord2VoidStar
772        and fromHRGN: HRGN -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
773        val toHDROP: SysWord.word -> HDROP = handleOfVoidStar o Memory.sysWord2VoidStar
774        and fromHDROP: HDROP -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
775        val toHICON: SysWord.word -> HICON = handleOfVoidStar o Memory.sysWord2VoidStar
776        and fromHICON: HICON -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
777        val toHGDIOBJ: SysWord.word -> HGDIOBJ = handleOfVoidStar o Memory.sysWord2VoidStar
778        and fromHGDIOBJ: HGDIOBJ -> SysWord.word = Memory.voidStar2Sysword o voidStarOfHandle
779
780        (* Maybe we should have two different types for horizontal and vertical. *)
781        datatype ScrollDirection =
782            SB_BOTTOM | SB_ENDSCROLL | SB_LINEDOWN | SB_LINEUP | SB_PAGEDOWN | SB_PAGEUP |
783            SB_THUMBPOSITION | SB_THUMBTRACK | SB_TOP | SB_LEFT | SB_RIGHT | SB_LINELEFT |
784            SB_LINERIGHT | SB_PAGELEFT | SB_PAGERIGHT
785        local
786            val tab = [
787                (SB_LINEUP,     0w0: word),
788                (SB_LINELEFT,   0w0),
789                (SB_LINEDOWN,   0w1),
790                (SB_LINERIGHT,  0w1),
791                (SB_PAGEUP,     0w2),
792                (SB_PAGELEFT,   0w2),
793                (SB_PAGEDOWN,   0w3),
794                (SB_PAGERIGHT,  0w3),
795                (SB_THUMBPOSITION, 0w4),
796                (SB_THUMBTRACK, 0w5),
797                (SB_TOP,        0w6),
798                (SB_LEFT,       0w6),
799                (SB_BOTTOM,     0w7),
800                (SB_RIGHT,      0w7),
801                (SB_ENDSCROLL,  0w8)
802                ]
803        in
804            val (toCsd, fromCsd) = tableLookup(tab, NONE)
805        end
806
807        (* This is a bit of a mess.  Various operations take or return handles to
808           these types of image and also take this value as a parameter. *)
809        datatype ImageType = IMAGE_BITMAP | IMAGE_CURSOR | IMAGE_ENHMETAFILE | IMAGE_ICON
810    
811        local
812            val tab = [
813                (IMAGE_BITMAP, 0),
814                (IMAGE_ICON, 1),
815                (IMAGE_CURSOR, 2),
816                (IMAGE_ENHMETAFILE, 3)
817                ]
818        in
819            val (toCit, fromCit) = tableLookup(tab, NONE)
820        end
821
822        val (toCcbf, fromCcbf) = clipLookup
823        datatype MouseKeyFlags = MK_LBUTTON | MK_RBUTTON | MK_SHIFT | MK_CONTROL | MK_MBUTTON
824
825        local
826            val tab = [
827                (MK_LBUTTON,        0wx0001),
828                (MK_RBUTTON,        0wx0002),
829                (MK_SHIFT,          0wx0004),
830                (MK_CONTROL,        0wx0008),
831                (MK_MBUTTON,        0wx0010)
832                ]
833        in
834            val (toCmkf, fromCmkf) = tableSetLookup(tab, NONE)
835        end
836        
837
838        datatype MDITileFlags = MDITILE_VERTICAL | MDITILE_HORIZONTAL | MDITILE_SKIPDISABLED
839
840        local
841            val tab = [
842                (MDITILE_VERTICAL,      0wx0000),
843                (MDITILE_HORIZONTAL,    0wx0001),
844                (MDITILE_SKIPDISABLED,  0wx0002)
845                ]
846        in
847            val (toCmdif, fromCmdif) = tableSetLookup(tab, NONE)
848        end
849
850        datatype WMPrintOption = 
851            PRF_CHECKVISIBLE | PRF_NONCLIENT | PRF_CLIENT | PRF_ERASEBKGND |
852            PRF_CHILDREN | PRF_OWNED
853
854        local
855            val tab = [
856                (PRF_CHECKVISIBLE,      0wx00000001),
857                (PRF_NONCLIENT,         0wx00000002),
858                (PRF_CLIENT,            0wx00000004),
859                (PRF_ERASEBKGND,        0wx00000008),
860                (PRF_CHILDREN,          0wx00000010),
861                (PRF_OWNED,             0wx00000020)
862                ]
863        in
864            val (toCwmpl, fromCwmpl) = tableSetLookup(tab, NONE)
865        end
866
867        val (toCcbal, fromCcbal) = ComboBase.CBDIRATTRS
868        val (toCesbf, fromCesbf) = ScrollBase.ENABLESCROLLBARFLAG
869
870        (*fun itob i = i <> 0*)
871        
872        (* These deal with signed quantities.  LOWORD/HIWORD deal with words *)
873        local
874            val shift32 = Word.fromInt(SysWord.wordSize-32)
875            and shift16 = Word.fromInt(SysWord.wordSize-16)
876            open SysWord
877            infix 5 << ~>>
878            infix 7 andb
879            infix 6 orb
880            (* Y is the high order word, X is the low order word. *)
881        in
882            fun getYLParam (i: SysWord.word) = toIntX((i << shift32) ~>> shift16)
883            and getXLParam (i: SysWord.word) = toIntX((i << shift16) ~>> shift16)
884            
885            fun makeXYParam (x, y) = ((fromInt y andb 0wxffff) << 0w16) orb (fromInt x andb 0wxffff)
886        end
887    in
888        type flags = WinBase.Style.flags
889        and WindowPositionStyle = WinBase.WindowPositionStyle
890        
891        datatype ControlType = datatype ControlType
892        datatype ScrollDirection = datatype ScrollDirection
893
894        datatype HitTest =
895            HTBORDER
896        |   HTBOTTOM
897        |   HTBOTTOMLEFT
898        |   HTBOTTOMRIGHT
899        |   HTCAPTION
900        |   HTCLIENT
901        |   HTCLOSE
902        |   HTERROR
903        |   HTGROWBOX
904        |   HTHELP
905        |   HTHSCROLL
906        |   HTLEFT
907        |   HTMENU
908        |   HTMAXBUTTON
909        |   HTMINBUTTON
910        |   HTNOWHERE
911        |   HTREDUCE
912        |   HTRIGHT
913        |   HTSIZE
914        |   HTSYSMENU
915        |   HTTOP
916        |   HTTOPLEFT
917        |   HTTOPRIGHT
918        |   HTTRANSPARENT
919        |   HTVSCROLL
920        |   HTZOOM
921
922        datatype LRESULT =
923            LRESINT of int
924        |   LRESHANDLE of HGDIOBJ
925
926        datatype ImageType = datatype ImageType
927
928        (* WM_SIZE options. *)
929        datatype WMSizeOptions =
930            SIZE_RESTORED | SIZE_MINIMIZED | SIZE_MAXIMIZED | SIZE_MAXSHOW | SIZE_MAXHIDE
931        local
932            val tab = [
933                (SIZE_RESTORED,       0w0: SysWord.word),
934                (SIZE_MINIMIZED,      0w1),
935                (SIZE_MAXIMIZED,      0w2),
936                (SIZE_MAXSHOW,        0w3),
937                (SIZE_MAXHIDE,        0w4)
938                ]
939        in
940            val (fromWMSizeOpt, toWMSizeOpt) = tableLookup(tab, NONE)
941        end
942
943        (* WM_ACTIVATE options *)
944        datatype WMActivateOptions = WA_INACTIVE | WA_ACTIVE | WA_CLICKACTIVE
945        local
946            val 
947            tab = [
948                (WA_INACTIVE,       0w0: word),
949                (WA_ACTIVE,         0w1),
950                (WA_CLICKACTIVE,    0w2)
951                ]
952        in
953            val (fromWMactive, toWMactive) = tableLookup(tab, NONE)
954        end
955
956        datatype SystemCommand =
957            SC_SIZE | SC_MOVE | SC_MINIMIZE | SC_MAXIMIZE | SC_NEXTWINDOW | SC_PREVWINDOW |
958            SC_CLOSE | SC_VSCROLL | SC_HSCROLL | SC_MOUSEMENU | SC_KEYMENU | SC_ARRANGE |
959            SC_RESTORE | SC_TASKLIST | SC_SCREENSAVE | SC_HOTKEY | SC_DEFAULT |
960            SC_MONITORPOWER | SC_CONTEXTHELP | SC_SEPARATOR
961        local
962            val tab = [
963                (SC_SIZE,           0xF000),
964                (SC_MOVE,           0xF010),
965                (SC_MINIMIZE,       0xF020),
966                (SC_MAXIMIZE,       0xF030),
967                (SC_NEXTWINDOW,     0xF040),
968                (SC_PREVWINDOW,     0xF050),
969                (SC_CLOSE,          0xF060),
970                (SC_VSCROLL,        0xF070),
971                (SC_HSCROLL,        0xF080),
972                (SC_MOUSEMENU,      0xF090),
973                (SC_KEYMENU,        0xF100),
974                (SC_ARRANGE,        0xF110),
975                (SC_RESTORE,        0xF120),
976                (SC_TASKLIST,       0xF130),
977                (SC_SCREENSAVE,     0xF140),
978                (SC_HOTKEY,         0xF150),
979                (SC_DEFAULT,        0xF160),
980                (SC_MONITORPOWER,   0xF170),
981                (SC_CONTEXTHELP,    0xF180)]
982        in
983            val (fromSysCommand, toSysCommand) = tableLookup(tab, NONE)
984        end
985
986        datatype EMCharFromPos =
987            EMcfpEdit of POINT
988        |   EMcfpRichEdit of POINT
989        |   EMcfpUnknown of SysWord.word
990
991        datatype WMPrintOption = datatype WMPrintOption
992
993        (* Parameters to EM_SETMARGINS. *)
994        datatype MarginSettings = 
995            UseFontInfo | Margins of {left: int option, right: int option }
996
997        datatype MouseKeyFlags = datatype MouseKeyFlags
998        datatype MDITileFlags = datatype MDITileFlags
999
1000        (* TODO: Perhaps use a record for this.  It's always possible to use
1001           functions from Word32 though. *)
1002        type KeyData = Word32.word
1003        datatype Notification = datatype Notification
1004        datatype HelpHandle = datatype HelpHandle
1005
1006        local
1007            val tab =
1008            [
1009                (HTBORDER,      18),
1010                (HTBOTTOM,      15),
1011                (HTBOTTOMLEFT,  16),
1012                (HTBOTTOMRIGHT, 17),
1013                (HTCAPTION,     2),
1014                (HTCLIENT,      1),
1015                (HTCLOSE,       20),
1016                (HTERROR,       ~2),
1017                (HTGROWBOX,     4),
1018                (HTHELP,        21),
1019                (HTHSCROLL,     6),
1020                (HTLEFT,        10),
1021                (HTMENU,        5),
1022                (HTMAXBUTTON,   9),
1023                (HTMINBUTTON,   8),
1024                (HTNOWHERE,     0),
1025                (HTREDUCE,      8),
1026                (HTRIGHT,       11),
1027                (HTSIZE,        4),
1028                (HTSYSMENU,     3),
1029                (HTTOP,         12),
1030                (HTTOPLEFT,     13),
1031                (HTTOPRIGHT,    14),
1032                (HTTRANSPARENT, ~1),
1033                (HTVSCROLL,     7),
1034                (HTZOOM,        9)
1035            ]
1036        in
1037            val (fromHitTest, toHitTest) =
1038                tableLookup(tab, SOME(fn _ => HTERROR, fn _ => ~2))
1039                    (* Include default just in case a new value is added some time *)
1040        end
1041
1042
1043        type findReplaceFlags = FindReplaceFlags.flags
1044        type windowFlags = flags
1045
1046        datatype Message     =
1047            WM_NULL
1048
1049        |   WM_ACTIVATE of {active: WMActivateOptions, minimize: bool }
1050                  (* Indicates a change in activation state *)
1051
1052        |   WM_ACTIVATEAPP of {active: bool, threadid: int  } 
1053          (* Notifies applications when a new task activates *)
1054
1055        |   WM_ASKCBFORMATNAME of { length: int, formatName: string ref} 
1056          (* Retrieves the name of the clipboard format *)
1057
1058        |   WM_CANCELJOURNAL  
1059          (* Notifies application when user cancels journaling *)
1060
1061        |   WM_CANCELMODE 
1062          (* Notifies a Window to cancel internal modes *)
1063
1064        |   WM_CHANGECBCHAIN of { removed: HWND, next: HWND  }  
1065          (* Notifies clipboard viewer of removal from chain *)
1066
1067        |   WM_CHAR of {charCode: char, data: KeyData }                     
1068          (* Indicates the user pressed a character key *)
1069
1070        |   WM_CHARTOITEM of {key: int, caretpos: int, listbox: HWND  }
1071          (* Provides list-box keystrokes to owner Window *)
1072
1073        |   WM_CHILDACTIVATE  
1074          (* Notifies a child Window of activation *)
1075
1076        (* This is WM_USER+1.  It's only used in a GetFont dialogue box.
1077        |   WM_CHOOSEFONT_GETLOGFONT of LOGFONT ref *)
1078          (* Retrieves LOGFONT structure for Font dialog box *)
1079
1080        |   WM_CLEAR
1081          (* Clears an edit control *)
1082
1083        |   WM_CLOSE      
1084          (* System Close menu command was chosen *)
1085
1086        |   WM_COMMAND of {notifyCode: int, wId: int, control: HWND }
1087          (* Specifies a command message *)
1088
1089        |   WM_COMPAREITEM of (* Determines position of combo- or list-box item *)
1090            {
1091                controlid: int, ctlType: ControlType, ctlID: int, hItem: HWND,
1092                itemID1: int, itemData1: SysWord.word, itemID2: int, itemData2: SysWord.word                                        
1093            }
1094
1095        |   WM_COPY (* Copies a selection to the clipboard *)
1096
1097        |   WM_CREATE of
1098            { instance: HINSTANCE, creation: Foreign.Memory.voidStar, menu: HMENU, parent: HWND, cy: int, cx: int,
1099              y: int, x: int, style: windowFlags, name: string, (* The class may be a string or an atom. *)
1100              class: ClassType, extendedstyle: int }
1101          (* Indicates a Window is being created *)
1102
1103        |   WM_CTLCOLORBTN of { displaycontext: HDC, button: HWND }
1104          (* Button is about to be drawn *)
1105
1106        |   WM_CTLCOLORDLG of { displaycontext: HDC, dialogbox: HWND  }
1107          (* Dialog box is about to be drawn *)
1108
1109        |   WM_CTLCOLOREDIT of {  displaycontext: HDC, editcontrol: HWND  }
1110          (* Control is about to be drawn *)
1111
1112        |   WM_CTLCOLORLISTBOX of { displaycontext: HDC, listbox: HWND   }
1113          (* List box is about to be drawn *)
1114
1115        |   WM_CTLCOLORMSGBOX of { displaycontext: HDC, messagebox: HWND  }
1116          (* Message box is about to be drawn *)
1117
1118        |   WM_CTLCOLORSCROLLBAR of { displaycontext: HDC, scrollbar: HWND  }
1119          (* Indicates scroll bar is about to be drawn *)
1120
1121        |   WM_CTLCOLORSTATIC of { displaycontext: HDC, staticcontrol: HWND }
1122          (* Control is about to be drawn *)
1123          (* Note the return value is an HBRUSH *)
1124
1125        |   WM_CUT
1126          (* Deletes a selection and copies it to the clipboard *)
1127
1128        |   WM_DEADCHAR of { charCode: char, data: KeyData }
1129          (* Indicates the user pressed a dead key *)
1130
1131        |   WM_DELETEITEM of { senderId: int, ctlType: ControlType, ctlID: int, itemID: int, item: HWND, itemData: int }
1132          (* Indicates owner-draw item or control was altered *)
1133
1134        |   WM_DESTROY    
1135          (* Indicates Window is about to be destroyed *)
1136
1137        |   WM_DESTROYCLIPBOARD   
1138          (* Notifies owner that the clipboard was emptied *)
1139
1140        |   WM_DEVMODECHANGE of { devicename: string }   
1141          (* Indicates the device-mode settings have changed *)
1142
1143        |   WM_DRAWCLIPBOARD  
1144          (* Indicates the clipboard's contents have changed *) 
1145
1146        |   WM_DRAWITEM of
1147                { senderId: int, ctlType: ControlType, ctlID: int, itemID: int, itemAction: int,
1148                  itemState: int, hItem: HWND , hDC: HDC, rcItem: RECT, itemData: int }   
1149          (* Indicates owner-draw control/menu needs redrawing *) 
1150
1151        |   WM_DROPFILES of { hDrop: HDROP } 
1152          (* Indicates that a file has been dropped *)
1153
1154        |   WM_ENABLE of { enabled: bool }
1155          (* Indicates a Window's enable state is changing *)
1156
1157        |   WM_ENDSESSION of { endsession: bool }
1158          (* Indicates whether the Windows session is ending *)
1159
1160        |   WM_ENTERIDLE of { flag: int, window: HWND }
1161          (* Indicates a modal dialog box or menu is idle *)
1162
1163        |   WM_ENTERMENULOOP of { istrack: bool }
1164          (* Indicates entry into menu modal loop *)
1165
1166        |   WM_EXITMENULOOP of { istrack: bool }
1167          (* Indicates exit from menu modal loop *)
1168
1169        |   WM_ERASEBKGND of { devicecontext: HDC }
1170          (* Indicates a Window's background need erasing *)
1171
1172        |   WM_FONTCHANGE
1173          (* Indicates a change in the font-resource pool *)
1174
1175        |   WM_GETDLGCODE
1176          (* Allows dialog procedure to process control input
1177             TODO: This has parameters! *)
1178
1179        |   WM_GETFONT    
1180          (* Retrieves the font that a control is using *)
1181
1182        |   WM_GETHOTKEY
1183          (* Gets the virtual-key code of a Window's hot key *) 
1184
1185        |   WM_GETMINMAXINFO of
1186             { maxSize: POINT ref, maxPosition: POINT ref,
1187               minTrackSize: POINT ref, maxTrackSize: POINT ref }
1188          (* Gets minimum and maximum sizing information *)
1189
1190        |   WM_GETTEXT of { length: int, text: string ref  } 
1191          (* Gets the text that corresponds to a Window *)
1192
1193        |   WM_GETTEXTLENGTH  
1194          (* Gets length of text associated with a Window *)
1195
1196        |   WM_HOTKEY of { id: int }
1197          (* Hot key has been detected *)
1198
1199        |   WM_HSCROLL of { value: ScrollDirection, position: int, scrollbar: HWND  }    
1200          (* Indicates a click in a horizontal scroll bar *)
1201
1202        |   WM_HSCROLLCLIPBOARD of { viewer: HWND, code: int, position: int  }    
1203          (* Prompts owner to scroll clipboard contents *)
1204
1205        |   WM_ICONERASEBKGND of { devicecontext: HDC }
1206          (* Notifies minimized Window to fill icon background *)
1207
1208        |   WM_INITDIALOG of { dialog: HWND, initdata: int  }
1209          (* Initializes a dialog box *)
1210
1211        |   WM_INITMENU of { menu: HMENU }   
1212          (* Indicates a menu is about to become active *)
1213
1214        |   WM_INITMENUPOPUP of { menupopup: HMENU, itemposition: int, isSystemMenu: bool  }
1215          (* Indicates a pop-up menu is being created *)
1216
1217        |   WM_KEYDOWN of { virtualKey: int, data: KeyData  }   
1218          (* Indicates a nonsystem key was pressed *)
1219
1220        |   WM_KEYUP of { virtualKey: int, data: KeyData  } 
1221          (* Indicates a nonsystem key was released *)
1222
1223        |   WM_KILLFOCUS of { receivefocus: HWND }
1224          (* Indicates the Window is losing keyboard focus *)
1225
1226        |   WM_LBUTTONDBLCLK of { keyflags: MouseKeyFlags list, x: int, y: int  }
1227          (* Indicates double-click of left button *) 
1228
1229        |   WM_LBUTTONDOWN of { keyflags: MouseKeyFlags list, x: int, y: int  }
1230          (* Indicates when left mouse button is pressed *)
1231
1232        |   WM_LBUTTONUP of { keyflags: MouseKeyFlags list, x: int, y: int  }
1233          (* Indicates when left mouse button is released *)
1234
1235        |   WM_MBUTTONDBLCLK of { keyflags: MouseKeyFlags list, x: int, y: int  }
1236          (* Indicates double-click of middle mouse button *)
1237
1238        |   WM_MBUTTONDOWN of { keyflags: MouseKeyFlags list, x: int, y: int  }
1239          (* Indicates when middle mouse button is pressed *)
1240
1241        |   WM_MBUTTONUP of { keyflags: MouseKeyFlags list, x: int, y: int  }
1242          (* Indicates when middle mouse button is released *)
1243  
1244        |   WM_MDICASCADE of { skipDisabled: bool  } 
1245          (* Arranges MDI child Windows in cascade format *)
1246
1247        |   WM_MDICREATE of
1248            { class: ClassType, title: string, instance: HINSTANCE, x: int, y: int,
1249              cx: int, cy: int, style: int, cdata: int }  
1250          (* Prompts MDI client to create a child Window *) 
1251
1252        |   WM_MDIDESTROY of { child: HWND  }    
1253          (* Closes an MDI child Window *) 
1254
1255        |   WM_MDIGETACTIVE
1256          (* Retrieves data about the active MDI child Window *) 
1257
1258        |   WM_MDIICONARRANGE 
1259          (* Arranges minimized MDI child Windows *) 
1260
1261        |   WM_MDIMAXIMIZE of {  child: HWND  }   
1262          (* Maximizes an MDI child Window *) 
1263
1264        |   WM_MDINEXT of { child: HWND, flagnext: bool  }
1265          (* Activates the next MDI child Window *) 
1266
1267        |   WM_MDIREFRESHMENU
1268          (* Refreshes an MDI frame Window's menu *) 
1269
1270        |   WM_MDIRESTORE of {  child: HWND  }
1271          (* Prompts MDI client to restore a child Window *) 
1272
1273        |   WM_MDISETMENU  of { frameMenu: HMENU, windowMenu: HMENU  } 
1274          (* Replaces an MDI frame Window's menu *) 
1275
1276        |   WM_MDITILE of { tilingflag: MDITileFlags list }
1277          (* Arranges MDI child Windows in tiled format *) 
1278
1279        |   WM_MEASUREITEM of
1280            { senderId: int, ctlType: ControlType, ctlID: int, itemID: int, itemWidth: int ref, itemHeight: int ref, itemData: int }  
1281          (* Requests dimensions of owner-draw control or item *)
1282
1283        |   WM_MENUCHAR of { ch: char, menuflag: MenuBase.MenuFlag, menu: HMENU }  
1284          (* Indicates an unknown menu mnemonic was pressed *)
1285
1286        |   WM_MENUSELECT of { menuitem: int, menuflags: MenuBase.MenuFlag list, menu: HMENU  }
1287          (* Indicates that the user selected a menu item *)
1288
1289        |   WM_MOUSEACTIVATE of { parent: HWND, hitTest: HitTest, message: int }
1290          (* Indicates a mouse click in an inactive Window *) 
1291
1292        |   WM_MOUSEMOVE of { keyflags: MouseKeyFlags list, x: int, y: int }  
1293          (* Indicates mouse-cursor movement *)
1294
1295        |   WM_MOUSEHOVER of { keyflags: MouseKeyFlags list, x: int, y: int }
1296            (* Indicates the mouse hovering in the client area *)
1297    
1298        |   WM_MOUSELEAVE
1299            (* Indicates the mouse leaving the client area *)
1300
1301        |   WM_MOVE of { x: int, y: int  }  
1302          (* Indicates a Window's position has changed *)
1303
1304        |   WM_NCACTIVATE of { active: bool }
1305          (* Changes the active state of nonclient area *)
1306
1307        |   WM_NCCALCSIZE of
1308            { validarea: bool, newrect: RECT ref, oldrect: RECT, oldclientarea: RECT,
1309              hwnd: HWND, insertAfter: HWND, x: int, y: int, cx: int, cy: int, style: WindowPositionStyle list}
1310          (* Calculates the size of a Window's client area *)
1311
1312        |   WM_NCCREATE of
1313            { instance: HINSTANCE, creation: Foreign.Memory.voidStar, menu: HMENU, parent: HWND, cy: int, cx: int,
1314              y: int, x: int, style: windowFlags, name: string, class: ClassType, extendedstyle: int } 
1315          (* Indicates a Window's nonclient area being created *)
1316
1317        |   WM_NCDESTROY  
1318          (* Indicates Window's nonclient area being destroyed *)
1319
1320        |   WM_NCHITTEST of { x: int, y: int  } 
1321          (* Indicates mouse-cursor movement *)
1322
1323        |   WM_NCLBUTTONDBLCLK of { hitTest: HitTest, x: int, y: int  }    
1324          (* Indicates nonclient left button double-click *)
1325
1326        |   WM_NCLBUTTONDOWN  of { hitTest: HitTest, x: int, y: int  } 
1327          (* Indicates left button pressed in nonclient area *)
1328
1329        |   WM_NCLBUTTONUP of { hitTest: HitTest, x: int, y: int  }    
1330          (* Indicates left button released in nonclient area *)
1331
1332        |   WM_NCMBUTTONDBLCLK of { hitTest: HitTest, x: int, y: int  }    
1333          (* Indicates nonclient middle button double-click *)
1334
1335        |   WM_NCMBUTTONDOWN of { hitTest: HitTest, x: int, y: int  }  
1336          (* Indicates middle button pressed in nonclient area *)
1337
1338        |   WM_NCMBUTTONUP of { hitTest: HitTest, x: int, y: int  }    
1339          (* Indicates middle button released in nonclient area *)
1340
1341        |   WM_NCMOUSEMOVE of { hitTest: HitTest, x: int, y: int  }    
1342          (* Indicates mouse-cursor movement in nonclient area *)
1343
1344        |   WM_NCMOUSEHOVER of { hitTest: HitTest, x: int, y: int  }
1345            (* Indicates the mouse hovering in the nonclient area *)
1346    
1347        |   WM_NCMOUSELEAVE
1348            (* Indicates the mouse leaving the nonclient area *)
1349
1350        |   WM_NCPAINT of { region: HRGN  }  
1351          (* Indicates a Window's frame needs painting *)
1352
1353        |   WM_NCRBUTTONDBLCLK of { hitTest: HitTest, x: int, y: int  }    
1354          (* Indicates nonclient right button double-click *)
1355
1356        |   WM_NCRBUTTONDOWN of { hitTest: HitTest, x: int, y: int  }  
1357          (* Indicates right button pressed in nonclient area *)
1358
1359        |   WM_NCRBUTTONUP of { hitTest: HitTest, x: int, y: int  }    
1360          (* Indicates right button released in nonclient area *)
1361
1362        |   WM_NEXTDLGCTL of { control: int, handleflag: bool  } 
1363          (* Sets focus to different dialog box control *) 
1364
1365        |   WM_PAINT  
1366          (* Indicates a Window's client area need painting *)
1367
1368        |   WM_PAINTCLIPBOARD of { clipboard: HWND }
1369          (* Prompts owner to display clipboard contents *)
1370
1371        |   WM_PAINTICON
1372          (* Icon is about to be painted *) 
1373
1374        |   WM_PALETTECHANGED of { palChg: HWND  }   
1375          (* Indicates the focus-Window realized its palette *)
1376
1377        |   WM_PALETTEISCHANGING of { realize: HWND  }   
1378          (* Informs Windows that palette is changing *) 
1379
1380        |   WM_PARENTNOTIFY of { eventflag: int, idchild: int, value: int }  
1381          (* Notifies parent of child-Window activity *) 
1382
1383        |   WM_PASTE  
1384          (* Inserts clipboard data into an edit control *)
1385
1386        |   WM_POWER of { powerevent: int  } 
1387          (* Indicates the system is entering suspended mode *)
1388
1389        |   WM_QUERYDRAGICON  
1390          (* Requests a cursor handle for a minimized Window *)
1391
1392        |   WM_QUERYENDSESSION of { source: int  }
1393          (* Requests that the Windows session be ended *) 
1394
1395        |   WM_QUERYNEWPALETTE
1396          (* Allows a Window to realize its logical palette *) 
1397
1398        |   WM_QUERYOPEN
1399          (* Requests that a minimized Window be restored *) 
1400
1401        |   WM_QUEUESYNC
1402          (* Delimits CBT messages *) 
1403
1404        |   WM_QUIT of { exitcode: int  }    
1405          (* Requests that an application be terminated *)
1406
1407        |   WM_RBUTTONDBLCLK of { keyflags: MouseKeyFlags list, x: int, y: int  }    
1408          (* Indicates double-click of right mouse button *)
1409
1410        |   WM_RBUTTONDOWN of { keyflags: MouseKeyFlags list, x: int, y: int  }  
1411          (* Indicates when right mouse button is pressed *)
1412
1413        |   WM_RBUTTONUP of { keyflags: MouseKeyFlags list, x: int, y: int  }
1414          (* Indicates when right mouse button is released *) 
1415
1416        |   WM_RENDERALLFORMATS   
1417          (* Notifies owner to render all clipboard formats *) 
1418
1419        |   WM_RENDERFORMAT of { format: ClipboardFormat  }  
1420          (* Notifies owner to render clipboard data *) 
1421
1422        |   WM_SETCURSOR of { cursorwindow: HWND, hitTest: HitTest, mousemessage: int }
1423          (* Prompts a Window to set the cursor shape *) 
1424
1425        |   WM_SETFOCUS of { losing: HWND  }
1426
1427        |   WM_SETFONT of {font: HFONT, redrawflag: bool  } 
1428
1429        |   WM_SETHOTKEY of { virtualKey: int  } 
1430
1431        |   WM_SETREDRAW of { redrawflag: bool  }
1432
1433        |   WM_SETTEXT of { text: string  }  
1434
1435        |   WM_SHOWWINDOW of { showflag: bool, statusflag: int  } 
1436
1437        |   WM_SIZE of { flag: WMSizeOptions, width: int, height: int  }   
1438
1439        |   WM_SIZECLIPBOARD of { viewer: HWND}
1440
1441        |   WM_SYSCHAR of { charCode: char, data: KeyData  }
1442
1443        |   WM_SYSCOLORCHANGE
1444
1445        |   WM_SYSCOMMAND of { commandvalue: SystemCommand, sysBits: int, p: POINT }
1446
1447        |   WM_SYSDEADCHAR of { charCode: char, data: KeyData  }
1448
1449        |   WM_SYSKEYDOWN of { virtualKey: int, data: KeyData  }
1450
1451        |   WM_SYSKEYUP of { virtualKey: int, data: KeyData  }
1452
1453        |   WM_TIMECHANGE 
1454          (* Indicates the system time has been set *)
1455
1456        |   WM_TIMER of { timerid: int  }
1457
1458        |   WM_UNDO   
1459
1460        |   WM_SYSTEM_OTHER of { uMsg: int, wParam: SysWord.word, lParam: SysWord.word }
1461        |   WM_USER of { uMsg: int, wParam: SysWord.word, lParam: SysWord.word }
1462        |   WM_APP of { uMsg: int, wParam: SysWord.word, lParam: SysWord.word }
1463        |   WM_REGISTERED of { uMsg: int, wParam: SysWord.word, lParam: SysWord.word }
1464
1465        |   WM_VKEYTOITEM of { virtualKey: int,
1466                             caretpos: int,
1467                             listbox: HWND  }
1468
1469        |   WM_VSCROLL of { value: ScrollDirection,
1470                          position: int,
1471                          scrollbar: HWND  }
1472
1473        |   WM_VSCROLLCLIPBOARD of { viewer: HWND,
1474                                   code: int,
1475                                   position: int  }
1476
1477        |   WM_WINDOWPOSCHANGED of
1478                { hwnd: HWND, front: HWND, x: int, y: int, width: int, height: int, flags: WindowPositionStyle list }
1479
1480        |   WM_WINDOWPOSCHANGING of
1481                {
1482                    hwnd: HWND, front: HWND ref, x: int ref, y: int ref,
1483                    width: int ref, height: int ref, flags: WindowPositionStyle list ref
1484                }
1485
1486        |   WM_NOTIFY of {from: HWND, idCtrl: int, idFrom: int, notification: Notification }
1487
1488        |   WM_CAPTURECHANGED of { newCapture: HWND }
1489
1490        |   WM_ENTERSIZEMOVE
1491
1492        |   WM_EXITSIZEMOVE
1493
1494        |   WM_PRINT of {hdc: HDC, flags: WMPrintOption list }
1495
1496        |   WM_PRINTCLIENT of {hdc: HDC, flags: WMPrintOption list }
1497
1498        |   WM_HELP of { ctrlId: int, itemHandle: HelpHandle, contextId: int, mousePos: POINT }
1499
1500        |   WM_GETICON of { big: bool }
1501
1502        |   WM_SETICON of { big: bool, icon: HICON }
1503
1504        |   WM_CONTEXTMENU of { hwnd: HWND, xPos: int, yPos: int }
1505
1506        |   WM_DISPLAYCHANGE of { bitsPerPixel: int, xScreen: int, yScreen: int }
1507
1508        |   EM_CANUNDO
1509
1510        |   EM_CHARFROMPOS of EMCharFromPos
1511
1512        |   EM_EMPTYUNDOBUFFER
1513
1514        |   EM_FMTLINES of {addEOL: bool}
1515
1516        |   EM_GETFIRSTVISIBLELINE
1517
1518        |   EM_GETLIMITTEXT
1519
1520        |   EM_GETLINE of { lineNo: int, size: int, result: string ref }
1521
1522        |   EM_GETLINECOUNT
1523
1524        |   EM_GETMARGINS
1525
1526        |   EM_GETMODIFY
1527
1528        |   EM_GETPASSWORDCHAR
1529
1530        |   EM_GETRECT of {rect: RECT ref}
1531
1532        |   EM_GETSEL of {startPos: int ref, endPos: int ref}
1533
1534        |   EM_GETTHUMB
1535
1536        |   EM_LIMITTEXT of {limit: int}
1537
1538        |   EM_LINEFROMCHAR of {index: int}
1539
1540        |   EM_LINEINDEX of {line: int}
1541
1542        |   EM_LINELENGTH of {index: int}
1543
1544        |   EM_LINESCROLL of {xScroll: int, yScroll: int}
1545
1546        |   EM_POSFROMCHAR of {index: int}
1547
1548        |   EM_REPLACESEL of {canUndo: bool, text: string}
1549
1550        |   EM_SCROLL of {action: ScrollDirection}
1551
1552        |   EM_SCROLLCARET
1553
1554        |   EM_SETMARGINS of {margins: MarginSettings}
1555
1556        |   EM_SETMODIFY of { modified: bool }
1557
1558        |   EM_SETPASSWORDCHAR of { ch: char }
1559
1560        |   EM_SETREADONLY of { readOnly: bool }
1561
1562        |   EM_SETRECT of {rect: RECT}
1563
1564        |   EM_SETRECTNP of {rect: RECT}
1565
1566        |   EM_SETSEL of {startPos: int, endPos: int}
1567
1568        |   EM_SETTABSTOPS of {tabs: IntVector.vector}
1569
1570        |   EM_UNDO
1571
1572        |   BM_CLICK
1573
1574        |   BM_GETCHECK
1575
1576        |   BM_GETIMAGE of {imageType: ImageType}
1577
1578        |   BM_GETSTATE
1579
1580        |   BM_SETCHECK of {state: int}
1581
1582        |   BM_SETIMAGE of {image: HGDIOBJ, imageType: ImageType}
1583
1584        |   BM_SETSTATE of {highlight: bool }
1585
1586        |   BM_SETSTYLE of {redraw: bool, style: windowFlags}
1587
1588        |   CB_GETEDITSEL of {startPos: int ref, endPos: int ref}
1589
1590        |   CB_LIMITTEXT of {limit: int}
1591
1592        |   CB_SETEDITSEL of {startPos: int, endPos: int}
1593
1594        |   CB_ADDSTRING of { text: string }
1595
1596        |   CB_DELETESTRING of { index: int }
1597
1598        |   CB_GETCOUNT
1599
1600        |   CB_GETCURSEL
1601
1602        |   CB_DIR of { attrs: ComboBase.CBDirAttr list, fileSpec: string }
1603
1604        |   CB_GETLBTEXT of { index: int, length: int, text: string ref }
1605
1606        |   CB_GETLBTEXTLEN of { index: int }
1607
1608        |   CB_INSERTSTRING of { index: int, text: string }
1609
1610        |   CB_RESETCONTENT
1611
1612        |   CB_FINDSTRING of { indexStart: int, text: string }
1613
1614        |   CB_SELECTSTRING of { indexStart: int, text: string }
1615
1616        |   CB_SETCURSEL of { index: int }
1617
1618        |   CB_SHOWDROPDOWN of { show: bool }
1619
1620        |   CB_GETITEMDATA of { index: int }
1621
1622        |   CB_SETITEMDATA of { index: int, data: int }
1623
1624        |   CB_GETDROPPEDCONTROLRECT of { rect: RECT ref }
1625
1626        |   CB_SETITEMHEIGHT of { index: int, height: int }
1627
1628        |   CB_GETITEMHEIGHT of { index: int }
1629
1630        |   CB_SETEXTENDEDUI of { extended: bool }
1631
1632        |   CB_GETEXTENDEDUI
1633
1634        |   CB_GETDROPPEDSTATE
1635
1636        |   CB_FINDSTRINGEXACT of { indexStart: int, text: string }
1637
1638        |   CB_SETLOCALE of { locale: int }
1639
1640        |   CB_GETLOCALE
1641
1642        |   CB_GETTOPINDEX
1643
1644        |   CB_SETTOPINDEX of { index: int }
1645
1646        |   CB_GETHORIZONTALEXTENT
1647
1648        |   CB_SETHORIZONTALEXTENT of { extent: int }
1649
1650        |   CB_GETDROPPEDWIDTH
1651
1652        |   CB_SETDROPPEDWIDTH of { width: int }
1653
1654        |   CB_INITSTORAGE of { items: int, bytes: int }
1655
1656        |   LB_ADDSTRING of { text: string }
1657
1658        |   LB_INSERTSTRING of { index: int, text: string }
1659
1660        |   LB_DELETESTRING of { index: int }
1661
1662        |   LB_SELITEMRANGEEX of { first: int, last: int }
1663
1664        |   LB_RESETCONTENT
1665
1666        |   LB_SETSEL of { select: bool, index: int }
1667
1668        |   LB_SETCURSEL of { index: int }
1669
1670        |   LB_GETSEL of { index: int }
1671
1672        |   LB_GETCURSEL
1673
1674        |   LB_GETTEXT of { index: int, length: int, text: string ref }
1675
1676        |   LB_GETTEXTLEN of { index: int }
1677
1678        |   LB_GETCOUNT
1679
1680        |   LB_SELECTSTRING of { indexStart: int, text: string }
1681
1682        |   LB_DIR of { attrs: ComboBase.CBDirAttr list, fileSpec: string }
1683
1684        |   LB_GETTOPINDEX
1685
1686        |   LB_FINDSTRING of { indexStart: int, text: string }
1687
1688        |   LB_GETSELCOUNT
1689
1690        |   LB_GETSELITEMS of { items: IntArray.array }
1691
1692        |   LB_SETTABSTOPS of { tabs: IntVector.vector }
1693
1694        |   LB_GETHORIZONTALEXTENT
1695
1696        |   LB_SETHORIZONTALEXTENT of { extent: int }
1697
1698        |   LB_SETCOLUMNWIDTH of { column: int }
1699
1700        |   LB_ADDFILE of { fileName: string }
1701
1702        |   LB_SETTOPINDEX of { index: int }
1703
1704        |   LB_GETITEMRECT of { rect: RECT ref, index: int }
1705
1706        |   LB_GETITEMDATA of { index: int }
1707
1708        |   LB_SETITEMDATA of { index: int, data: int }
1709
1710        |   LB_SELITEMRANGE of { select: bool, first: int, last: int }
1711
1712        |   LB_SETANCHORINDEX of { index: int }
1713
1714        |   LB_GETANCHORINDEX
1715
1716        |   LB_SETCARETINDEX of { index: int, scroll: bool }
1717
1718        |   LB_GETCARETINDEX
1719
1720        |   LB_SETITEMHEIGHT of { index: int, height: int }
1721
1722        |   LB_GETITEMHEIGHT of { index: int }
1723
1724        |   LB_FINDSTRINGEXACT of { indexStart: int, text: string }
1725
1726        |   LB_SETLOCALE of { locale: int } (* Should be an abstract type? *)
1727
1728        |   LB_GETLOCALE (* Result will be the type used above. *)
1729
1730        |   LB_SETCOUNT of { items: int }
1731
1732        |   LB_INITSTORAGE of { items: int, bytes: int }
1733
1734        |   LB_ITEMFROMPOINT of { point: POINT }
1735
1736        |   STM_GETICON
1737
1738        |   STM_GETIMAGE of {imageType: ImageType}
1739
1740        |   STM_SETICON of {icon: HICON}
1741
1742        |   STM_SETIMAGE of {image: HGDIOBJ, imageType: ImageType}
1743
1744        |   SBM_SETPOS of { pos: int, redraw: bool }
1745
1746        |   SBM_GETPOS
1747
1748        |   SBM_SETRANGE of { minPos: int, maxPos: int }
1749
1750        |   SBM_SETRANGEREDRAW of { minPos: int, maxPos: int }
1751
1752        |   SBM_GETRANGE of { minPos: int ref, maxPos: int ref }
1753
1754        |   SBM_ENABLE_ARROWS of ScrollBase.enableArrows
1755
1756        |   SBM_SETSCROLLINFO of { info: ScrollBase.SCROLLINFO,
1757                                 options: ScrollBase.ScrollInfoOption list }
1758
1759        |   SBM_GETSCROLLINFO of { info: ScrollBase.SCROLLINFO ref,
1760                                 options: ScrollBase.ScrollInfoOption list }
1761
1762        |   FINDMSGSTRING of
1763            { flags: findReplaceFlags, findWhat: string, replaceWith: string }
1764
1765
1766        (* GetMessage and PeekMessage return these values. *)
1767        type MSG = {
1768            msg: Message,
1769            hwnd: HWND,
1770            time: Time.time,
1771            pt: {x: int, y: int}
1772            }
1773            
1774        type HGDIOBJ = HGDIOBJ and HWND = HWND and RECT = RECT and POINT = POINT
1775        and HMENU = HMENU and HICON = HICON and HINSTANCE = HINSTANCE and HDC = HDC
1776        and HFONT = HFONT and HRGN = HRGN and HDROP = HDROP
1777        and ClipboardFormat = ClipboardFormat and ClassType = ClassType
1778        and findReplaceFlags = FindReplaceFlags.flags
1779        and windowFlags = flags
1780
1781        (* WM_MOUSEMOVE etc *)
1782        fun decompileMouseMove(constr, wp, lp) =
1783        let
1784            val lp32 = Word32.fromLargeWord lp
1785        in
1786            constr { keyflags = fromCmkf(Word32.fromLargeWord wp), x = Word.toInt(LOWORD lp32), y = Word.toInt(HIWORD lp32)  }
1787        end
1788        
1789        fun compileMouseMove(code, { keyflags, x, y}) =
1790            (code, Word32.toLargeWord (toCmkf keyflags), Word32.toLargeWord(MAKELONG(Word.fromInt x, Word.fromInt y)), fn()=>())
1791
1792        local (* EM_GETSEL and CB_GETEDITSEL *)
1793            val {load=loadDword, store=storeDword, ctype={size=sizeDword, ...}, ...} = breakConversion cDWORD
1794        in
1795            fun compileGetSel(code, {startPos=ref s, endPos=ref e}) =
1796            let
1797                open Memory
1798                infix 6 ++
1799                (* Allocate space for two DWORDs *)
1800                val mem = malloc(sizeDword * 0w2)
1801                val eAddr = mem ++ sizeDword
1802                val () = ignore(storeDword(mem, s)) (* Can ignore the results *)
1803                and () = ignore(storeDword(eAddr, e))
1804            in
1805                (code, fromAddr mem, fromAddr eAddr, fn () => free mem)
1806            end
1807            
1808            and decompileGetSel{wp, lp} =
1809            let
1810                val s = loadDword(toAddr wp)
1811                and e = loadDword(toAddr lp)
1812            in
1813                {startPos = ref s, endPos=ref e}
1814            end
1815            
1816            (* Update ML from wp/lp values *)
1817            fun updateGetSelFromWpLp({startPos, endPos}, {wp, lp}) =
1818                ( startPos := loadDword(toAddr wp); endPos := loadDword(toAddr lp) )
1819            (* Update wp/lp from ML *)
1820            and updateGetSelParms({wp, lp}, {startPos = ref s, endPos = ref e}) =
1821                ( ignore(storeDword(toAddr wp, s)); ignore(storeDword(toAddr lp, e)) )
1822        end
1823
1824        local (* EM_GETRECT and CB_GETDROPPEDCONTROLRECT.  LB_GETITEMRECT and WM_NCCALCSIZE are similar *)
1825            val {load=loadRect, store=storeRect, ctype={size=sizeRect, ...}, ...} = breakConversion cRect
1826        in
1827            fun compileGetRect(code, wp, r) =
1828            let
1829                open Memory
1830                val mem = malloc sizeRect
1831                val () = ignore(storeRect(mem, r)) (* Can ignore the result *)
1832            in
1833                (code, wp, fromAddr mem, fn () => free mem)
1834            end
1835            
1836            and compileSetRect(code, rect) =
1837            let
1838                open Memory
1839                val mem = malloc sizeRect
1840                val () = ignore(storeRect(mem, rect))
1841            in
1842                (code, 0w0, fromAddr mem, fn () => free mem)
1843            end
1844            
1845            (* These can be used for updating *)
1846            val fromCrect = loadRect (* For the moment *)
1847            and toCrect = ignore o storeRect
1848        end
1849
1850    val hiWord = Word.toInt o HIWORD o Word32.fromLargeWord
1851    and loWord = Word.toInt o LOWORD o Word32.fromLargeWord
1852
1853    (* Decode a received message. *)
1854    fun decompileMessage (0x0000, _: SysWord.word, _: SysWord.word) = WM_NULL
1855    
1856    |   decompileMessage (0x0001, wp, lp) = WM_CREATE(decompileCreate{wp=wp, lp=lp})
1857
1858    |   decompileMessage (0x0002, _, _) = WM_DESTROY
1859     
1860    |   decompileMessage (0x0003, _, lp) = WM_MOVE { x = loWord lp, y = hiWord lp }
1861
1862    |   decompileMessage (0x0005, wp, lp) = WM_SIZE { flag = toWMSizeOpt wp, width = loWord lp, height = hiWord lp }
1863
1864    |   decompileMessage (0x0006, wp, _) =
1865        let
1866            val wp32 = Word32.fromLargeWord wp
1867        in
1868            WM_ACTIVATE { active = toWMactive (LOWORD wp32), minimize = HIWORD wp32 <> 0w0 }
1869        end
1870
1871    |   decompileMessage (0x0007, wp, _) = WM_SETFOCUS { losing = handleOfVoidStar(toAddr wp) } 
1872
1873    |   decompileMessage (0x0008, wp, _) = WM_KILLFOCUS { receivefocus = handleOfVoidStar(toAddr wp) }
1874
1875    |   decompileMessage (0x000A, wp, _) = WM_ENABLE { enabled = wp <> 0w0 }
1876
1877    |   decompileMessage (0x000B, wp, _) = WM_SETREDRAW { redrawflag = wp <> 0w0  }
1878
1879    |   decompileMessage (0x000C, _, lp) = WM_SETTEXT { text = fromCstring(toAddr lp)  }
1880
1881        (* When the message arrives we don't know what the text is. *)
1882    |   decompileMessage (0x000D, wp, _) = WM_GETTEXT { length = SysWord.toInt wp, text = ref ""  }
1883
1884    |   decompileMessage ( 0x000E, _, _) = WM_GETTEXTLENGTH
1885    
1886    |   decompileMessage ( 0x000F, _, _) = WM_PAINT
1887    
1888    |   decompileMessage ( 0x0010, _, _) = WM_CLOSE
1889
1890    |   decompileMessage ( 0x0011, wp, _) = WM_QUERYENDSESSION { source = SysWord.toInt wp }
1891    
1892    |   decompileMessage (0x0012, wp, _) = WM_QUIT {exitcode = SysWord.toInt wp }
1893
1894    |   decompileMessage ( 0x0013, _, _) = WM_QUERYOPEN
1895 
1896    |   decompileMessage ( 0x0014, wp, _) = WM_ERASEBKGND { devicecontext = toHDC wp }
1897
1898    |   decompileMessage ( 0x0015, _, _) = WM_SYSCOLORCHANGE
1899
1900    |   decompileMessage ( 0x0016, wp, _) = WM_ENDSESSION { endsession = wp <> 0w0 }
1901    
1902    |   decompileMessage ( 0x0018, wp, lp) = WM_SHOWWINDOW  { showflag = wp <> 0w0, statusflag = SysWord.toInt lp  }
1903    
1904    |   decompileMessage ( 0x001B, _, lp) = WM_DEVMODECHANGE { devicename = fromCstring(toAddr lp) } (* "0x001B" *)
1905    
1906    |   decompileMessage ( 0x001C, wp, lp) = WM_ACTIVATEAPP { active = wp <> 0w0, threadid = SysWord.toInt lp } (* "0x001C" *)
1907    
1908    |   decompileMessage ( 0x001D, _, _) = WM_FONTCHANGE
1909    
1910    |   decompileMessage ( 0x001E, _, _) = WM_TIMECHANGE (* "0x001E" *)
1911    
1912    |   decompileMessage ( 0x001F, _, _) = WM_CANCELMODE (* "0x001F" *)
1913    
1914    |   decompileMessage ( 0x0020, wp, lp) =
1915            WM_SETCURSOR
1916                { cursorwindow = toHWND wp, hitTest = toHitTest(loWord lp), mousemessage = hiWord lp }
1917    
1918    |   decompileMessage ( 0x0021, wp, lp) =
1919            WM_MOUSEACTIVATE
1920                { parent = toHWND wp, hitTest = toHitTest(loWord lp), message = hiWord lp }
1921    
1922    |   decompileMessage (0x0022, _, _) = WM_CHILDACTIVATE (* "0x0022" *)
1923    
1924    |   decompileMessage (0x0023, _, _) = WM_QUEUESYNC (* "0x0023" *)
1925    
1926    |   decompileMessage (0x0024, wp, lp) = WM_GETMINMAXINFO(decompileMinMax{lp=lp, wp=wp})
1927
1928    |   decompileMessage ( 0x0026, _, _) = WM_PAINTICON
1929    
1930    |   decompileMessage ( 0x0027, wp, _) = WM_ICONERASEBKGND { devicecontext = toHDC wp } (* "0x0027" *)
1931    
1932    |   decompileMessage ( 0x0028, wp, lp) = WM_NEXTDLGCTL { control = SysWord.toInt wp, handleflag = lp <> 0w0  } (* "0x0028" *)
1933
1934    |   decompileMessage (0x002B, wp, lp) =
1935        let
1936            val (ctlType,ctlID,itemID,itemAction,itemState,hItem,hDC, rcItem,itemData) = 
1937                toMLDrawItem lp
1938        in
1939            WM_DRAWITEM{ senderId = SysWord.toInt wp, ctlType = ctlType, ctlID = ctlID, itemID = itemID,
1940              itemAction = itemAction, itemState = itemState, hItem = hItem, hDC = hDC,
1941              rcItem = rcItem, itemData = itemData }
1942        end
1943
1944    |   decompileMessage (0x002C, wp, lp) =
1945        let
1946            val (ctlType,ctlID,itemID, itemWidth,itemHeight,itemData) = toMLMeasureItem lp       
1947        in
1948            WM_MEASUREITEM
1949            {
1950                senderId = SysWord.toInt wp, ctlType = ctlType, ctlID = ctlID,
1951                itemID = itemID, itemWidth = ref itemWidth, itemHeight = ref itemHeight, itemData = itemData 
1952            }
1953        end
1954
1955    |   decompileMessage (0x002D, wp, lp) =
1956        let
1957            val (ctlType,ctlID,itemID,hItem,itemData) = toMLDeleteItem lp
1958        in
1959            WM_DELETEITEM
1960                { senderId = SysWord.toInt wp, ctlType = ctlType, ctlID = ctlID, itemID = itemID,
1961                  item = hItem, itemData = itemData }
1962        end
1963
1964    |   decompileMessage ( 0x002E, wp, lp) =
1965            WM_VKEYTOITEM  { virtualKey = loWord wp, caretpos = hiWord wp, listbox = toHWND lp  } (* "0x002E" *)
1966    
1967    |   decompileMessage ( 0x002F, wp, lp) =
1968            WM_CHARTOITEM { key = loWord wp, caretpos = hiWord wp,listbox  = toHWND lp  } (* "0x002F" *)
1969
1970    |   decompileMessage ( 0x0030, wp, lp) =
1971            (* The definition of WM_SETFONT says that it is the low order word of lp that says whether the
1972               control should be redrawn immediately. *)
1973            WM_SETFONT { font = toHFONT wp, redrawflag = SysWord.andb(0wxffff, lp) <> 0w0  } (* "0x0030" *)
1974
1975    |   decompileMessage ( 0x0031, _, _) = WM_GETFONT (* "0x0031" *)
1976    
1977    |   decompileMessage ( 0x0032, wp, _) = WM_SETHOTKEY { virtualKey = SysWord.toInt wp  } (* "0x0032" *)
1978    
1979    |   decompileMessage ( 0x0033, _, _) = WM_GETHOTKEY (* "0x0033" *)
1980    
1981    |   decompileMessage ( 0x0037, _, _) = WM_QUERYDRAGICON (* "0x0037" *)
1982    
1983    |   decompileMessage (0x0039, wp, lp) =
1984        let
1985            val (ctlType, ctlID, hItem, itemID1, itemData1, itemID2, itemData2, _) = toMLCompareItem lp       
1986        in
1987            WM_COMPAREITEM
1988            {
1989                controlid = SysWord.toInt wp, ctlType = ctlType, ctlID = ctlID, hItem = hItem,
1990                itemID1 = itemID1, itemData1 = itemData1, itemID2 = itemID2, itemData2 = itemData2
1991            }
1992        end
1993
1994    |   decompileMessage (0x0046, wp, lp) = WM_WINDOWPOSCHANGING(cToMLWindowPosChanging{wp=wp, lp=lp})
1995
1996    |   decompileMessage (0x0047, wp, lp) = WM_WINDOWPOSCHANGED(cToMLWindowPosChanged{wp=wp, lp=lp})
1997
1998    |   decompileMessage ( 0x0048, wp, _) = WM_POWER { powerevent = SysWord.toInt wp  } (* "0x0048" *)
1999
2000    |   decompileMessage ( 0x004B, _, _) = WM_CANCELJOURNAL (* "0x004B" *)
2001
2002    |   decompileMessage ( 0x004E, wp, lp) = WM_NOTIFY(decompileNotify{wp=wp, lp=lp})
2003
2004    |   decompileMessage ( 0x0053, wp, lp) = WM_HELP(decompileHelpInfo{wp=wp, lp=lp})
2005
2006(*
2007WM_INPUTLANGCHANGEREQUEST       0x0050
2008WM_INPUTLANGCHANGE              0x0051
2009WM_TCARD                        0x0052
2010WM_USERCHANGED                  0x0054
2011WM_NOTIFYFORMAT                 0x0055
2012
2013NFR_ANSI                             1
2014NFR_UNICODE                          2
2015NF_QUERY                             3
2016NF_REQUERY                           4
2017
2018WM_CONTEXTMENU                  0x007B
2019WM_STYLECHANGING                0x007C
2020WM_STYLECHANGED                 0x007D
2021*)
2022
2023    |   decompileMessage ( 0x007B, wp, lp) =
2024            WM_CONTEXTMENU { hwnd = toHWND wp, xPos = loWord lp, yPos = hiWord lp}
2025
2026    |   decompileMessage ( 0x007E, wp, lp) =
2027            WM_DISPLAYCHANGE { bitsPerPixel = SysWord.toInt wp, xScreen = loWord lp, yScreen = hiWord lp}
2028
2029    |   decompileMessage ( 0x007F, wp, _) = WM_GETICON { big = SysWord.toInt wp = 1}
2030
2031    |   decompileMessage ( 0x0080, wp, lp) = WM_SETICON { big = SysWord.toInt wp = 1, icon = toHICON lp}
2032
2033    |   decompileMessage ( 0x0081, wp, lp) = WM_NCCREATE(decompileCreate{wp=wp, lp=lp})
2034
2035    |   decompileMessage ( 0x0082, _, _) = WM_NCDESTROY
2036
2037    |   decompileMessage ( 0x0083, wp, lp) = WM_NCCALCSIZE(decompileNCCalcSize{wp=wp, lp=lp})
2038
2039    |   decompileMessage ( 0x0084, _, lp) = WM_NCHITTEST { x = loWord lp, y = hiWord lp  } (* "0x0084" *)
2040
2041    |   decompileMessage ( 0x0085, wp, _) = WM_NCPAINT { region = toHRGN wp  } (* "0x0085" *)
2042    
2043    |   decompileMessage ( 0x0086, wp, _) = WM_NCACTIVATE  { active = wp <> 0w0 } (* "0x0086" *)
2044
2045    |   decompileMessage ( 0x0087, _, _) = WM_GETDLGCODE (* "0x0087" *)
2046    
2047    |   decompileMessage ( 0x00A0, wp, lp) = WM_NCMOUSEMOVE { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2048    
2049    |   decompileMessage ( 0x00A1, wp, lp) = WM_NCLBUTTONDOWN { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2050    
2051    |   decompileMessage ( 0x00A2, wp, lp) = WM_NCLBUTTONUP { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2052    
2053    |   decompileMessage ( 0x00A3, wp, lp) = WM_NCLBUTTONDBLCLK { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2054    
2055    |   decompileMessage ( 0x00A4, wp, lp) = WM_NCRBUTTONDOWN { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2056    
2057    |   decompileMessage ( 0x00A5, wp, lp) = WM_NCRBUTTONUP { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2058    
2059    |   decompileMessage ( 0x00A6, wp, lp) = WM_NCRBUTTONDBLCLK { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2060    
2061    |   decompileMessage ( 0x00A7, wp, lp) = WM_NCMBUTTONDOWN { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2062    
2063    |   decompileMessage ( 0x00A8, wp, lp) = WM_NCMBUTTONUP { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2064    
2065    |   decompileMessage ( 0x00A9, wp, lp) = WM_NCMBUTTONDBLCLK { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp  }
2066
2067(* Edit control messages *)
2068    |   decompileMessage ( 0x00B0, wp, lp) = EM_GETSEL (decompileGetSel{wp=wp, lp=lp})
2069
2070    |   decompileMessage ( 0x00B1, wp, lp) = EM_SETSEL { startPos = SysWord.toInt wp, endPos = SysWord.toInt lp }
2071
2072    |   decompileMessage ( 0x00B2, _, lp) = EM_GETRECT {rect = ref(fromCrect(toAddr lp))}
2073
2074    |   decompileMessage ( 0x00B3, _, lp) = EM_SETRECT { rect = fromCrect(toAddr lp) }
2075
2076    |   decompileMessage ( 0x00B4, _, lp) = EM_SETRECTNP { rect = fromCrect(toAddr lp) }
2077
2078    |   decompileMessage ( 0x00B5, wp, _) = EM_SCROLL{action = fromCsd(Word.fromLargeWord wp)}
2079
2080    |   decompileMessage ( 0x00B6, wp, lp) = EM_LINESCROLL{xScroll = SysWord.toInt wp, yScroll = SysWord.toInt lp}
2081
2082    |   decompileMessage ( 0x00B7, _, _) = EM_SCROLLCARET
2083
2084    |   decompileMessage ( 0x00B8, _, _) = EM_GETMODIFY
2085
2086    |   decompileMessage ( 0x00B9, wp, _) = EM_SETMODIFY{modified = wp <> 0w0}
2087
2088    |   decompileMessage ( 0x00BA, _, _) = EM_GETLINECOUNT
2089
2090    |   decompileMessage ( 0x00BB, wp, _) = EM_LINEINDEX {line = SysWord.toIntX (* -1 = current line *) wp}
2091(*
2092EM_SETHANDLE            0x00BC
2093*)
2094    |   decompileMessage ( 0x00BE, _, _) = EM_GETTHUMB
2095
2096    |   decompileMessage ( 0x00C1, wp, _) = EM_LINELENGTH {index = SysWord.toIntX (* May be -1 *) wp}
2097
2098    |   decompileMessage ( 0x00C2, wp, lp) = EM_REPLACESEL {canUndo = wp <> 0w0, text = fromCstring(toAddr lp)}
2099
2100    |   decompileMessage ( 0x00C4, wp, lp) = EM_GETLINE(decompileGetLine{wp=wp, lp=lp})
2101
2102    |   decompileMessage ( 0x00C5, wp, _) = EM_LIMITTEXT {limit = SysWord.toInt wp}
2103
2104    |   decompileMessage ( 0x00C6, _, _) = EM_CANUNDO
2105
2106    |   decompileMessage ( 0x00C7, _, _) = EM_UNDO
2107
2108    |   decompileMessage ( 0x00C8, wp, _) = EM_FMTLINES{addEOL = wp <> 0w0}
2109
2110    |   decompileMessage ( 0x00C9, wp, _) = EM_LINEFROMCHAR{index = SysWord.toInt wp}
2111
2112    |   decompileMessage ( 0x00CB, wp, lp) = EM_SETTABSTOPS{tabs=decompileTabStops{wp=wp, lp=lp}}
2113
2114    |   decompileMessage ( 0x00CC, wp, _) = EM_SETPASSWORDCHAR{ch = chr (SysWord.toInt wp)}
2115
2116    |   decompileMessage ( 0x00CD, _, _) = EM_EMPTYUNDOBUFFER
2117
2118    |   decompileMessage ( 0x00CE, _, _) = EM_GETFIRSTVISIBLELINE
2119
2120    |   decompileMessage ( 0x00CF, wp, _) = EM_SETREADONLY{readOnly = wp <> 0w0}
2121(*
2122EM_SETWORDBREAKPROC     0x00D0
2123EM_GETWORDBREAKPROC     0x00D1
2124*)
2125
2126    |   decompileMessage (0x00D2, _, _) = EM_GETPASSWORDCHAR
2127
2128    |   decompileMessage (0x00D3, wp, lp) =
2129            if wp = 0wxffff then EM_SETMARGINS{margins=UseFontInfo}
2130            else
2131            let
2132                val left =
2133                    if SysWord.andb(wp, 0w1) <> 0w0
2134                    then SOME(loWord lp)
2135                    else NONE
2136                val right =
2137                    if SysWord.andb(wp, 0w2) <> 0w0
2138                    then SOME(hiWord lp)
2139                    else NONE
2140            in
2141                EM_SETMARGINS{margins=Margins{left=left, right=right}}
2142            end
2143
2144    |   decompileMessage (0x00D4, _, _) = EM_GETMARGINS
2145
2146    |   decompileMessage (0x00D5, _, _) = EM_GETLIMITTEXT
2147
2148    |   decompileMessage (0x00D6, wp, _) = EM_POSFROMCHAR {index = SysWord.toInt wp}
2149
2150    |   decompileMessage (0x00D7, _, lp) =
2151            (* The value in lParam is different depending on whether this is an edit control
2152               or a rich edit control.  Since we don't know we just pass the lp value. *)
2153            EM_CHARFROMPOS(EMcfpUnknown lp)
2154
2155(* Scroll bar messages *)
2156
2157    |   decompileMessage (0x00E0, wp, lp) = SBM_SETPOS {pos = SysWord.toInt wp, redraw = lp <> 0w0}
2158
2159    |   decompileMessage (0x00E1, _, _) = SBM_GETPOS
2160
2161    |   decompileMessage (0x00E2, wp, lp) = SBM_SETRANGE {minPos = SysWord.toInt wp, maxPos = SysWord.toInt lp}
2162
2163    |   decompileMessage (0x00E6, wp, lp) = SBM_SETRANGEREDRAW {minPos = SysWord.toInt wp, maxPos = SysWord.toInt lp}
2164
2165    |   decompileMessage (0x00E3, wp, lp) =
2166            SBM_GETRANGE { minPos = ref(loadInt(toAddr wp)), maxPos = ref(loadInt(toAddr lp)) }
2167
2168    |   decompileMessage (0x00E4, wp, _) = SBM_ENABLE_ARROWS(fromCesbf(SysWord.toInt wp))
2169
2170    |   decompileMessage (0x00E9, _, lp) =
2171        let
2172            val (info, options) = toScrollInfo lp
2173        in
2174            SBM_SETSCROLLINFO{ info = info, options = options }
2175        end
2176
2177     |  decompileMessage (0x00EA, _, lp) =
2178        let
2179            (* The values may not be correct at this point but the mask
2180               should have been set. *)
2181            val (info, options) = toScrollInfo lp
2182        in
2183            SBM_GETSCROLLINFO{ info = ref info, options = options }
2184        end
2185
2186(* Button control messages *)
2187    |   decompileMessage (0x00F0, _, _) = BM_GETCHECK
2188
2189    |   decompileMessage (0x00F1, wp, _) = BM_SETCHECK{state = SysWord.toInt wp}
2190
2191    |   decompileMessage (0x00F2, _, _) = BM_GETSTATE
2192
2193    |   decompileMessage (0x00F3, wp, _) = BM_SETSTATE{highlight = SysWord.toInt wp <> 0}
2194
2195    |   decompileMessage (0x00F4, wp, lp) = BM_SETSTYLE{redraw = SysWord.toInt lp <> 0, style = Style.fromWord wp}
2196
2197    |   decompileMessage (0x00F5, _, _) = BM_CLICK
2198
2199    |   decompileMessage (0x00F6, wp, _) = BM_GETIMAGE{imageType = fromCit(SysWord.toInt wp)}
2200
2201    |   decompileMessage (0x00F7, wp, lp) = BM_SETIMAGE{imageType = fromCit (SysWord.toInt wp), image = toHGDIOBJ lp}
2202
2203    |   decompileMessage (0x0100, wp, lp) = WM_KEYDOWN { virtualKey = SysWord.toInt wp, data = Word32.fromLargeWord lp }
2204    
2205    |   decompileMessage (0x0101, wp, lp) = WM_KEYUP { virtualKey = SysWord.toInt wp, data = Word32.fromLargeWord lp }
2206    
2207    |   decompileMessage (0x0102, wp, lp) = WM_CHAR { charCode = chr (SysWord.toInt wp), data = Word32.fromLargeWord lp }
2208    
2209    |   decompileMessage (0x0103, wp, lp) = WM_DEADCHAR { charCode = chr (SysWord.toInt wp), data = Word32.fromLargeWord lp  }
2210    
2211    |   decompileMessage (0x0104, wp, lp) = WM_SYSKEYDOWN { virtualKey = SysWord.toInt wp, data = Word32.fromLargeWord lp }
2212    
2213    |   decompileMessage (0x0105, wp, lp) = WM_SYSKEYUP { virtualKey = SysWord.toInt wp, data = Word32.fromLargeWord lp }
2214    
2215    |   decompileMessage (0x0106, wp, lp) = WM_SYSCHAR { charCode = chr (SysWord.toInt wp), data = Word32.fromLargeWord lp }
2216    
2217    |   decompileMessage (0x0107, wp, lp) = WM_SYSDEADCHAR { charCode = chr (SysWord.toInt wp), data = Word32.fromLargeWord lp }
2218(*
2219WM_IME_STARTCOMPOSITION         0x010D
2220WM_IME_ENDCOMPOSITION           0x010E
2221WM_IME_COMPOSITION              0x010F
2222WM_IME_KEYLAST                  0x010F
2223*)
2224    
2225    |   decompileMessage (0x0110, wp, lp) = WM_INITDIALOG { dialog   = toHWND wp, initdata = SysWord.toInt lp } (* "0x0110" *)
2226
2227    |   decompileMessage (0x0111, wp, lp) =
2228        let
2229            val wp32 = Word32.fromLargeWord wp
2230        in
2231            WM_COMMAND { notifyCode = Word.toInt(HIWORD wp32), wId = Word.toInt(LOWORD wp32), control = toHWND lp  }
2232        end
2233
2234    |   decompileMessage (0x0112, wp, lp) =
2235            WM_SYSCOMMAND
2236                { commandvalue = toSysCommand(SysWord.toInt(SysWord.andb(wp, 0wxFFF0))),
2237                  sysBits = SysWord.toInt(SysWord.andb(wp, 0wxF)),
2238                  p = {x= getXLParam lp, y= getYLParam lp}}
2239
2240    |   decompileMessage (0x0113, wp, _) = WM_TIMER  { timerid = SysWord.toInt wp  } (* "0x0113" *)
2241
2242    |   decompileMessage (0x0114, wp, lp) =
2243            WM_HSCROLL { value = fromCsd(LOWORD(Word32.fromLargeWord wp)), position = hiWord wp, scrollbar = toHWND lp } (* "0x0114" *)
2244    
2245    |   decompileMessage (0x0115, wp, lp) =
2246            WM_VSCROLL { value = fromCsd(LOWORD(Word32.fromLargeWord wp)), position  = hiWord wp, scrollbar = toHWND lp } (* "0x0115" *)
2247
2248    |   decompileMessage (0x0116, wp, _) = WM_INITMENU { menu = toHMENU wp } (* "0x0116" *)
2249
2250    |   decompileMessage (0x0117, wp, lp) =
2251            WM_INITMENUPOPUP { menupopup  = toHMENU wp, itemposition = loWord lp, isSystemMenu = hiWord lp <> 0 } (* "0x0117" *)
2252    
2253    |   decompileMessage (0x011F, wp, lp) =
2254        let
2255            val wp32 = Word32.fromLargeWord wp
2256        in
2257            WM_MENUSELECT { menuitem = Word.toInt(LOWORD wp32),
2258                            menuflags =
2259                                MenuBase.toMenuFlagSet(Word32.fromLargeWord(Word.toLargeWord(Word.andb(HIWORD wp32, 0wxffff)))),
2260                            menu = toHMENU lp } (* "0x011F" *)
2261        end
2262    
2263    |   decompileMessage (0x0120, wp, lp) =
2264        let
2265            val wp32 = Word32.fromLargeWord wp
2266        in
2267            WM_MENUCHAR { ch = chr(Word.toInt(LOWORD wp32)),
2268                          menuflag = (* Just a single flag *)
2269                                MenuBase.toMenuFlag(Word32.fromLargeWord(Word.toLargeWord(Word.andb(HIWORD wp32, 0wxffff)))),
2270                          menu= toHMENU lp  } (* "0x0120" *)
2271        end
2272    
2273    |   decompileMessage (0x0121, wp, lp) = WM_ENTERIDLE { flag = SysWord.toInt wp, window = toHWND lp } (* "0x0121" *)
2274
2275    |   decompileMessage (0x0132, wp, lp) = WM_CTLCOLORMSGBOX { displaycontext = toHDC wp, messagebox = toHWND lp  } (* "0x0132" *)
2276    
2277    |   decompileMessage (0x0133, wp, lp) = WM_CTLCOLOREDIT { displaycontext = toHDC wp, editcontrol = toHWND lp  } (* "0x0133" *)
2278    
2279    |   decompileMessage (0x0134, wp, lp) = WM_CTLCOLORLISTBOX { displaycontext = toHDC wp, listbox = toHWND lp   } (* "0x0134" *)
2280    
2281    |   decompileMessage (0x0135, wp, lp) = WM_CTLCOLORBTN { displaycontext = toHDC wp, button = toHWND lp  }(* "0x0135" *)
2282    
2283    |   decompileMessage (0x0136, wp, lp) = WM_CTLCOLORDLG { displaycontext = toHDC wp, dialogbox = toHWND lp  } (* "0x0136" *)
2284    
2285    |   decompileMessage (0x0137, wp, lp) = WM_CTLCOLORSCROLLBAR { displaycontext = toHDC wp, scrollbar = toHWND lp  } (* "0x0137" *)
2286    
2287    |   decompileMessage (0x0138, wp, lp) = WM_CTLCOLORSTATIC { displaycontext = toHDC wp, staticcontrol = toHWND lp  } (* "0x0138" *)
2288
2289(* Combobox messages. *)
2290    |   decompileMessage (0x0140, wp, lp) = CB_GETEDITSEL (decompileGetSel{wp=wp, lp=lp})
2291
2292    |   decompileMessage (0x0141, wp, _) = CB_LIMITTEXT {limit = SysWord.toInt wp}
2293
2294    |   decompileMessage (0x0142, _, lp) = CB_SETEDITSEL { startPos = loWord lp, endPos = hiWord lp }
2295
2296    |   decompileMessage (0x0143, _, lp) = CB_ADDSTRING {text = fromCstring(toAddr lp) }
2297
2298    |   decompileMessage (0x0144, wp, _) = CB_DELETESTRING {index = SysWord.toInt wp}
2299
2300    |   decompileMessage (0x0145, wp, lp) =
2301            CB_DIR {attrs = fromCcbal(Word32.fromLargeWord wp), fileSpec = fromCstring(toAddr lp) }
2302
2303    |   decompileMessage (0x0146, _, _) = CB_GETCOUNT
2304
2305    |   decompileMessage (0x0147, _, _) = CB_GETCURSEL
2306
2307    |   decompileMessage (0x0148, wp, _) = CB_GETLBTEXT { index = SysWord.toInt wp, length = 0, text = ref ""  }
2308
2309    |   decompileMessage (0x0149, wp, _) = CB_GETLBTEXTLEN {index = SysWord.toInt wp}
2310
2311    |   decompileMessage (0x014A, wp, lp) = CB_INSERTSTRING {text = fromCstring(toAddr lp), index = SysWord.toInt wp }
2312
2313    |   decompileMessage (0x014B, _, _) = CB_RESETCONTENT
2314
2315    |   decompileMessage (0x014C, wp, lp) = CB_FINDSTRING {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2316
2317    |   decompileMessage (0x014D, wp, lp) = CB_SELECTSTRING {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2318
2319    |   decompileMessage (0x014E, wp, _) = CB_SETCURSEL {index = SysWord.toInt wp}
2320
2321    |   decompileMessage (0x014F, wp, _) = CB_SHOWDROPDOWN {show = wp <> 0w0}
2322
2323    |   decompileMessage (0x0150, wp, _) = CB_GETITEMDATA {index = SysWord.toInt wp}
2324
2325    |   decompileMessage (0x0151, wp, lp) = CB_SETITEMDATA {index = SysWord.toInt wp, data = SysWord.toInt lp}
2326
2327    |   decompileMessage (0x0152, _, lp) = CB_GETDROPPEDCONTROLRECT {rect = ref(fromCrect(toAddr lp))}
2328
2329    |   decompileMessage (0x0153, wp, lp) = CB_SETITEMHEIGHT {index = SysWord.toInt wp, height = SysWord.toInt lp}
2330
2331    |   decompileMessage (0x0154, wp, _) = CB_GETITEMHEIGHT {index = SysWord.toInt wp}
2332
2333    |   decompileMessage (0x0155, wp, _) = CB_SETEXTENDEDUI {extended = wp <> 0w0}
2334
2335    |   decompileMessage (0x0156, _, _) = CB_GETEXTENDEDUI
2336
2337    |   decompileMessage (0x0157, _, _) = CB_GETDROPPEDSTATE
2338
2339    |   decompileMessage (0x0158, wp, lp) = CB_FINDSTRINGEXACT {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2340
2341    |   decompileMessage (0x0159, wp, _) = CB_SETLOCALE {locale = SysWord.toInt wp}
2342
2343    |   decompileMessage (0x015A, _, _) = CB_GETLOCALE
2344
2345    |   decompileMessage (0x015b, _, _) = CB_GETTOPINDEX
2346
2347    |   decompileMessage (0x015c, wp, _) = CB_SETTOPINDEX {index = SysWord.toInt wp}
2348
2349    |   decompileMessage (0x015d, _, _) = CB_GETHORIZONTALEXTENT
2350
2351    |   decompileMessage (0x015e, wp, _) = CB_SETHORIZONTALEXTENT {extent = SysWord.toInt wp}
2352
2353    |   decompileMessage (0x015f, _, _) = CB_GETDROPPEDWIDTH
2354
2355    |   decompileMessage (0x0160, wp, _) = CB_SETDROPPEDWIDTH {width = SysWord.toInt wp}
2356
2357    |   decompileMessage (0x0161, wp, lp) = CB_INITSTORAGE {items = SysWord.toInt wp, bytes = SysWord.toInt lp}
2358
2359(* Static control messages. *)
2360    |   decompileMessage (0x0170, wp, _) = STM_SETICON{icon = toHICON wp}
2361
2362    |   decompileMessage (0x0171, _, _) = STM_GETICON
2363
2364    |   decompileMessage (0x0172, wp, lp) = STM_SETIMAGE{imageType = fromCit(SysWord.toInt wp), image = toHGDIOBJ lp}
2365
2366    |   decompileMessage (0x0173, wp, _) = STM_GETIMAGE{imageType = fromCit(SysWord.toInt wp)}
2367
2368(* Listbox messages *)
2369    |   decompileMessage (0x0180, _, lp) = LB_ADDSTRING {text = fromCstring(toAddr lp) }
2370
2371    |   decompileMessage (0x0181, wp, lp) = LB_INSERTSTRING {text = fromCstring(toAddr lp), index = SysWord.toInt wp }
2372
2373    |   decompileMessage (0x0182, wp, _) = LB_DELETESTRING {index = SysWord.toInt wp}
2374
2375    |   decompileMessage (0x0183, wp, lp) = LB_SELITEMRANGEEX {first = SysWord.toInt wp, last = SysWord.toInt lp}
2376
2377    |   decompileMessage (0x0184, _, _) = LB_RESETCONTENT
2378
2379    |   decompileMessage (0x0185, wp, lp) = LB_SETSEL {select = wp <> 0w0, index = SysWord.toInt lp}
2380
2381    |   decompileMessage (0x0186, wp, _) = LB_SETCURSEL {index = SysWord.toInt wp}
2382
2383    |   decompileMessage (0x0187, wp, _) = LB_GETSEL {index = SysWord.toInt wp}
2384
2385    |   decompileMessage (0x0188, _, _) = LB_GETCURSEL
2386
2387    |   decompileMessage (0x0189, wp, _) = LB_GETTEXT { index = SysWord.toInt wp, length = 0, text = ref ""  }
2388
2389    |   decompileMessage (0x018A, wp, _) = LB_GETTEXTLEN {index = SysWord.toInt wp}
2390
2391    |   decompileMessage (0x018B, _, _) = LB_GETCOUNT
2392
2393    |   decompileMessage (0x018C, wp, lp) = LB_SELECTSTRING {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2394
2395    |   decompileMessage (0x018D, wp, lp) = LB_DIR {attrs = fromCcbal(Word32.fromLargeWord wp), fileSpec = fromCstring(toAddr lp) }
2396
2397    |   decompileMessage (0x018E, _, _) = LB_GETTOPINDEX
2398
2399    |   decompileMessage (0x018F, wp, lp) = LB_FINDSTRING {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2400
2401    |   decompileMessage (0x0190, _, _) = LB_GETSELCOUNT
2402
2403    |   decompileMessage (0x0191, wp, _) = LB_GETSELITEMS { items = IntArray.array(SysWord.toInt wp, ~1) }
2404
2405    |   decompileMessage (0x0192, wp, lp) = LB_SETTABSTOPS{tabs=decompileTabStops{wp=wp, lp=lp}}
2406
2407    |   decompileMessage (0x0193, _, _) = LB_GETHORIZONTALEXTENT
2408
2409    |   decompileMessage (0x0194, wp, _) = LB_SETHORIZONTALEXTENT {extent = SysWord.toInt wp}
2410
2411    |   decompileMessage (0x0195, wp, _) = LB_SETCOLUMNWIDTH {column = SysWord.toInt wp}
2412
2413    |   decompileMessage (0x0196, _, lp) = LB_ADDFILE {fileName = fromCstring(toAddr lp) }
2414
2415    |   decompileMessage (0x0197, wp, _) = LB_SETTOPINDEX {index = SysWord.toInt wp}
2416
2417    |   decompileMessage (0x0198, wp, lp) = LB_GETITEMRECT {index = SysWord.toInt wp, rect = ref(fromCrect(toAddr lp))}
2418
2419    |   decompileMessage (0x0199, wp, _) = LB_GETITEMDATA {index = SysWord.toInt wp}
2420
2421    |   decompileMessage (0x019A, wp, lp) = LB_SETITEMDATA {index = SysWord.toInt wp, data = SysWord.toInt lp}
2422
2423    |   decompileMessage (0x019B, wp, lp) = LB_SELITEMRANGE {select = wp <> 0w0, first = loWord lp, last = hiWord lp}
2424
2425    |   decompileMessage (0x019C, wp, _) = LB_SETANCHORINDEX {index = SysWord.toInt wp}
2426
2427    |   decompileMessage (0x019D, _, _) = LB_GETANCHORINDEX
2428
2429    |   decompileMessage (0x019E, wp, lp) = LB_SETCARETINDEX {index = SysWord.toInt wp, scroll = lp <> 0w0}
2430
2431    |   decompileMessage (0x019F, _, _) = LB_GETCARETINDEX
2432
2433    |   decompileMessage (0x01A0, wp, lp) = LB_SETITEMHEIGHT {index = SysWord.toInt wp, height = loWord lp}
2434
2435    |   decompileMessage (0x01A1, wp, _) = LB_GETITEMHEIGHT {index = SysWord.toInt wp}
2436
2437    |   decompileMessage (0x01A2, wp, lp) = LB_FINDSTRINGEXACT {text = fromCstring(toAddr lp), indexStart = SysWord.toInt wp }
2438
2439    |   decompileMessage (0x01A5, wp, _) = LB_SETLOCALE {locale = SysWord.toInt wp}
2440
2441    |   decompileMessage (0x01A6, _, _) = LB_GETLOCALE
2442
2443    |   decompileMessage (0x01A7, wp, _) = LB_SETCOUNT {items = SysWord.toInt wp}
2444
2445    |   decompileMessage (0x01A8, wp, lp) = LB_INITSTORAGE {items = SysWord.toInt wp, bytes = SysWord.toInt lp}
2446
2447    |   decompileMessage (0x01A9, _, lp) = LB_ITEMFROMPOINT {point = {x = loWord lp, y = hiWord lp }}
2448
2449    |   decompileMessage (0x0200, wp, lp) = decompileMouseMove(WM_MOUSEMOVE, wp, lp)
2450    
2451    |   decompileMessage (0x0201, wp, lp) = decompileMouseMove(WM_LBUTTONDOWN, wp, lp)
2452
2453    |   decompileMessage (0x0202, wp, lp) = decompileMouseMove(WM_LBUTTONUP, wp, lp)
2454
2455    |   decompileMessage (0x0203, wp, lp) = decompileMouseMove(WM_LBUTTONDBLCLK, wp, lp)
2456
2457    |   decompileMessage (0x0204, wp, lp) = decompileMouseMove(WM_RBUTTONDOWN, wp, lp)
2458
2459    |   decompileMessage (0x0205, wp, lp) = decompileMouseMove(WM_RBUTTONUP, wp, lp)
2460
2461    |   decompileMessage (0x0206, wp, lp) = decompileMouseMove(WM_RBUTTONDBLCLK, wp, lp)
2462
2463    |   decompileMessage (0x0207, wp, lp) = decompileMouseMove(WM_MBUTTONDOWN, wp, lp)
2464
2465    |   decompileMessage (0x0208, wp, lp) = decompileMouseMove(WM_MBUTTONUP, wp, lp)
2466
2467    |   decompileMessage (0x0209, wp, lp) = decompileMouseMove(WM_MBUTTONDBLCLK, wp, lp)
2468
2469(*
2470WM_MOUSEWHEEL                   0x020A
2471*)
2472    |   decompileMessage (0x0210, wp, lp) = WM_PARENTNOTIFY { eventflag = loWord wp, idchild = hiWord wp, value     = SysWord.toInt lp  }
2473    
2474    |   decompileMessage (0x0211, wp, _) = WM_ENTERMENULOOP { istrack= wp <> 0w0 } (* "0x0211" *)
2475    
2476    |   decompileMessage (0x0212, wp, _) = WM_EXITMENULOOP { istrack= wp <> 0w0 } (* "0x0212" *)
2477(*
2478WM_NEXTMENU                     0x0213
2479WM_SIZING                       0x0214
2480*)
2481    |   decompileMessage (0x0215, _, lp) = WM_CAPTURECHANGED { newCapture = toHWND lp }
2482(*
2483WM_MOVING                       0x0216
2484WM_POWERBROADCAST               0x0218
2485WM_DEVICECHANGE                 0x0219
2486*)
2487
2488    |   decompileMessage (0x0220, _, lp) =
2489        let
2490            val (class, title, hinst, x,y,cx,cy, style, lParam) = toMdiCreate lp
2491        in
2492            WM_MDICREATE
2493                { class = class, title = title, instance = hinst, x = x, y = y,
2494                  cx = cx, cy = cy, style = style, cdata = lParam }
2495        end
2496
2497    |   decompileMessage (0x0221, wp, _) = WM_MDIDESTROY  { child = toHWND wp } (* "0x0221" *)
2498    
2499    |   decompileMessage (0x0223, wp, _) = WM_MDIRESTORE { child = toHWND wp } (* "0x0223" *)
2500    
2501    |   decompileMessage (0x0224, wp, lp) = WM_MDINEXT { child = toHWND wp, flagnext = lp <> 0w0  } (* "0x0224" *)
2502    
2503    |   decompileMessage (0x0225, wp, _) = WM_MDIMAXIMIZE { child = toHWND wp }  (* "0x0225" *)
2504    
2505    |   decompileMessage (0x0226, wp, _) = WM_MDITILE { tilingflag = fromCmdif(Word32.fromLargeWord wp)  } (* "0x0226" *)
2506    
2507    |   decompileMessage (0x0227, wp, _) = WM_MDICASCADE { skipDisabled = SysWord.andb(wp, 0w2) <> 0w0 }
2508 
2509    |   decompileMessage (0x0228, _, _) = WM_MDIICONARRANGE
2510    
2511    |   decompileMessage (0x0229, _, _) = WM_MDIGETACTIVE
2512    
2513    |   decompileMessage (0x0230, wp, lp) = WM_MDISETMENU { frameMenu  = toHMENU wp, windowMenu = toHMENU lp } (* "0x0230" *)
2514
2515    |   decompileMessage (0x0231, _, _) = WM_ENTERSIZEMOVE
2516
2517    |   decompileMessage (0x0232, _, _) = WM_EXITSIZEMOVE
2518
2519    |   decompileMessage (0x0233, wp, _) = WM_DROPFILES { hDrop = toHDROP wp }
2520
2521    |   decompileMessage (0x0234, _, _) = WM_MDIREFRESHMENU (* "0x0234" *)
2522(*
2523WM_IME_SETCONTEXT               0x0281
2524WM_IME_NOTIFY                   0x0282
2525WM_IME_CONTROL                  0x0283
2526WM_IME_COMPOSITIONFULL          0x0284
2527WM_IME_SELECT                   0x0285
2528WM_IME_CHAR                     0x0286
2529WM_IME_KEYDOWN                  0x0290
2530WM_IME_KEYUP                    0x0291
2531*)
2532    |   decompileMessage (0x02A0, wp, lp) = WM_NCMOUSEHOVER { hitTest = toHitTest(SysWord.toInt wp), x = getXLParam lp, y = getYLParam lp }
2533
2534    |   decompileMessage (0x02A1, wp, lp) = decompileMouseMove(WM_MOUSEHOVER, wp, lp)(* "0x02A1" *)
2535
2536    |   decompileMessage (0x02A2, _, _) = WM_NCMOUSELEAVE (* "0x02A2" *)
2537
2538    |   decompileMessage (0x02A3, _, _) = WM_MOUSELEAVE (* "0x02A3" *)
2539
2540    |   decompileMessage (0x0300, _, _) = WM_CUT (* "0x0300" *)
2541    
2542    |   decompileMessage (0x0301, _, _) = WM_COPY (* "0x0301" *)
2543    
2544    |   decompileMessage (0x0302, _, _) = WM_PASTE (* "0x0302" *)
2545    
2546    |   decompileMessage (0x0303, _, _) = WM_CLEAR (* "0x0303" *)
2547    
2548    |   decompileMessage (0x0304, _, _) = WM_UNDO (* "0x0304" *)
2549    
2550    |   decompileMessage (0x0305, wp, _) = WM_RENDERFORMAT { format = fromCcbf(SysWord.toInt wp) } (* "0x0305" *)
2551    
2552    |   decompileMessage (0x0306, _, _) = WM_RENDERALLFORMATS (* "0x0306" *)
2553    
2554    |   decompileMessage (0x0307, _, _) = WM_DESTROYCLIPBOARD (* "0x0307" *)
2555    
2556    |   decompileMessage (0x0308, _, _) = WM_DRAWCLIPBOARD (* "0x0308" *)
2557    
2558    |   decompileMessage (0x0309, wp, _) = WM_PAINTCLIPBOARD { clipboard = toHWND wp  } (* "0x0309" *)
2559
2560    |   decompileMessage (0x030A, wp, lp) =
2561            WM_VSCROLLCLIPBOARD { viewer = toHWND wp, code = loWord lp, position = hiWord lp  } (* "0x030A" *)
2562    
2563    |   decompileMessage (0x030B, _, lp) = WM_SIZECLIPBOARD { viewer = toHWND lp  } (* "0x030B" *)
2564
2565            (* The format name is inserted by the window procedure so any
2566               incoming message won't have the information.  Indeed the
2567               buffer may not have been initialised. *)
2568    |   decompileMessage (0x030C, wp, _) = WM_ASKCBFORMATNAME { length = SysWord.toInt wp, formatName = ref ""  }
2569    
2570    |   decompileMessage (0x030D, wp, lp) = WM_CHANGECBCHAIN { removed = toHWND wp, next = toHWND lp }
2571    
2572    |   decompileMessage (0x030E, wp, lp) =
2573            WM_HSCROLLCLIPBOARD { viewer   = toHWND wp, code = loWord lp, position = hiWord lp  } (* "0x030E" *)
2574
2575    |   decompileMessage (0x030F, _, _) = WM_QUERYNEWPALETTE (* "0x030F" *)
2576
2577    |   decompileMessage (0x0310, wp, _) = WM_PALETTEISCHANGING { realize = toHWND wp } (* "0x0310" *)
2578
2579    |   decompileMessage (0x0311, wp, _) = WM_PALETTECHANGED { palChg = toHWND wp } (* "0x0311" *)
2580
2581    |   decompileMessage (0x0312, wp, _) = WM_HOTKEY { id = SysWord.toInt wp } (* "0x0312" *)
2582
2583    |   decompileMessage (0x0317, wp, lp) = WM_PRINT { hdc = toHDC wp, flags = fromCwmpl(Word32.fromLargeWord lp) }
2584
2585    |   decompileMessage (0x0318, wp, lp) = WM_PRINTCLIENT { hdc = toHDC wp, flags = fromCwmpl(Word32.fromLargeWord lp) }
2586
2587    |   decompileMessage (m, wp, lp) =
2588            (* User, application and registered messages. *)
2589            (* Rich edit controls use WM_USER+37 to WM_USER+122.  As and when we implement
2590               rich edit controls we may want to treat those messages specially. *)
2591            if m >= 0x0400 andalso m <= 0x7FFF
2592            then WM_USER { uMsg = m, wParam = wp, lParam = lp }
2593            else if m >= 0x8000 andalso m <= 0xBFFF
2594            then WM_APP { uMsg = m, wParam = wp, lParam = lp }
2595            else if m >= 0x8000 andalso m <= 0xFFFF
2596            then
2597                (
2598                (* We could use PolyML.OnEntry or use a weak byte ref to initialise the registered messages. *)
2599                if m = RegisterMessage "commdlg_FindReplace"
2600                then FINDMSGSTRING(decompileFindMsg{wp=wp, lp=lp})
2601                else WM_REGISTERED { uMsg = m, wParam = wp, lParam = lp }
2602                )
2603            else (* Other system messages. *)
2604                WM_SYSTEM_OTHER { uMsg = m, wParam = wp, lParam = lp }
2605
2606    fun btoi false = 0 | btoi true = 1
2607    
2608    fun makeLong(x, y) = Word32.toLargeWord(MAKELONG(Word.fromInt x, Word.fromInt y))
2609 
2610    (* If we return a string we need to ensure it's freed *)
2611    fun compileStringAsLp(code, wp, string) =
2612    let
2613        val s = toCstring string
2614    in
2615        (code, wp, fromAddr s, fn () => Memory.free s)
2616    end
2617    
2618    (* Requests for strings.  Many of these don't pass the length as an argument. *)
2619    fun compileStringRequest(code, wparam, length) =
2620    let
2621        open Memory
2622        val mem = malloc(Word.fromInt length)
2623    in
2624        (code, wparam, fromAddr mem, fn () => free mem)
2625    end
2626
2627    fun strAddrAsLp(code, wp, (addr, free)) = (code, wp, addr, free)
2628
2629    fun noFree () = ()
2630
2631    fun compileMessage WM_NULL = (0x0000, 0w0: SysWord.word, 0w0: SysWord.word, noFree)
2632
2633    |   compileMessage (WM_CREATE args) = compileCreate(0x0001, args)
2634
2635    |   compileMessage WM_DESTROY = (0x0002, 0w0, 0w0, noFree)
2636
2637    |   compileMessage (WM_MOVE {x, y}) = (0x0003, 0w0, makeLong(x, y), noFree)
2638
2639    |   compileMessage (WM_SIZE {flag, width, height}) =
2640            (0x0005, fromWMSizeOpt flag, makeLong(width, height), noFree)
2641
2642    |   compileMessage (WM_ACTIVATE {active, minimize}) =
2643            (0x0006, Word32.toLargeWord(MAKELONG(fromWMactive active, if minimize then 0w1 else 0w1)), 0w0, noFree)
2644
2645    |   compileMessage (WM_SETFOCUS {losing}) = (0x0007, 0w0, fromHWND losing, noFree)
2646
2647    |   compileMessage (WM_KILLFOCUS {receivefocus}) = (0x0008, 0w0, fromHWND receivefocus, noFree)
2648
2649    |   compileMessage (WM_ENABLE {enabled}) = (0x000A, if enabled then 0w1 else 0w0, 0w0, noFree)
2650
2651    |   compileMessage (WM_SETREDRAW {redrawflag}) = (0x000B, if redrawflag then 0w1 else 0w0, 0w0, noFree)
2652
2653    |   compileMessage (WM_SETTEXT {text}) = compileStringAsLp(0x000C, 0w0, text)
2654
2655    |   compileMessage (WM_GETTEXT {length, ...}) = compileStringRequest(0x000D, SysWord.fromInt length, length)
2656
2657    |   compileMessage WM_GETTEXTLENGTH = (0x000E, 0w0, 0w0, noFree)
2658
2659    |   compileMessage WM_PAINT = (0x000F, 0w0, 0w0, noFree)
2660
2661    |   compileMessage WM_CLOSE = (0x0010, 0w0, 0w0, noFree)
2662
2663    |   compileMessage (WM_QUERYENDSESSION { source}) = (0x0011, SysWord.fromInt source, 0w0, noFree)
2664
2665    |   compileMessage (WM_QUIT {exitcode}) = (0x0012, SysWord.fromInt exitcode, 0w0, noFree)
2666
2667    |   compileMessage WM_QUERYOPEN = (0x0013, 0w0, 0w0, noFree)
2668
2669    |   compileMessage (WM_ERASEBKGND {devicecontext}) = (0x0014, 0w0, fromHDC devicecontext, noFree)
2670
2671    |   compileMessage WM_SYSCOLORCHANGE = (0x0015, 0w0, 0w0, noFree)
2672
2673    |   compileMessage (WM_ENDSESSION {endsession}) = (0x0016, SysWord.fromInt(btoi endsession), 0w0, noFree)
2674
2675    |   compileMessage (WM_SHOWWINDOW {showflag, statusflag}) =
2676                (0x0018, SysWord.fromInt(btoi showflag), SysWord.fromInt statusflag, noFree)
2677
2678    |   compileMessage (WM_DEVMODECHANGE {devicename}) = compileStringAsLp(0x001B, 0w0, devicename)
2679
2680    |   compileMessage (WM_ACTIVATEAPP {active, threadid}) =
2681                (0x001B, SysWord.fromInt(btoi active), SysWord.fromInt threadid, noFree)
2682
2683    |   compileMessage WM_FONTCHANGE = (0x001D, 0w0, 0w0, noFree)
2684
2685    |   compileMessage WM_TIMECHANGE = (0x001E, 0w0, 0w0, noFree)
2686
2687    |   compileMessage WM_CANCELMODE = (0x001F, 0w0, 0w0, noFree)
2688
2689    |   compileMessage (WM_SETCURSOR {cursorwindow, hitTest, mousemessage}) =
2690            (0x0020, fromHWND cursorwindow, makeLong(fromHitTest hitTest, mousemessage), noFree)
2691
2692    |   compileMessage (WM_MOUSEACTIVATE {parent, hitTest, message}) =
2693            (0x0021, fromHWND parent, makeLong(fromHitTest hitTest, message), noFree)
2694
2695    |   compileMessage WM_CHILDACTIVATE = (0x0022, 0w0, 0w0, noFree)
2696
2697    |   compileMessage WM_QUEUESYNC = (0x0023, 0w0, 0w0, noFree)
2698    
2699    |   compileMessage(WM_GETMINMAXINFO args) = compileMinMax(0x0024, args)
2700
2701    |   compileMessage WM_PAINTICON = (0x0026, 0w0, 0w0, noFree)
2702
2703    |   compileMessage (WM_ICONERASEBKGND {devicecontext}) =
2704                (0x0027, fromHDC devicecontext, 0w0, noFree)
2705
2706    |   compileMessage (WM_NEXTDLGCTL {control, handleflag}) =
2707                (0x0028, SysWord.fromInt control, SysWord.fromInt(btoi handleflag), noFree)
2708
2709    |   compileMessage (WM_DRAWITEM { senderId, ctlType, ctlID, itemID, itemAction,itemState,
2710                                 hItem, hDC, rcItem, itemData}) =
2711            strAddrAsLp(0x002B, SysWord.fromInt senderId,
2712                fromMLDrawItem(ctlType, ctlID, itemID, itemAction,itemState, hItem, hDC,rcItem,itemData))
2713
2714    |   compileMessage (WM_MEASUREITEM{ senderId, ctlType, ctlID, itemID, itemWidth=ref itemWidth, itemHeight=ref itemHeight, itemData}) =
2715            strAddrAsLp(0x002C, SysWord.fromInt senderId,
2716                fromMLMeasureItem(ctlType, ctlID, itemID, itemWidth, itemHeight, itemData))
2717
2718    |   compileMessage (WM_DELETEITEM{ senderId, ctlType, ctlID, itemID, item, itemData}) =
2719            strAddrAsLp(0x002D, SysWord.fromInt senderId,
2720                fromMLDeleteItem(ctlType, ctlID, itemID, item, itemData))
2721
2722    |   compileMessage (WM_VKEYTOITEM {virtualKey, caretpos, listbox}) =
2723            (0x002E, makeLong(virtualKey, caretpos), fromHWND listbox, noFree)
2724
2725    |   compileMessage (WM_CHARTOITEM {key, caretpos, listbox}) =
2726            (0x002F, makeLong(key, caretpos), fromHWND listbox, noFree)
2727
2728    |   compileMessage (WM_SETFONT {font, redrawflag}) =
2729            (0x0030, fromHFONT font, if redrawflag then 0w1 else 0w0, noFree)
2730
2731    |   compileMessage WM_GETFONT = (0x0031, 0w0, 0w0, noFree)
2732
2733    |   compileMessage (WM_SETHOTKEY {virtualKey}) = (0x0032, SysWord.fromInt virtualKey, 0w0, noFree)
2734
2735    |   compileMessage WM_GETHOTKEY = (0x0033, 0w0, 0w0, noFree)
2736
2737    |   compileMessage WM_QUERYDRAGICON = (0x0037, 0w0, 0w0, noFree)
2738
2739    |   compileMessage (WM_COMPAREITEM { controlid, ctlType, ctlID, hItem, itemID1,itemData1, itemID2,itemData2}) =
2740        let
2741            (* TODO: Perhaps we should have locale Id in the argument record. *)
2742            val LOCALE_USER_DEFAULT = 0x0400
2743        in
2744            strAddrAsLp(0x0039, SysWord.fromInt controlid,
2745                fromMLCompareItem (ctlType, ctlID, hItem, itemID1, itemData1, itemID2, itemData2, LOCALE_USER_DEFAULT))
2746        end
2747
2748    |   compileMessage (WM_WINDOWPOSCHANGING wpc) = mlToCWindowPosChanging(0x0046, wpc)
2749
2750    |   compileMessage (WM_WINDOWPOSCHANGED wpc) = mlToCWindowPosChanged(0x0047, wpc)
2751
2752    |   compileMessage (WM_POWER {powerevent}) = (0x0048, SysWord.fromInt powerevent, 0w0, noFree)
2753
2754    |   compileMessage WM_CANCELJOURNAL = (0x004B, 0w0, 0w0, noFree)
2755
2756    |   compileMessage (WM_NOTIFY {idCtrl, from, idFrom, notification}) =
2757            strAddrAsLp (0x004E, SysWord.fromInt idCtrl, compileNotification(from, idFrom, notification))
2758
2759(*
2760WM_INPUTLANGCHANGEREQUEST       0x0050
2761WM_INPUTLANGCHANGE              0x0051
2762WM_TCARD                        0x0052
2763WM_USERCHANGED                  0x0054
2764WM_NOTIFYFORMAT                 0x0055
2765
2766WM_STYLECHANGING                0x007C
2767WM_STYLECHANGED                 0x007D
2768*)
2769
2770    |   compileMessage (WM_HELP args) = compileHelpInfo(0x0053, args)
2771
2772    |   compileMessage (WM_CONTEXTMENU { hwnd, xPos, yPos }) =
2773            (0x007B, fromHWND hwnd, makeLong(xPos, yPos), noFree)
2774
2775    |   compileMessage (WM_DISPLAYCHANGE { bitsPerPixel, xScreen, yScreen}) =
2776            (0x007E, SysWord.fromInt bitsPerPixel, makeLong(xScreen, yScreen), noFree)
2777
2778    |   compileMessage (WM_GETICON {big}) = (0x007F, SysWord.fromInt(btoi big), 0w0, noFree)
2779
2780    |   compileMessage (WM_SETICON { big, icon }) =
2781            (0x0080, SysWord.fromInt(btoi big), fromAddr(voidStarOfHandle icon), noFree)
2782
2783    |   compileMessage (WM_NCCREATE args) = compileCreate(0x0081, args)
2784
2785    |   compileMessage WM_NCDESTROY = (0x0082, 0w0, 0w0, noFree)
2786
2787    |   compileMessage (WM_NCCALCSIZE args) = compileNCCalcSize args
2788
2789    |   compileMessage (WM_NCHITTEST {x, y}) = (0x0084, 0w0, makeLong(x, y), noFree)
2790
2791    |   compileMessage (WM_NCPAINT {region}) = (0x0085, fromHRGN region, 0w0, noFree)
2792
2793    |   compileMessage (WM_NCACTIVATE {active}) = (0x0086, SysWord.fromInt(btoi active), 0w0, noFree)
2794
2795    |   compileMessage WM_GETDLGCODE = (0x0087, 0w0, 0w0, noFree)
2796
2797    |   compileMessage (WM_NCMOUSEMOVE {hitTest, x, y}) =
2798                (0x00A0, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2799
2800    |   compileMessage (WM_NCLBUTTONDOWN {hitTest, x, y}) =
2801                (0x00A1, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2802
2803    |   compileMessage (WM_NCLBUTTONUP {hitTest, x, y}) =
2804                (0x00A2, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2805
2806    |   compileMessage (WM_NCLBUTTONDBLCLK {hitTest, x, y}) =
2807                (0x00A3, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2808
2809    |   compileMessage (WM_NCRBUTTONDOWN {hitTest, x, y}) =
2810                (0x00A4, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2811
2812    |   compileMessage (WM_NCRBUTTONUP {hitTest, x, y}) =
2813                (0x00A5, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2814
2815    |   compileMessage (WM_NCRBUTTONDBLCLK {hitTest, x, y}) =
2816                (0x00A6, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2817
2818    |   compileMessage (WM_NCMBUTTONDOWN {hitTest, x, y}) =
2819                (0x00A7, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2820
2821    |   compileMessage (WM_NCMBUTTONUP {hitTest, x, y}) =
2822                (0x00A8, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2823
2824    |   compileMessage (WM_NCMBUTTONDBLCLK {hitTest, x, y}) =
2825                (0x00A9, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
2826
2827(* Edit control messages *)
2828    |   compileMessage (EM_GETSEL args) = compileGetSel(0x00B0, args)
2829
2830    |   compileMessage (EM_SETSEL{startPos, endPos}) =
2831            (0x00B1, SysWord.fromInt startPos, SysWord.fromInt endPos, noFree)
2832
2833    |   compileMessage (EM_GETRECT {rect=ref r}) = compileGetRect(0x00B2, 0w0, r)
2834
2835    |   compileMessage (EM_SETRECT {rect}) = compileSetRect(0x00B3, rect)
2836
2837    |   compileMessage (EM_SETRECTNP {rect}) = compileSetRect(0x00B4, rect)
2838
2839    |   compileMessage (EM_SCROLL{action}) = (0x00B5, Word.toLargeWord(toCsd action), 0w0, noFree)
2840
2841    |   compileMessage (EM_LINESCROLL{xScroll, yScroll}) =
2842            (0x00B6, SysWord.fromInt xScroll, SysWord.fromInt yScroll, noFree)
2843
2844    |   compileMessage EM_SCROLLCARET = (0x00B7, 0w0, 0w0, noFree)
2845
2846    |   compileMessage EM_GETMODIFY = (0x00B8, 0w0, 0w0, noFree)
2847
2848    |   compileMessage (EM_SETMODIFY{modified}) = (0x00B9, if modified then 0w1 else 0w0, 0w0, noFree)
2849
2850    |   compileMessage EM_GETLINECOUNT = (0x00BA, 0w0, 0w0, noFree)
2851
2852    |   compileMessage (EM_LINEINDEX{line}) = (0x00BB, SysWord.fromInt line, 0w0, noFree)
2853(*
2854EM_SETHANDLE            0x00BC
2855*)
2856    |   compileMessage EM_GETTHUMB = (0x00BE, 0w0, 0w0, noFree)
2857
2858    |   compileMessage (EM_LINELENGTH{index}) = (0x00BB, SysWord.fromInt index, 0w0, noFree)
2859
2860    |   compileMessage (EM_REPLACESEL{canUndo, text}) = compileStringAsLp(0x00C2, SysWord.fromInt(btoi canUndo), text)
2861
2862    |   compileMessage (EM_GETLINE args) = compileGetLine args
2863
2864    |   compileMessage (EM_LIMITTEXT{limit}) = (0x00C5, SysWord.fromInt limit, 0w0, noFree)
2865
2866    |   compileMessage EM_CANUNDO = (0x00C6, 0w0, 0w0, noFree)
2867
2868    |   compileMessage EM_UNDO = (0x00C7, 0w0, 0w0, noFree)
2869
2870    |   compileMessage (EM_FMTLINES{addEOL}) = (0x00C8, SysWord.fromInt(btoi addEOL), 0w0, noFree)
2871
2872    |   compileMessage (EM_LINEFROMCHAR{index}) = (0x00C9, SysWord.fromInt index, 0w0, noFree)
2873
2874    |   compileMessage (EM_SETTABSTOPS{tabs}) = compileTabStops(0x00CB, tabs)
2875
2876    |   compileMessage (EM_SETPASSWORDCHAR{ch}) = (0x00CC, SysWord.fromInt(ord ch), 0w0, noFree)
2877
2878    |   compileMessage EM_EMPTYUNDOBUFFER = (0x00CD, 0w0, 0w0, noFree)
2879
2880    |   compileMessage EM_GETFIRSTVISIBLELINE = (0x00CE, 0w0, 0w0, noFree)
2881
2882    |   compileMessage (EM_SETREADONLY{readOnly}) = (0x00CF, SysWord.fromInt(btoi readOnly), 0w0, noFree)
2883(*
2884EM_SETWORDBREAKPROC     0x00D0
2885EM_GETWORDBREAKPROC     0x00D1
2886*)
2887    |   compileMessage EM_GETPASSWORDCHAR = (0x00D2, 0w0, 0w0, noFree)
2888
2889    |   compileMessage (EM_SETMARGINS{margins}) =
2890        (
2891            case margins of
2892                UseFontInfo => (0x00D3, SysWord.fromInt 0xffff, 0w0, noFree)
2893            |   Margins{left, right} =>
2894                let
2895                    val (b0, lo) = case left of SOME l => (0w1, l) | NONE => (0w0, 0)
2896                    val (b1, hi) = case right of SOME r => (0w2, r) | NONE => (0w0, 0)
2897                in
2898                    (0x00D3, SysWord.orb(b0, b1), makeLong(hi,lo), noFree)
2899                end
2900       )
2901
2902    |   compileMessage EM_GETMARGINS = (0x00D4, 0w0, 0w0, noFree) (* Returns margins in lResult *)
2903
2904    |   compileMessage EM_GETLIMITTEXT = (0x00D5, 0w0, 0w0, noFree)
2905
2906    |   compileMessage (EM_POSFROMCHAR {index}) = (0x00D6, SysWord.fromInt index, 0w0, noFree)
2907
2908    |   compileMessage (EM_CHARFROMPOS arg) =
2909        let
2910            val (lParam, toFree) =
2911                case arg of
2912                    EMcfpEdit{x,y} => (makeLong(x, y), noFree)
2913                |   EMcfpRichEdit pt => makePointStructAddr pt
2914                |   EMcfpUnknown lp => (lp, noFree)
2915        in
2916            (0x00D7, 0w0, lParam, toFree)
2917        end
2918
2919(* Scroll bar messages *)
2920
2921    |   compileMessage (SBM_SETPOS {pos, redraw}) = (0x00E0, SysWord.fromInt pos, SysWord.fromInt(btoi redraw), noFree)
2922
2923    |   compileMessage SBM_GETPOS = (0x00E1, 0w0, 0w0, noFree)
2924
2925    |   compileMessage (SBM_SETRANGE {minPos, maxPos}) = (0x00E2, SysWord.fromInt minPos, SysWord.fromInt maxPos, noFree)
2926
2927    |   compileMessage (SBM_SETRANGEREDRAW {minPos, maxPos}) = (0x00E6, SysWord.fromInt minPos, SysWord.fromInt maxPos, noFree)
2928
2929    |   compileMessage (SBM_GETRANGE _) =
2930        let
2931            (* An application should use GetScrollRange rather than sending this.*)
2932            open Memory
2933            (* We need to allocate two ints and pass their addresses *)
2934            val mem = malloc(0w2 * sizeInt)
2935            infix 6 ++
2936        in
2937            (0x00E3, fromAddr mem, fromAddr(mem ++ sizeInt), fn () => free mem)
2938        end
2939
2940    |   compileMessage (SBM_ENABLE_ARROWS flags) = (0x00E4, SysWord.fromInt(toCesbf flags), 0w0, noFree)
2941
2942    |   compileMessage (SBM_SETSCROLLINFO {info, options}) =
2943            strAddrAsLp(0x00E9, 0w0, fromScrollInfo(info, options))
2944
2945    |   compileMessage (SBM_GETSCROLLINFO {info = ref info, options}) =
2946            strAddrAsLp(0x00EA, 0w0, fromScrollInfo(info, options))
2947
2948(* Button control messages *)
2949
2950    |   compileMessage BM_GETCHECK = (0x00F0, 0w0, 0w0, noFree)
2951
2952    |   compileMessage (BM_SETCHECK{state}) = (0x00F1, SysWord.fromInt state, 0w0, noFree)
2953
2954    |   compileMessage BM_GETSTATE = (0x00F2, 0w0, 0w0, noFree)
2955
2956    |   compileMessage (BM_SETSTATE{highlight}) = (0x00F3, SysWord.fromInt(btoi highlight), 0w0, noFree)
2957
2958    |   compileMessage (BM_SETSTYLE{redraw, style})
2959            = (0x00F3, SysWord.fromInt(LargeWord.toInt(Style.toWord style)), SysWord.fromInt(btoi redraw), noFree)
2960
2961    |   compileMessage BM_CLICK = (0x00F5, 0w0, 0w0, noFree)
2962
2963    |   compileMessage (BM_GETIMAGE{imageType}) = (0x00F6, SysWord.fromInt(toCit imageType), 0w0, noFree)
2964
2965    |   compileMessage (BM_SETIMAGE{imageType, image}) =
2966                (0x00F7, SysWord.fromInt(toCit imageType), fromHGDIOBJ image, noFree)
2967
2968    |   compileMessage (WM_KEYDOWN {virtualKey, data}) = (0x0100, SysWord.fromInt virtualKey, Word32.toLargeWord data, noFree)
2969
2970    |   compileMessage (WM_KEYUP {virtualKey, data}) = (0x0101, SysWord.fromInt virtualKey, Word32.toLargeWord data, noFree)
2971
2972    |   compileMessage (WM_CHAR {charCode, data}) = (0x0102, SysWord.fromInt(ord charCode), Word32.toLargeWord data, noFree)
2973
2974    |   compileMessage (WM_DEADCHAR {charCode, data}) = (0x0103, SysWord.fromInt(ord charCode), Word32.toLargeWord data, noFree)
2975
2976    |   compileMessage (WM_SYSKEYDOWN {virtualKey, data}) = (0x0104, SysWord.fromInt virtualKey, Word32.toLargeWord data, noFree)
2977
2978    |   compileMessage (WM_SYSKEYUP {virtualKey, data}) = (0x0105, SysWord.fromInt virtualKey, Word32.toLargeWord data, noFree)
2979
2980    |   compileMessage (WM_SYSCHAR {charCode, data}) = (0x0106, SysWord.fromInt(ord charCode), Word32.toLargeWord data, noFree)
2981
2982    |   compileMessage (WM_SYSDEADCHAR {charCode, data}) = (0x0107, SysWord.fromInt(ord charCode), Word32.toLargeWord data, noFree)
2983(*
2984WM_IME_STARTCOMPOSITION         0x010D
2985WM_IME_ENDCOMPOSITION           0x010E
2986WM_IME_COMPOSITION              0x010F
2987WM_IME_KEYLAST                  0x010F
2988
2989*)
2990
2991    |   compileMessage (WM_INITDIALOG { dialog, initdata}) =
2992            (0x0110, fromHWND dialog, SysWord.fromInt initdata, noFree)
2993
2994    |   compileMessage (WM_COMMAND {notifyCode, wId, control}) =
2995            (0x0111, makeLong(wId, notifyCode), fromHWND control, noFree)
2996
2997    |   compileMessage (WM_SYSCOMMAND {commandvalue, sysBits, p={x,y}}) =
2998            (0x0112, Word.toLargeWord(Word.orb(Word.fromInt sysBits, Word.fromInt(fromSysCommand commandvalue))),
2999             makeLong(x,y), noFree)
3000
3001    |   compileMessage (WM_TIMER {timerid}) = (0x0113, SysWord.fromInt timerid, 0w0, noFree)
3002
3003    |   compileMessage (WM_HSCROLL {value, position, scrollbar}) =
3004            (0x0114, makeLong(Word.toInt(toCsd value), position), fromHWND scrollbar, noFree)
3005
3006    |   compileMessage (WM_VSCROLL {value, position, scrollbar}) =
3007            (0x0115, makeLong(Word.toInt(toCsd value), position), fromHWND scrollbar, noFree)
3008
3009    |   compileMessage (WM_INITMENU {menu}) =
3010            (0x0116, fromHMENU menu, 0w0, noFree)
3011
3012    |   compileMessage (WM_INITMENUPOPUP {menupopup, itemposition, isSystemMenu}) =
3013            (0x0117, fromHMENU menupopup, makeLong(itemposition, btoi isSystemMenu), noFree)
3014
3015    |   compileMessage (WM_MENUSELECT {menuitem, menuflags, menu}) =
3016            (0x011F, makeLong(menuitem, Word32.toInt(MenuBase.fromMenuFlagSet menuflags)), fromHMENU menu, noFree)
3017
3018    |   compileMessage (WM_MENUCHAR { ch, menuflag, menu}) =
3019            (0x0120, makeLong(ord ch, Word32.toInt(MenuBase.fromMenuFlag menuflag)), fromHMENU menu, noFree)
3020
3021    |   compileMessage (WM_ENTERIDLE { flag, window}) = (0x0121, SysWord.fromInt flag, fromHWND window, noFree)
3022
3023    |   compileMessage (WM_CTLCOLORMSGBOX { displaycontext, messagebox}) =
3024            (0x0132, fromHDC displaycontext, fromHWND messagebox, noFree)
3025
3026    |   compileMessage (WM_CTLCOLOREDIT { displaycontext, editcontrol}) =
3027            (0x0133, fromHDC displaycontext, fromHWND editcontrol, noFree)
3028
3029    |   compileMessage (WM_CTLCOLORLISTBOX { displaycontext, listbox}) =
3030            (0x0134, fromHDC displaycontext, fromHWND listbox, noFree)
3031
3032    |   compileMessage (WM_CTLCOLORBTN { displaycontext, button}) =
3033            (0x0135, fromHDC displaycontext, fromHWND button, noFree)
3034
3035    |   compileMessage (WM_CTLCOLORDLG { displaycontext, dialogbox}) =
3036            (0x0136, fromHDC displaycontext, fromHWND dialogbox, noFree)
3037
3038    |   compileMessage (WM_CTLCOLORSCROLLBAR { displaycontext, scrollbar}) =
3039            (0x0137, fromHDC displaycontext, fromHWND scrollbar, noFree)
3040
3041    |   compileMessage (WM_CTLCOLORSTATIC { displaycontext, staticcontrol}) =
3042            (0x0138, fromHDC displaycontext, fromHWND staticcontrol, noFree)
3043
3044(* Combobox messages. *)
3045
3046    |   compileMessage (CB_GETEDITSEL args) = compileGetSel(0x0140, args)
3047
3048    |   compileMessage (CB_LIMITTEXT{limit}) = (0x0141, SysWord.fromInt limit, 0w0, noFree)
3049
3050    |   compileMessage (CB_SETEDITSEL{startPos, endPos}) =
3051            (0x0142, 0w0, makeLong(startPos, endPos), noFree)
3052
3053    |   compileMessage (CB_ADDSTRING{text}) = compileStringAsLp(0x0143, 0w0, text)
3054
3055    |   compileMessage (CB_DELETESTRING{index}) = (0x0144, SysWord.fromInt index, 0w0, noFree)
3056
3057    |   compileMessage (CB_DIR{attrs, fileSpec}) = compileStringAsLp(0x0145, Word32.toLargeWord(toCcbal attrs), fileSpec)
3058
3059    |   compileMessage CB_GETCOUNT = (0x0146, 0w0, 0w0, noFree)
3060
3061    |   compileMessage CB_GETCURSEL = (0x0147, 0w0, 0w0, noFree)
3062
3063    |   compileMessage (CB_GETLBTEXT {length, index, ...}) = compileStringRequest(0x0148, SysWord.fromInt index, length)
3064
3065    |   compileMessage (CB_GETLBTEXTLEN{index}) = (0x0149, SysWord.fromInt index, 0w0, noFree)
3066
3067    |   compileMessage (CB_INSERTSTRING{text, index}) = compileStringAsLp(0x014A, SysWord.fromInt index, text)
3068
3069    |   compileMessage CB_RESETCONTENT = (0x014B, 0w0, 0w0, noFree)
3070
3071    |   compileMessage (CB_FINDSTRING{text, indexStart}) = compileStringAsLp(0x014C, SysWord.fromInt indexStart, text)
3072
3073    |   compileMessage (CB_SELECTSTRING{text, indexStart}) = compileStringAsLp(0x014D, SysWord.fromInt indexStart, text)
3074
3075    |   compileMessage (CB_SETCURSEL{index}) = (0x014E, SysWord.fromInt index, 0w0, noFree)
3076
3077    |   compileMessage (CB_SHOWDROPDOWN{show}) = (0x014F, SysWord.fromInt(btoi show), 0w0, noFree)
3078
3079    |   compileMessage (CB_GETITEMDATA{index}) = (0x0150, SysWord.fromInt index, 0w0, noFree)
3080
3081    |   compileMessage (CB_SETITEMDATA{index, data}) = (0x0151, SysWord.fromInt index, SysWord.fromInt data, noFree)
3082
3083    |   compileMessage (CB_GETDROPPEDCONTROLRECT {rect=ref rect}) = compileGetRect(0x0152, 0w0, rect)
3084
3085    |   compileMessage (CB_SETITEMHEIGHT{index, height}) = (0x0153, SysWord.fromInt index, SysWord.fromInt height, noFree)
3086
3087    |   compileMessage (CB_GETITEMHEIGHT{index}) = (0x0154, SysWord.fromInt index, 0w0, noFree)
3088
3089    |   compileMessage (CB_SETEXTENDEDUI{extended}) = (0x0155, SysWord.fromInt(btoi extended), 0w0, noFree)
3090
3091    |   compileMessage CB_GETEXTENDEDUI = (0x0156, 0w0, 0w0, noFree)
3092
3093    |   compileMessage CB_GETDROPPEDSTATE = (0x0157, 0w0, 0w0, noFree)
3094
3095    |   compileMessage (CB_FINDSTRINGEXACT{text, indexStart}) = compileStringAsLp(0x0158, SysWord.fromInt indexStart, text)
3096
3097    |   compileMessage (CB_SETLOCALE{locale}) = (0x0159, SysWord.fromInt locale, 0w0, noFree)
3098
3099    |   compileMessage CB_GETLOCALE = (0x015A, 0w0, 0w0, noFree)
3100
3101    |   compileMessage CB_GETTOPINDEX = (0x015b, 0w0, 0w0, noFree)
3102
3103    |   compileMessage (CB_SETTOPINDEX{index}) = (0x015c, SysWord.fromInt index, 0w0, noFree)
3104
3105    |   compileMessage CB_GETHORIZONTALEXTENT = (0x015d, 0w0, 0w0, noFree)
3106
3107    |   compileMessage (CB_SETHORIZONTALEXTENT{extent}) = (0x015e, SysWord.fromInt extent, 0w0, noFree)
3108
3109    |   compileMessage CB_GETDROPPEDWIDTH = (0x015f, 0w0, 0w0, noFree)
3110
3111    |   compileMessage (CB_SETDROPPEDWIDTH{width}) = (0x0160, SysWord.fromInt width, 0w0, noFree)
3112
3113    |   compileMessage (CB_INITSTORAGE{items, bytes}) = (0x0161, SysWord.fromInt items, SysWord.fromInt bytes, noFree)
3114
3115(* Static control messages. *)
3116
3117    |   compileMessage (STM_SETICON{icon}) = (0x0170, fromHICON icon, 0w0, noFree)
3118
3119    |   compileMessage STM_GETICON = (0x0171, 0w0, 0w0, noFree)
3120
3121    |   compileMessage (STM_SETIMAGE{imageType, image}) =
3122                (0x0172, SysWord.fromInt(toCit imageType), fromHGDIOBJ image, noFree)
3123
3124    |   compileMessage (STM_GETIMAGE{imageType}) = (0x0173, SysWord.fromInt(toCit imageType), 0w0, noFree)
3125
3126(* Listbox messages *)
3127    |   compileMessage (LB_ADDSTRING{text}) = compileStringAsLp(0x0180, 0w0, text)
3128
3129    |   compileMessage (LB_INSERTSTRING{text, index}) = compileStringAsLp(0x0181, SysWord.fromInt index, text)
3130
3131    |   compileMessage (LB_DELETESTRING{index}) = (0x0182, SysWord.fromInt index, 0w0, noFree)
3132
3133    |   compileMessage (LB_SELITEMRANGEEX{first, last}) = (0x0183, SysWord.fromInt first, SysWord.fromInt last, noFree)
3134
3135    |   compileMessage LB_RESETCONTENT = (0x0184, 0w0, 0w0, noFree)
3136
3137    |   compileMessage (LB_SETSEL{select, index}) = (0x0185, SysWord.fromInt(btoi select), SysWord.fromInt index, noFree)
3138
3139    |   compileMessage (LB_SETCURSEL{index}) = (0x0186, SysWord.fromInt index, 0w0, noFree)
3140
3141    |   compileMessage (LB_GETSEL{index}) = (0x0187, SysWord.fromInt index, 0w0, noFree)
3142
3143    |   compileMessage LB_GETCURSEL = (0x0188, 0w0, 0w0, noFree)
3144
3145    |   compileMessage (LB_GETTEXT {length, index, ...}) = compileStringRequest(0x0189, SysWord.fromInt index, length)
3146
3147    |   compileMessage (LB_GETTEXTLEN{index}) = (0x018A, SysWord.fromInt index, 0w0, noFree)
3148
3149    |   compileMessage LB_GETCOUNT = (0x018B, 0w0, 0w0, noFree)
3150
3151    |   compileMessage (LB_SELECTSTRING{text, indexStart}) = compileStringAsLp(0x018C, SysWord.fromInt indexStart, text)
3152
3153    |   compileMessage (LB_DIR{attrs, fileSpec}) = compileStringAsLp(0x018D, Word32.toLargeWord(toCcbal attrs), fileSpec)
3154
3155    |   compileMessage LB_GETTOPINDEX = (0x018E, 0w0, 0w0, noFree)
3156
3157    |   compileMessage (LB_FINDSTRING{text, indexStart}) = compileStringAsLp (0x018F, SysWord.fromInt indexStart, text)
3158
3159    |   compileMessage LB_GETSELCOUNT = (0x0190, 0w0, 0w0, noFree)
3160
3161    |   compileMessage (LB_GETSELITEMS args) = compileGetSelItems(0x0191, args)
3162
3163    |   compileMessage (LB_SETTABSTOPS{tabs}) = compileTabStops(0x0192, tabs)
3164
3165    |   compileMessage LB_GETHORIZONTALEXTENT = (0x0193, 0w0, 0w0, noFree)
3166
3167    |   compileMessage (LB_SETHORIZONTALEXTENT{extent}) = (0x0194, SysWord.fromInt extent, 0w0, noFree)
3168
3169    |   compileMessage (LB_SETCOLUMNWIDTH{column}) = (0x0195, SysWord.fromInt column, 0w0, noFree)
3170
3171    |   compileMessage (LB_ADDFILE{fileName}) = compileStringAsLp(0x0196, 0w0, fileName)
3172
3173    |   compileMessage (LB_SETTOPINDEX{index}) = (0x0197, SysWord.fromInt index, 0w0, noFree)
3174
3175    |   compileMessage (LB_GETITEMRECT{rect=ref rect, index}) = compileGetRect(0x0198, SysWord.fromInt index, rect)
3176
3177    |   compileMessage (LB_GETITEMDATA{index}) = (0x0199, SysWord.fromInt index, 0w0, noFree)
3178
3179    |   compileMessage (LB_SETITEMDATA{index, data}) = (0x019A, SysWord.fromInt index, SysWord.fromInt data, noFree)
3180
3181    |   compileMessage (LB_SELITEMRANGE{select, first, last}) =
3182            (0x019B, SysWord.fromInt(btoi select), makeLong(first, last), noFree)
3183
3184    |   compileMessage (LB_SETANCHORINDEX{index}) = (0x019C, SysWord.fromInt index, 0w0, noFree)
3185
3186    |   compileMessage LB_GETANCHORINDEX = (0x019D, 0w0, 0w0, noFree)
3187
3188    |   compileMessage (LB_SETCARETINDEX{index, scroll}) = (0x019E, SysWord.fromInt index, SysWord.fromInt(btoi scroll), noFree)
3189
3190    |   compileMessage LB_GETCARETINDEX = (0x019F, 0w0, 0w0, noFree)
3191
3192    |   compileMessage (LB_SETITEMHEIGHT{index, height}) =
3193                (0x01A0, SysWord.fromInt index, makeLong(height, 0), noFree)
3194
3195    |   compileMessage (LB_GETITEMHEIGHT{index}) = (0x01A1, SysWord.fromInt index, 0w0, noFree)
3196
3197    |   compileMessage (LB_FINDSTRINGEXACT{text, indexStart}) =
3198            compileStringAsLp(0x01A2, SysWord.fromInt indexStart, text)
3199
3200    |   compileMessage (LB_SETLOCALE{locale}) = (0x01A5, SysWord.fromInt locale, 0w0, noFree)
3201
3202    |   compileMessage LB_GETLOCALE = (0x01A6, 0w0, 0w0, noFree)
3203
3204    |   compileMessage (LB_SETCOUNT{items}) = (0x01A7, SysWord.fromInt items, 0w0, noFree)
3205
3206    |   compileMessage (LB_INITSTORAGE{items, bytes}) = (0x01A8, SysWord.fromInt items, SysWord.fromInt bytes, noFree)
3207
3208    |   compileMessage (LB_ITEMFROMPOINT { point = {x, y}}) = (0x01A9, 0w0, makeLong(x,y), noFree)
3209
3210    |   compileMessage (WM_MOUSEMOVE margs) = compileMouseMove(0x0200, margs)
3211
3212    |   compileMessage (WM_LBUTTONDOWN margs) = compileMouseMove(0x0201, margs)
3213
3214    |   compileMessage (WM_LBUTTONUP margs) = compileMouseMove(0x0202, margs)
3215
3216    |   compileMessage (WM_LBUTTONDBLCLK margs) = compileMouseMove(0x0203, margs)
3217
3218    |   compileMessage (WM_RBUTTONDOWN margs) = compileMouseMove(0x0204, margs)
3219
3220    |   compileMessage (WM_RBUTTONUP margs) = compileMouseMove(0x0205, margs)
3221
3222    |   compileMessage (WM_RBUTTONDBLCLK margs) = compileMouseMove(0x0206, margs)
3223
3224    |   compileMessage (WM_MBUTTONDOWN margs) = compileMouseMove(0x0207, margs)
3225
3226    |   compileMessage (WM_MBUTTONUP margs) = compileMouseMove(0x0208, margs)
3227
3228    |   compileMessage (WM_MBUTTONDBLCLK margs) = compileMouseMove(0x0209, margs)
3229 (*
3230WM_MOUSEWHEEL                   0x020A
3231*)
3232
3233    |   compileMessage (WM_PARENTNOTIFY { eventflag, idchild, value}) =
3234            (0x0210, makeLong(eventflag,idchild), SysWord.fromInt value, noFree)
3235
3236    |   compileMessage (WM_ENTERMENULOOP {istrack}) = (0x0211, SysWord.fromInt(btoi istrack), 0w0, noFree)
3237
3238    |   compileMessage (WM_EXITMENULOOP {istrack}) = (0x0212, SysWord.fromInt(btoi istrack), 0w0, noFree)
3239
3240(*
3241WM_NEXTMENU                     0x0213
3242WM_SIZING                       0x0214
3243*)
3244
3245    |   compileMessage (WM_CAPTURECHANGED {newCapture}) = (0x0215, 0w0, fromHWND newCapture, noFree)
3246(*
3247WM_MOVING                       0x0216
3248WM_POWERBROADCAST               0x0218
3249WM_DEVICECHANGE                 0x0219
3250*)
3251
3252    |   compileMessage (WM_MDICREATE{class, title, instance, x, y, cx, cy, style, cdata}) =
3253            strAddrAsLp (0x0220, 0w0, fromMdiCreate(class,title,instance,x,y,cx,cy,style,cdata))
3254
3255    |   compileMessage (WM_MDIDESTROY{child}) =
3256            (0x0221, fromHWND child, 0w0, noFree)
3257
3258    |   compileMessage (WM_MDIRESTORE{child}) =
3259            (0x0223, fromHWND child, 0w0, noFree)
3260
3261    |   compileMessage (WM_MDINEXT{child, flagnext}) =
3262            (0x0224, fromHWND child, SysWord.fromInt(btoi flagnext), noFree)
3263
3264    |   compileMessage (WM_MDIMAXIMIZE{child}) =
3265            (0x0225, fromHWND child, 0w0, noFree)
3266
3267    |   compileMessage (WM_MDITILE{tilingflag}) = (0x0226, Word32.toLargeWord(toCmdif tilingflag), 0w0, noFree)
3268
3269    |   compileMessage (WM_MDICASCADE{skipDisabled}) =
3270            (0x0227, SysWord.fromInt(if skipDisabled then 2 else 0), 0w0, noFree)
3271
3272    |   compileMessage WM_MDIICONARRANGE = (0x0228, 0w0, 0w0, noFree)
3273
3274    |   compileMessage WM_MDIGETACTIVE = (0x0229, 0w0, 0w0 (* MUST be null *), noFree)
3275
3276    |   compileMessage (WM_MDISETMENU{frameMenu, windowMenu}) =
3277            (0x0230, fromHMENU frameMenu, fromHMENU windowMenu, noFree)
3278
3279    |   compileMessage WM_ENTERSIZEMOVE = (0x0231, 0w0, 0w0, noFree)
3280
3281    |   compileMessage WM_EXITSIZEMOVE = (0x0232, 0w0, 0w0, noFree)
3282
3283    |   compileMessage (WM_DROPFILES{hDrop}) = (0x0233, fromHDROP hDrop, 0w0, noFree)
3284
3285    |   compileMessage WM_MDIREFRESHMENU = (0x0234, 0w0, 0w0, noFree)
3286(*
3287WM_IME_SETCONTEXT               0x0281
3288WM_IME_NOTIFY                   0x0282
3289WM_IME_CONTROL                  0x0283
3290WM_IME_COMPOSITIONFULL          0x0284
3291WM_IME_SELECT                   0x0285
3292WM_IME_CHAR                     0x0286
3293WM_IME_KEYDOWN                  0x0290
3294WM_IME_KEYUP                    0x0291
3295*)
3296    |   compileMessage (WM_NCMOUSEHOVER {hitTest, x, y}) =
3297            (0x02A0, SysWord.fromInt(fromHitTest hitTest), makeXYParam(x, y), noFree)
3298
3299    |   compileMessage (WM_MOUSEHOVER margs) = compileMouseMove(0x02A1, margs)
3300
3301    |   compileMessage WM_NCMOUSELEAVE = (0x02A2, 0w0, 0w0, noFree)
3302
3303    |   compileMessage WM_MOUSELEAVE = (0x02A3, 0w0, 0w0, noFree)
3304
3305    |   compileMessage WM_CUT = (0x0300, 0w0, 0w0, noFree)
3306
3307    |   compileMessage WM_COPY = (0x0301, 0w0, 0w0, noFree)
3308
3309    |   compileMessage WM_PASTE = (0x0302, 0w0, 0w0, noFree)
3310
3311    |   compileMessage WM_CLEAR = (0x0303, 0w0, 0w0, noFree)
3312
3313    |   compileMessage WM_UNDO = (0x0304, 0w0, 0w0, noFree)
3314
3315    |   compileMessage (WM_RENDERFORMAT {format}) = (0x0305, SysWord.fromInt(toCcbf format), 0w0, noFree)
3316
3317    |   compileMessage WM_RENDERALLFORMATS = (0x0306, 0w0, 0w0, noFree)
3318
3319    |   compileMessage WM_DESTROYCLIPBOARD = (0x0307, 0w0, 0w0, noFree)
3320
3321    |   compileMessage WM_DRAWCLIPBOARD = (0x0308, 0w0, 0w0, noFree)
3322
3323    |   compileMessage (WM_PAINTCLIPBOARD{clipboard}) =
3324            (0x030A, fromHWND clipboard, 0w0, noFree)
3325
3326    |   compileMessage (WM_VSCROLLCLIPBOARD{viewer, code, position}) =
3327            (0x030A, fromHWND viewer, makeLong(code, position), noFree)
3328
3329    |   compileMessage (WM_SIZECLIPBOARD{viewer}) = (0x030B, 0w0, fromHWND viewer, noFree)
3330
3331    |   compileMessage (WM_ASKCBFORMATNAME {length, ...}) = compileStringRequest(0x030C, SysWord.fromInt length, length)
3332
3333    |   compileMessage (WM_CHANGECBCHAIN{removed, next}) =
3334            (0x030D, fromHWND removed, fromHWND next, noFree)
3335
3336    |   compileMessage (WM_HSCROLLCLIPBOARD{viewer, code, position}) =
3337            (0x030E, fromHWND viewer, makeLong(code, position), noFree)
3338
3339    |   compileMessage WM_QUERYNEWPALETTE = (0x030F, 0w0, 0w0, noFree)
3340
3341    |   compileMessage (WM_PALETTEISCHANGING{realize}) =
3342            (0x0310, fromHWND realize, 0w0, noFree)
3343
3344    |   compileMessage (WM_PALETTECHANGED{palChg}) =
3345            (0x0311, fromHWND palChg, 0w0, noFree)
3346
3347    |   compileMessage (WM_HOTKEY{id}) = (0x0312, SysWord.fromInt id, 0w0, noFree)
3348
3349    |   compileMessage (WM_PRINT{hdc, flags}) =
3350            (0x0317, fromHDC hdc, Word32.toLargeWord(toCwmpl flags), noFree)
3351
3352    |   compileMessage (WM_PRINTCLIENT{hdc, flags}) =
3353            (0x0318, fromHDC hdc, Word32.toLargeWord(toCwmpl flags), noFree)
3354
3355    |   compileMessage (FINDMSGSTRING args) = compileFindMsg args
3356
3357    |   compileMessage (WM_SYSTEM_OTHER{uMsg, wParam, lParam}) = (uMsg, wParam, lParam, noFree)
3358
3359    |   compileMessage (WM_USER{uMsg, wParam, lParam}) = (uMsg, wParam, lParam, noFree)
3360
3361    |   compileMessage (WM_APP{uMsg, wParam, lParam}) = (uMsg, wParam, lParam, noFree)
3362
3363    |   compileMessage (WM_REGISTERED{uMsg, wParam, lParam}) = (uMsg, wParam, lParam, noFree)
3364
3365        local
3366            val msgStruct = cStruct6(cHWND, cUint, cUINT_PTRw, cUINT_PTRw, cDWORD, cPoint)
3367            val { load=loadMsg, store=storeMsg, ctype={size=msgSize, ... }, ... } =
3368                breakConversion msgStruct
3369        in
3370            (* Store the address of the message in the memory. *)
3371            fun storeMessage(v: voidStar, {msg, hwnd, time, pt}: MSG) =
3372            let
3373                val (msgId: int, wParam, lParam, freeMem) = compileMessage msg
3374                val mem = Memory.malloc msgSize
3375                val f = storeMsg(mem, (hwnd, msgId, wParam, lParam, Int.fromLarge(Time.toMilliseconds time), pt))
3376            in
3377                setAddress(v, 0w0, mem);
3378                fn () => (freeMem(); f(); Memory.free mem)
3379            end
3380        
3381            fun loadMessage(v: voidStar): MSG =
3382            let
3383                val (hWnd, msgId, wParam, lParam, t, pt) = loadMsg v
3384                val msg = decompileMessage(msgId, wParam, lParam)
3385                (*val () =
3386                    case msg of WM_USER _ => TextIO.print(Int.toString msgId ^ "\n") | _ => ()*)
3387            in
3388                {
3389                    msg = msg,
3390                    hwnd = hWnd,
3391                    time = Time.fromMilliseconds(LargeInt.fromInt t),
3392                    pt = pt
3393                }
3394            end
3395            
3396            val LPMSG: MSG conversion =
3397                makeConversion { load = loadMessage, store = storeMessage, ctype=LowLevel.cTypePointer }
3398            
3399            val msgSize = msgSize
3400        end
3401
3402    (* Update the lParam/wParam values from the values in a returned message. This is needed
3403       if an ML callback makes a modification that has to be passed back to C. *)
3404    (* TODO: The rest of these. *)
3405    local
3406        fun copyString(_, _, 0) = () (* If the length is zero do nothing *)
3407        |   copyString(ptr: voidStar, s: string, length: int) =
3408        let
3409            open Memory
3410            fun copyChar(i, c) =
3411                if i < length then set8(ptr, Word.fromInt i, Byte.charToByte c) else ()
3412        in
3413            CharVector.appi copyChar s;
3414            (* Null terminate either at the end of the string or the buffer *)
3415            set8(ptr, Word.fromInt(Int.min(size s + 1, length-1)), 0w0)
3416        end
3417    in
3418        fun updateParamsFromMessage(msg: Message, wp: SysWord.word, lp: SysWord.word): unit =
3419            case msg of
3420                WM_GETTEXT{text = ref t, ...} => copyString(toAddr lp, t, SysWord.toInt wp)
3421            |   WM_ASKCBFORMATNAME{formatName = ref t, ...} => copyString(toAddr lp, t, SysWord.toInt wp)
3422            |   EM_GETLINE{result = ref t, size, ...} => copyString(toAddr lp, t, size)
3423            |   EM_GETRECT {rect = ref r} => toCrect(toAddr lp, r)
3424            |   EM_GETSEL args => updateGetSelParms({wp=wp, lp=lp}, args)
3425            |   CB_GETEDITSEL args => updateGetSelParms({wp=wp, lp=lp}, args)
3426            |   CB_GETLBTEXT {text = ref t, length, ...} => copyString(toAddr lp, t, length)
3427            |   CB_GETDROPPEDCONTROLRECT {rect = ref r} => toCrect(toAddr lp, r)
3428            |   SBM_GETRANGE {minPos=ref minPos, maxPos=ref maxPos} =>  
3429                    (ignore(storeInt(toAddr wp, minPos)); ignore(storeInt(toAddr lp, maxPos)))
3430            |   SBM_GETSCROLLINFO args => updateScrollInfo({wp=wp, lp=lp}, args)
3431            |   LB_GETTEXT {text = ref t, length, ...} => copyString(toAddr lp, t, length)
3432            |   LB_GETSELITEMS args => updateGetSelItemsParms({wp=wp, lp=lp}, args)
3433            |   LB_GETITEMRECT{rect = ref r, ...} => toCrect(toAddr lp, r)
3434            |   WM_NCCALCSIZE { newrect = ref r, ...} => toCrect(toAddr lp, r) (* This sets the first rect *)
3435            |   WM_MEASUREITEM args => updateMeasureItemParms({wp=wp, lp=lp}, args)
3436            |   WM_GETMINMAXINFO args => updateMinMaxParms({wp=wp, lp=lp}, args)
3437            |   WM_WINDOWPOSCHANGING args => updateWindowPosChangingParms({wp=wp, lp=lp}, args)
3438    (*      |   WM_NOTIFY{ notification=TTN_GETDISPINFO(ref s), ...} =>
3439                        (* This particular notification allows the result to be fed
3440                           back in several ways.  We copy into the char array. *)
3441                        assign charArray80 (offset 1 (Cpointer Cvoid) (offset 1 nmhdr (deref lp)))
3442                                (toCcharArray80 s) *)
3443                
3444            |   _ => ()
3445    end
3446
3447    (* Update the message contents from the values of wParam/lParam.  This is used
3448       when a message has been sent or passed into C code that may have updated
3449       the message contents.  Casts certain message results to HGDIOBJ. *)
3450    fun messageReturnFromParams(msg: Message, wp: SysWord.word, lp: SysWord.word, reply: SysWord.word): LRESULT =
3451    let
3452        val () =
3453            (* For certain messages we need to extract the reply from the arguments. *)
3454        case msg of
3455            WM_GETTEXT{text, ...} =>
3456                text := (if reply = 0w0 then "" else fromCstring(toAddr lp))
3457        |   WM_ASKCBFORMATNAME{formatName, ...} =>
3458                formatName := (if reply = 0w0 then "" else fromCstring(toAddr lp))
3459        |   EM_GETLINE{result, ...} =>
3460                result := (if reply = 0w0 then "" else fromCstring(toAddr lp))
3461        |   EM_GETRECT { rect } => rect := fromCrect(toAddr lp)
3462        |   EM_GETSEL args => updateGetSelFromWpLp(args, {wp=wp, lp=lp})
3463        |   CB_GETEDITSEL args => updateGetSelFromWpLp(args, {wp=wp, lp=lp})
3464        |   CB_GETLBTEXT {text, ...} =>
3465                text := (if reply = 0w0 then "" else fromCstring(toAddr lp))
3466        |   CB_GETDROPPEDCONTROLRECT  { rect } => rect := fromCrect(toAddr lp)
3467        |   SBM_GETRANGE {minPos, maxPos} => (minPos := loadInt(toAddr wp); maxPos := loadInt(toAddr lp))
3468
3469        |   SBM_GETSCROLLINFO {info, ...} =>
3470            let
3471                val ({minPos, maxPos, pageSize, pos, trackPos}, _) = toScrollInfo lp
3472            in
3473                info := {minPos = minPos, maxPos = maxPos, pageSize = pageSize,
3474                      pos = pos, trackPos = trackPos}
3475            end
3476
3477        |   LB_GETTEXT {text, ...} =>
3478                text := (if reply = 0w0 then "" else fromCstring(toAddr lp))
3479
3480        |   LB_GETSELITEMS args => updateGetSelItemsFromWpLp(args, {wp=wp, lp=lp, reply=reply})
3481        |   LB_GETITEMRECT{rect, ...} => rect := fromCrect(toAddr lp) (* This also has an item index *)
3482        |   WM_NCCALCSIZE { newrect, ...} =>
3483               (* Whatever the value of "validarea" we just look at the first rectangle. *)
3484                newrect := fromCrect (toAddr lp)
3485
3486        |   WM_GETMINMAXINFO args => updateMinMaxFromWpLp(args, {wp=wp, lp=lp})
3487
3488        |   WM_WINDOWPOSCHANGING wpCh =>
3489                updateCfromMLwmWindowPosChanging({wp=wp, lp=lp}, wpCh)
3490
3491        |   WM_MEASUREITEM args => updateMeasureItemFromWpLp(args, {wp=wp, lp=lp})
3492        |   _ => ()
3493        
3494            val fromHgdi = handleOfVoidStar o toAddr
3495        in
3496            (* We need to "cast" some of the results. *)
3497        case msg of
3498            WM_GETFONT => LRESHANDLE(fromHgdi reply)
3499        |   WM_GETICON _ => LRESHANDLE(fromHgdi reply)
3500        |   WM_SETICON _ => LRESHANDLE(fromHgdi reply)
3501        |   BM_GETIMAGE _ => LRESHANDLE(fromHgdi reply)
3502        |   BM_SETIMAGE _ => LRESHANDLE(fromHgdi reply)
3503        |   STM_GETICON => LRESHANDLE(fromHgdi reply)
3504        |   STM_GETIMAGE _ => LRESHANDLE(fromHgdi reply)
3505        |   STM_SETICON _ => LRESHANDLE(fromHgdi reply)
3506        |   STM_SETIMAGE _ => LRESHANDLE(fromHgdi reply)
3507        |   _ => LRESINT (SysWord.toInt reply)
3508        end
3509
3510        (* Window callback table. *)
3511        local
3512            type callback = HWND * int * SysWord.word * SysWord.word -> SysWord.word
3513            (* *)
3514            datatype tableEntry = TableEntry of {hWnd: HWND, callBack: callback}
3515            (* Windows belong to the thread that created them so each thread has
3516               its own list of windows.  Any thread could have one outstanding
3517               callback waiting to be assigned to a window that is being created. *)
3518            val threadWindows = Universal.tag(): tableEntry list Universal.tag
3519            val threadOutstanding = Universal.tag(): callback option Universal.tag
3520
3521            (* This message is used to test if we are using the Poly callback.  We use
3522               the same number as MFC uses so it's unlikely that any Windows class will
3523               use this. *)
3524            val WMTESTPOLY = 0x0360
3525            fun getWindowList (): tableEntry list =
3526                getOpt (Thread.Thread.getLocal threadWindows, [])
3527            and setWindowList(t: tableEntry list): unit =
3528                Thread.Thread.setLocal(threadWindows, t)
3529                
3530            fun getOutstanding(): callback option =
3531                Option.join(Thread.Thread.getLocal threadOutstanding)
3532            and setOutstanding(t: callback option): unit =
3533                Thread.Thread.setLocal(threadOutstanding, t)
3534
3535            (* Get the callback for this window.  If it's the first time we've
3536               had a message for this window we need to use the outstanding callback. *)
3537            fun getCallback(hw: HWND): callback =
3538                case List.find (fn (TableEntry{hWnd, ...}) =>
3539                        hw = hWnd) (getWindowList ())
3540                of
3541                     SOME(TableEntry{callBack, ...}) => callBack
3542                |    NONE => (* See if this has just been set up. *)
3543                        (case getOutstanding() of
3544                            SOME cb => (* It has.  We now know the window handle so link it up. *)
3545                                (
3546                                setWindowList(TableEntry{hWnd=hw, callBack=cb} :: getWindowList ());
3547                                setOutstanding NONE;
3548                                cb
3549                                )
3550                         |  NONE => raise Fail "No callback found"
3551                        )
3552
3553            fun removeCallback(hw: HWND): unit =
3554                setWindowList(List.filter
3555                    (fn(TableEntry{hWnd, ...}) => hw <> hWnd) (getWindowList ()))
3556
3557            fun mainCallbackFunction(hw:HWND, msgId:int, wParam:SysWord.word, lParam:SysWord.word): SysWord.word =
3558            if msgId = WMTESTPOLY
3559            then SysWord.fromInt ~1 (* This tests whether we are already installed. *)
3560            else getCallback hw (hw, msgId, wParam, lParam)
3561
3562            val mainWinProc =
3563                buildClosure4withAbi(mainCallbackFunction, winAbi, (cHWND, cUint, cUINT_PTRw, cUINT_PTRw), cUINT_PTRw)
3564            
3565            val WNDPROC: (HWND * int * SysWord.word * SysWord.word -> SysWord.word) closure conversion = cFunction
3566
3567            (* This is used to set the window proc.  The result is also a window proc. *)
3568            val SetWindowLong = winCall3 (user "SetWindowLongPtrA") (cHWND, cInt, WNDPROC) cPointer
3569            val CallWindowProc = winCall5 (user "CallWindowProcA") (cPointer, cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
3570
3571        in
3572            val mainWinProc = mainWinProc
3573            and removeCallback = removeCallback
3574
3575            fun windowCallback (call: HWND * Message * 'a -> LRESULT * 'a, init: 'a):
3576                    (HWND * int * SysWord.word * SysWord.word -> SysWord.word) =
3577                let
3578                    val state = ref init
3579
3580                    fun callBack(h: HWND, uMsg:int, wParam: SysWord.word, lParam: SysWord.word): SysWord.word =
3581                    let
3582                        val msg = decompileMessage(uMsg, wParam, lParam)
3583                            handle exn =>
3584                                (
3585                                print(concat["Exception with message ",
3586                                        Int.toString uMsg, exnMessage exn ]);
3587                                WM_NULL
3588                                )
3589                        val (result, newState) =
3590                            call(h, msg, !state)
3591                                handle exn =>
3592                                (
3593                                print(concat["Exception with message ",
3594                                        PolyML.makestring msg,
3595                                        exnMessage exn ]);
3596                                (LRESINT 0, !state)
3597                                )
3598                    in
3599                        (* For a few messages we have to update the value pointed to
3600                           by wParam/lParam after we've handled it. *)
3601                        updateParamsFromMessage(msg, wParam, lParam);
3602                        state := newState;
3603                        (* If our callback returned SOME x we use that as the result,
3604                           otherwise we call the default.  We do it this way rather
3605                           than having the caller call DefWindowProc because that
3606                           would involve recompiling the message and we can't
3607                           guarantee that all the parameters of the original message
3608                           would be correctly set. *)
3609                        case result of
3610                            LRESINT res => SysWord.fromInt res
3611                        |   LRESHANDLE res => fromAddr(voidStarOfHandle res)
3612                    end;
3613                in
3614                    callBack
3615                end
3616
3617            (* When we first set up a callback we don't know the window handle so we use null. *)
3618            fun setCallback(call, init) = setOutstanding(SOME(windowCallback(call, init)))
3619
3620            val sendMsg = winCall4(user "SendMessageA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
3621
3622            fun subclass(w: HWND, f: HWND * Message * 'a -> LRESULT * 'a, init: 'a):
3623                    (HWND * Message -> LRESULT) =
3624            let
3625                
3626                val testPoly = sendMsg(w, WMTESTPOLY, 0w0, 0w0)
3627
3628                fun addCallback (hWnd, call: HWND * Message * 'a -> LRESULT * 'a, init: 'a): unit =
3629                    setWindowList(
3630                        TableEntry{ hWnd = hWnd, callBack = windowCallback(call, init) } :: getWindowList ())
3631
3632                val oldDefProc: callback =
3633                    if SysWord.toIntX testPoly = ~1
3634                    then (* We already have our Window proc installed. *)
3635                    let
3636                        (* We should have a callback already installed. *)
3637                        val oldCallback = getCallback w
3638                    in
3639                        removeCallback w;
3640                        addCallback(w, f, init);
3641                        oldCallback
3642                    end
3643                    else
3644                    let
3645                        (* Set up the new window proc and get the existing one. *)
3646                        val oldWProc = SetWindowLong(w, ~4, mainWinProc)
3647        
3648                        val defProc =
3649                            fn (h, m, w, l) => CallWindowProc(oldWProc, h, m, w, l)
3650                    in
3651                        (* Remove any existing callback function and install the new one. *)
3652                        removeCallback w;
3653                        addCallback(w, f, init);
3654                        defProc
3655                    end
3656            in
3657                fn (hw: HWND, msg: Message) =>
3658                let
3659                    val (m: int, w: SysWord.word, l: SysWord.word, freeMem) = compileMessage msg
3660                    val res: SysWord.word = oldDefProc(hw, m, w, l)
3661                in
3662                    messageReturnFromParams(msg, w, l, res)
3663                        before freeMem()
3664                end
3665            end
3666        end
3667
3668
3669        (* Keyboard operations on modeless dialogues are performed by isDialogMessage.
3670           We keep a list of modeless dialogues and process them in the main
3671           message loop.
3672           This also has an important function for dialogues created by FindText.
3673           They allocate memory which can't be freed until the dialogue has gone. *)
3674        local
3675            val modeless = ref []
3676            val isDialogMessage = winCall2 (user "IsDialogMessage") (cHWND, cPointer) cBool
3677            val isWindow = winCall1 (user "IsWindow") (cHWND) cBool
3678        in
3679            fun addModelessDialogue (hWnd: HWND, doFree) =
3680                modeless := (hWnd, doFree) :: (!modeless)
3681
3682            fun isDialogueMsg(msg: voidStar) =
3683            let
3684                (* Take this opportunity to filter any dialogues that have gone away. *)
3685                (* If this has gone away run any "free" function.*)
3686                fun filter(w, f) =
3687                    if isWindow w
3688                    then true (* Still there *)
3689                    else (case f of NONE => () | SOME f => f(); false)
3690            in
3691                modeless := List.filter filter (!modeless);
3692                (* See if isDialogMessage returns true for any of these. *)
3693                List.foldl (fn ((w, _), b) => b orelse isDialogMessage(w, msg)) false (!modeless)
3694            end
3695        end
3696
3697        datatype PeekMessageOptions = PM_NOREMOVE | PM_REMOVE
3698        (* TODO: We can also include PM_NOYIELD. *)
3699
3700        val peekMsg = winCall5(user "PeekMessageA") (cPointer, cHWND, cUint, cUint, cUint) cBool
3701
3702        fun PeekMessage(hWnd: HWND option, wMsgFilterMin: int,
3703                        wMsgFilterMax: int, remove: PeekMessageOptions): MSG option =
3704        let
3705            val msg = malloc msgSize
3706            
3707            val opts = case remove of PM_REMOVE => 1 | PM_NOREMOVE => 0
3708            val res = peekMsg(msg, getOpt(hWnd, hNull), wMsgFilterMin, wMsgFilterMax, opts)
3709        in
3710            (if not res
3711            then NONE
3712            else SOME(loadMessage msg)) before free msg
3713        end;
3714
3715        (* This was originally implemented before we had threads and used a RTS call to
3716           pick up the messages. *)
3717        
3718        val WaitMessage = winCall0 (user "WaitMessage") () cBool
3719
3720        local
3721            val getMsg = winCall4(user "GetMessage") (cPointer, cHWND, cUint, cUint) cBool
3722        in
3723            fun GetMessage(hWnd: HWND option, wMsgFilterMin: int, wMsgFilterMax: int): MSG =
3724            let
3725                val msg = malloc msgSize
3726                val res = getMsg(msg, getOpt(hWnd, hNull), wMsgFilterMin, wMsgFilterMax)
3727            in
3728                loadMessage msg before free msg
3729            end
3730        end
3731
3732        (* Wait for messages and dispatch them.  It only returns when a QUIT message
3733           has been received. *)
3734        local
3735            val peekMsg = winCall5(user "PeekMessageA") (cPointer, cHWND, cUint, cUint, cUint) cBool
3736            val transMsg = winCall1(user "TranslateMessage") (cPointer) cBool
3737            val dispMsg = winCall1(user "DispatchMessageA") (cPointer) cInt
3738        in
3739            fun RunApplication() =
3740            let
3741                val msg = malloc msgSize
3742                val res = peekMsg(msg, hNull, 0, 0, 1)
3743            in
3744                if not res
3745                then (* There's no message at the moment.  Wait for one. *)
3746                    (free msg; WaitMessage(); RunApplication())
3747                else case loadMessage msg of
3748                    { msg = WM_QUIT{exitcode}, ...} => (free msg; exitcode)
3749                |   _ =>
3750                    (
3751                        if isDialogueMsg msg then ()
3752                        else ( transMsg msg; dispMsg msg; () );
3753                        free msg;
3754                        RunApplication()
3755                    )
3756            end
3757        end
3758
3759        local
3760            val sendMsg = winCall4(user "SendMessageA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw
3761        in
3762            fun SendMessage(hWnd: HWND, msg: Message) =
3763            let
3764                val (msgId, wp, lp, freeMem) = compileMessage msg
3765                val reply = sendMsg(hWnd, msgId, wp, lp)
3766            in
3767                (* Update any result values and cast the results if necessary. *)
3768                messageReturnFromParams(msg, wp, lp, reply)
3769                    before freeMem()
3770            end
3771        end
3772
3773        local
3774            val postMessage =
3775                winCall4(user "PostMessageA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw)
3776                    (successState "PostMessage")
3777        in
3778            fun PostMessage(hWnd: HWND, msg: Message) =
3779            let
3780                val (msgId, wp, lp, _) = compileMessage msg
3781                (* This could result in a memory leak. *)
3782            in
3783                postMessage(hWnd, msgId, wp, lp)
3784            end
3785        end
3786
3787        val HWND_BROADCAST: HWND  = handleOfVoidStar(sysWord2VoidStar 0wxffff)
3788
3789        val PostQuitMessage = winCall1 (user "PostQuitMessage") cInt cVoid
3790        val RegisterWindowMessage = winCall1 (user "RegisterWindowMessageA") (cString) cUint
3791        val InSendMessage = winCall0 (user "InSendMessage") () cBool
3792        val GetInputState = winCall0 (user "GetInputState") () cBool
3793
3794        local
3795            val getMessagePos = winCall0 (user "GetMessagePos") () cDWORDw
3796        in
3797            fun GetMessagePos(): POINT =
3798            let
3799                val r = getMessagePos ()
3800            in
3801                { x = Word.toInt(LOWORD r), y = Word.toInt(HIWORD r) }
3802            end
3803        end
3804
3805        val GetMessageTime = Time.fromMilliseconds o LargeInt.fromInt o
3806            winCall0 (user "GetMessageTime") () cLong
3807
3808        datatype QueueStatus =
3809            QS_KEY | QS_MOUSEMOVE | QS_MOUSEBUTTON | QS_POSTMESSAGE | QS_TIMER |
3810            QS_PAINT | QS_SENDMESSAGE | QS_HOTKEY | QS_ALLPOSTMESSAGE
3811        local
3812            val tab = [
3813                (QS_KEY,              0wx0001),
3814                (QS_MOUSEMOVE,        0wx0002),
3815                (QS_MOUSEBUTTON,      0wx0004),
3816                (QS_POSTMESSAGE,      0wx0008),
3817                (QS_TIMER,            0wx0010),
3818                (QS_PAINT,            0wx0020),
3819                (QS_SENDMESSAGE,      0wx0040),
3820                (QS_HOTKEY,           0wx0080),
3821                (QS_ALLPOSTMESSAGE,   0wx0100)
3822            ]
3823        in
3824            val (fromQS, toQS) = tableSetLookup(tab, NONE)
3825        end
3826
3827        val QS_MOUSE = [QS_MOUSEMOVE, QS_MOUSEBUTTON]
3828        val QS_INPUT = QS_KEY :: QS_MOUSE
3829        val QS_ALLEVENTS = QS_POSTMESSAGE :: QS_TIMER :: QS_PAINT :: QS_HOTKEY :: QS_INPUT
3830        val QS_ALLINPUT = QS_SENDMESSAGE :: QS_ALLEVENTS
3831
3832        local
3833            val getQueueStatus = winCall1 (user "GetQueueStatus") (cUintw) cDWORDw
3834        in
3835            fun GetQueueStatus flags =
3836            let
3837                val res = getQueueStatus(fromQS flags)
3838            in
3839                (* The RTS uses PeekMessage internally so the "new messages"
3840                   value in the LOWORD is meaningless. *)
3841                toQS(Word32.fromLargeWord(Word.toLargeWord(HIWORD(res))))
3842            end
3843        end
3844
3845(*
3846BroadcastSystemMessage  
3847DispatchMessage  
3848GetMessageExtraInfo  
3849InSendMessageEx  - NT 5.0 and Windows 98  
3850PostThreadMessage  
3851ReplyMessage  
3852SendAsyncProc  
3853SendMessageCallback  
3854SendMessageTimeout  
3855SendNotifyMessage  
3856SetMessageExtraInfo  
3857TranslateMessage  
3858
3859Obsolete Functions
3860
3861PostAppMessage  
3862SetMessageQueue   
3863
3864*)
3865    end
3866end;
3867