X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/1066f857936e27fbf24d6b96b5be7703a2c0b0bf..70e049261c2b49411fbc9cefc737bc18ee6c4365:/lmessages.pas?ds=inline diff --git a/lmessages.pas b/lmessages.pas old mode 100755 new mode 100644 index d6e3745..d5521e5 --- a/lmessages.pas +++ b/lmessages.pas @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- } //this unit provides a rough approximation of windows messages on linux -//it is usefull for multithreaded applications on linux to communicate back to +//it is useful for multithreaded applications on linux to communicate back to //the main lcore thread //This unit is *nix only, on windows you should use the real thing @@ -73,11 +73,13 @@ type const WS_EX_TOOLWINDOW = $80; WS_POPUP = longint($80000000); + CW_USEDEFAULT=$80000000; hinstance=nil; PM_REMOVE = 1; WM_USER = 1024; WM_TIMER = 275; INFINITE = syncobjs.infinite; + function getwindowlongptr(ahwnd:hwnd;nindex:integer) : taddrint; function setwindowlongptr(ahwnd:hwnd;nindex:integer;dwNewLong : taddrint) : taddrint; function DefWindowProc(ahWnd:HWND; auMsg:Integer; awParam:WPARAM; alParam:LPARAM):Integer; stdcall; @@ -99,10 +101,11 @@ procedure init; implementation uses - baseunix,unix,lcore,unixutil;//,safewriteln; + baseunix,unix,lcore,unixutil,ltimevalstuff,sockets;//,safewriteln; {$i unixstuff.inc} type + tmessageintransit = class msg : tmsg; next : tmessageintransit; @@ -114,7 +117,7 @@ type waiting : boolean; lcorethread : boolean; nexttimer : ttimeval; - threadid : integer; + threadid : tthreadid; end; twindow=class hwnd : hwnd; @@ -131,22 +134,22 @@ var lcorelinkpiperecv : tlasio; windows : thashtable; //I would rather things crash immediately - //if they use an insufficiant size type + //if they use an insufficient size type //than crash after over four billion //windows have been made ;) nextwindowhandle : qword = $100000000; -{$i ltimevalstuff.inc} + //findthreaddata should only be called while holding the structurelock -function findthreaddata(threadid : integer) : tthreaddata; +function findthreaddata(threadid : tthreadid) : tthreaddata; begin - result := tthreaddata(findtree(@threaddata,inttostr(threadid))); + result := tthreaddata(findtree(@threaddata,inttostr(taddrint(threadid)))); if result = nil then begin result := tthreaddata.create; result.messageevent := teventobject.create(nil,false,false,inttostr(taddrint(result))); result.nexttimer := tv_invalidtimebig; result.threadid := threadid; - addtree(@threaddata,inttostr(threadid),result); + addtree(@threaddata,inttostr(taddrint(threadid)),result); end; end; @@ -160,7 +163,7 @@ begin //writeln('freeing thread data object'); athreaddata.free; //writeln('deleting thread data object from hashtable'); - deltree(@threaddata,inttostr(athreaddata.threadid)); + deltree(@threaddata,inttostr(taddrint(athreaddata.threadid))); //writeln('finished deleting thread data'); end else begin //writeln('thread data is not unused'); @@ -232,7 +235,7 @@ begin //swriteln('duplicate window class registered with different settings'); raise exception.create('duplicate window class registered with different settings'); end else begin - //swriteln('duplicate window class registered with same settings, tollerated'); + //swriteln('duplicate window class registered with same settings, tolerated'); end; end else begin //swriteln('about to allocate memory for new windowclass'); @@ -289,10 +292,10 @@ begin window := twindow(findtree(@windows,inttostr(ahwnd))); if window <> nil then begin freemem(window.extrawindowmemory); - //writeln('aboute to delete window from windows structure'); + //writeln('about to delete window from windows structure'); deltree(@windows,inttostr(ahwnd)); //writeln('deleted window from windows structure'); - windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(window.threadid))); + windowthreaddata := tthreaddata(findtree(@threaddata,inttostr(taddrint(window.threadid)))); if windowthreaddata <> nil then begin //writeln('found thread data scanning for messages to clean up'); @@ -409,15 +412,15 @@ begin //we have to get the window procedure while the structurelock //is still held as the window could be destroyed from another thread //otherwise. - if window <> nil then begin + if window <> nil then begin windowproc := window.windowproc; - end else begin - windowproc := nil; - end; + end else begin + windowproc := nil; + end; finally structurelock.release; end; - if windowproc <> nil then begin + if assigned(windowproc) then begin result := windowproc(lpmsg.hwnd,lpmsg.message,lpmsg.wparam,lpmsg.lparam); end else begin result := -1; @@ -494,7 +497,7 @@ end; function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): WINBOOL; begin - result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,PM_REMOVE,true); + result := getmessageinternal(lpmsg,hwnd,wmsgfiltermin,wmsgfiltermax,wRemoveMsg,true); end; function SetEvent(hEvent:THevent):WINBOOL;