1(* 2 Copyright (c) 2001-7, 2015 3 David C.J. Matthews 4 5 This library is free software; you can redistribute it and/or 6 modify it under the terms of the GNU Lesser General Public 7 License version 2.1 as published by the Free Software Foundation. 8 9 This library is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12 Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 17*) 18 19structure 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=0w0, 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 = IntInf.andb((SysWord.toInt wp), 2) <> 0 } 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, SysWord.fromInt(IntInf.orb(sysBits, 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, 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 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 (* TODO: This was originally implemented before we had threads. The only reason 3716 for continuing with it is to allow the thread to be interrupted. *) 3717 local 3718 val callWin = RunCall.run_call2 RuntimeCalls.POLY_SYS_os_specific 3719 in 3720 fun pauseForMessage(hwnd: HWND, min, max): unit = 3721 callWin(1101, (hwnd, min, max)) 3722 3723 (* We implement WaitMessage within the RTS. *) 3724 fun WaitMessage(): bool = 3725 (pauseForMessage(hwndNull, 0, 0); true) 3726 end 3727 3728 (* We don't use the underlying GetMessage function because that blocks the 3729 thread which would prevent other ML processes from running. Instead we 3730 use PeekMessage and an RTS call which allows other threads to run. *) 3731 fun GetMessage(hWnd: HWND option, wMsgFilterMin: int, wMsgFilterMax: int): MSG = 3732 case PeekMessage(hWnd, wMsgFilterMin, wMsgFilterMax, PM_REMOVE) of 3733 SOME msg => msg 3734 | NONE => 3735 let 3736 val hwnd = getOpt(hWnd, hwndNull) 3737 in 3738 pauseForMessage(hwnd, wMsgFilterMin, wMsgFilterMax); 3739 GetMessage(hWnd, wMsgFilterMin, wMsgFilterMax) 3740 end 3741 3742 (* Wait for messages and dispatch them. It only returns when a QUIT message 3743 has been received. *) 3744 fun RunApplication() = 3745 let 3746 val peekMsg = winCall5(user "PeekMessageA") (cPointer, cHWND, cUint, cUint, cUint) cBool 3747 val transMsg = winCall1(user "TranslateMessage") (cPointer) cBool 3748 val dispMsg = winCall1(user "DispatchMessageA") (cPointer) cInt 3749 val msg = malloc msgSize 3750 val res = peekMsg(msg, hNull, 0, 0, 1) 3751 in 3752 if not res 3753 then (* There's no message at the moment. Wait for one. *) 3754 (free msg; WaitMessage(); RunApplication()) 3755 else case loadMessage msg of 3756 { msg = WM_QUIT{exitcode}, ...} => (free msg; exitcode) 3757 | _ => 3758 ( 3759 if isDialogueMsg msg then () 3760 else ( transMsg msg; dispMsg msg; () ); 3761 free msg; 3762 RunApplication() 3763 ) 3764 end 3765 3766 local 3767 val sendMsg = winCall4(user "SendMessageA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) cUINT_PTRw 3768 in 3769 fun SendMessage(hWnd: HWND, msg: Message) = 3770 let 3771 val (msgId, wp, lp, freeMem) = compileMessage msg 3772 val reply = sendMsg(hWnd, msgId, wp, lp) 3773 in 3774 (* Update any result values and cast the results if necessary. *) 3775 messageReturnFromParams(msg, wp, lp, reply) 3776 before freeMem() 3777 end 3778 end 3779 3780 local 3781 val postMessage = 3782 winCall4(user "PostMessageA") (cHWND, cUint, cUINT_PTRw, cUINT_PTRw) 3783 (successState "PostMessage") 3784 in 3785 fun PostMessage(hWnd: HWND, msg: Message) = 3786 let 3787 val (msgId, wp, lp, _) = compileMessage msg 3788 (* This could result in a memory leak. *) 3789 in 3790 postMessage(hWnd, msgId, wp, lp) 3791 end 3792 end 3793 3794 val HWND_BROADCAST: HWND = handleOfVoidStar(sysWord2VoidStar 0wxffff) 3795 3796 val PostQuitMessage = winCall1 (user "PostQuitMessage") cInt cVoid 3797 val RegisterWindowMessage = winCall1 (user "RegisterWindowMessageA") (cString) cUint 3798 val InSendMessage = winCall0 (user "InSendMessage") () cBool 3799 val GetInputState = winCall0 (user "GetInputState") () cBool 3800 3801 local 3802 val getMessagePos = winCall0 (user "GetMessagePos") () cDWORDw 3803 in 3804 fun GetMessagePos(): POINT = 3805 let 3806 val r = getMessagePos () 3807 in 3808 { x = Word.toInt(LOWORD r), y = Word.toInt(HIWORD r) } 3809 end 3810 end 3811 3812 val GetMessageTime = Time.fromMilliseconds o 3813 winCall0 (user "GetMessageTime") () cLong 3814 3815 datatype QueueStatus = 3816 QS_KEY | QS_MOUSEMOVE | QS_MOUSEBUTTON | QS_POSTMESSAGE | QS_TIMER | 3817 QS_PAINT | QS_SENDMESSAGE | QS_HOTKEY | QS_ALLPOSTMESSAGE 3818 local 3819 val tab = [ 3820 (QS_KEY, 0wx0001), 3821 (QS_MOUSEMOVE, 0wx0002), 3822 (QS_MOUSEBUTTON, 0wx0004), 3823 (QS_POSTMESSAGE, 0wx0008), 3824 (QS_TIMER, 0wx0010), 3825 (QS_PAINT, 0wx0020), 3826 (QS_SENDMESSAGE, 0wx0040), 3827 (QS_HOTKEY, 0wx0080), 3828 (QS_ALLPOSTMESSAGE, 0wx0100) 3829 ] 3830 in 3831 val (fromQS, toQS) = tableSetLookup(tab, NONE) 3832 end 3833 3834 val QS_MOUSE = [QS_MOUSEMOVE, QS_MOUSEBUTTON] 3835 val QS_INPUT = QS_KEY :: QS_MOUSE 3836 val QS_ALLEVENTS = QS_POSTMESSAGE :: QS_TIMER :: QS_PAINT :: QS_HOTKEY :: QS_INPUT 3837 val QS_ALLINPUT = QS_SENDMESSAGE :: QS_ALLEVENTS 3838 3839 local 3840 val getQueueStatus = winCall1 (user "GetQueueStatus") (cUintw) cDWORDw 3841 in 3842 fun GetQueueStatus flags = 3843 let 3844 val res = getQueueStatus(fromQS flags) 3845 in 3846 (* The RTS uses PeekMessage internally so the "new messages" 3847 value in the LOWORD is meaningless. *) 3848 toQS(Word32.fromLargeWord(Word.toLargeWord(HIWORD(res)))) 3849 end 3850 end 3851 3852(* 3853BroadcastSystemMessage 3854DispatchMessage 3855GetMessageExtraInfo 3856InSendMessageEx - NT 5.0 and Windows 98 3857PostThreadMessage 3858ReplyMessage 3859SendAsyncProc 3860SendMessageCallback 3861SendMessageTimeout 3862SendNotifyMessage 3863SetMessageExtraInfo 3864TranslateMessage 3865 3866Obsolete Functions 3867 3868PostAppMessage 3869SetMessageQueue 3870 3871*) 3872 end 3873end; 3874