diff --git a/trunk/Projects/SAMufasaGUI/testunit.pas b/trunk/Projects/SAMufasaGUI/testunit.pas index e4049f5..fe59cf8 100644 --- a/trunk/Projects/SAMufasaGUI/testunit.pas +++ b/trunk/Projects/SAMufasaGUI/testunit.pas @@ -1191,6 +1191,11 @@ var x, y: Integer; begin Self.Manager.GetMousePos(x, y); + if self.Manager.ReceivedError() then + begin + formWriteln('Our window no longer exists -> Resetting to desktop'); + self.Manager.SetDesktop; + end; StatusBar.Panels[Panel_Coords].Text := Format('(%d, %d)', [x, y]); end; diff --git a/trunk/Units/MMLAddon/windowselector.pas b/trunk/Units/MMLAddon/windowselector.pas index bfd629b..cece181 100644 --- a/trunk/Units/MMLAddon/windowselector.pas +++ b/trunk/Units/MMLAddon/windowselector.pas @@ -85,14 +85,14 @@ var x_root, y_root : cint; xmask : cuint; x, y : cint; - Old_Handler : TXErrorHandler; + //Old_Handler : TXErrorHandler; window_opacity: TAtom; opacity_75: culong; opacity_100: culong; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); Result := 0; @@ -143,7 +143,7 @@ begin XChangeProperty(manager.display, Result, window_opacity, XA_CARDINAL, 32, PropModeReplace, @opacity_100, 1); XFlush(manager.display); - XSetErrorHandler(Old_handler); + //XSetErrorHandler(Old_handler); end; {$ELSE} diff --git a/trunk/Units/MMLCore/iomanager.pas b/trunk/Units/MMLCore/iomanager.pas index 0f79b07..0307dfe 100644 --- a/trunk/Units/MMLCore/iomanager.pas +++ b/trunk/Units/MMLCore/iomanager.pas @@ -49,6 +49,11 @@ interface procedure ActivateClient; virtual; function TargetValid: boolean; virtual; + { Sucky implementation } + function GetError: String; virtual; abstract; + function ReceivedError: Boolean; virtual; abstract; + procedure ResetError; virtual; abstract; + { ONLY override the following methods if the target provides mouse functions, defaults to | raise exceptions } procedure GetMousePosition(var x,y: integer); virtual; @@ -104,6 +109,7 @@ interface function ReturnData(xs, ys, width, height: Integer): TRetData; override; abstract; function TargetValid: boolean; override; abstract; + procedure ActivateClient; override; abstract; procedure GetMousePosition(var x,y: integer); override; abstract; procedure MoveMouse(x,y: integer); override; abstract; @@ -244,6 +250,11 @@ interface constructor Create; constructor Create(plugin_dir: string); destructor Destroy; override; + + { Sucky implementation } + function GetError: String; + function ReceivedError: Boolean; + procedure ResetError; procedure SetDesktop; virtual; abstract; function SetTarget(ArrPtr: PRGB32; Size: TPoint): integer; overload; @@ -631,6 +642,27 @@ begin result := keymouse.GetKeyCode(c); end; +function TIOManager_Abstract.GetError: String; +begin + if keymouse.ReceivedError then + exit(keymouse.GetError); + if image.ReceivedError then + exit(image.GetError); + raise Exception.Create('TIOManager_Abstract.GetError: NO ERROR!'); + exit(''); +end; + +function TIOManager_Abstract.ReceivedError: Boolean; +begin + exit(keymouse.ReceivedError or image.ReceivedError); +end; + +procedure TIOManager_Abstract.ResetError; +begin + keymouse.ResetError; + image.ResetError; +end; + // TRUE when STOPPING. procedure TIOManager_Abstract.SetState(val: Boolean); begin diff --git a/trunk/Units/MMLCore/os_linux.pas b/trunk/Units/MMLCore/os_linux.pas index 8a7a2b9..1d1c289 100644 --- a/trunk/Units/MMLCore/os_linux.pas +++ b/trunk/Units/MMLCore/os_linux.pas @@ -26,7 +26,8 @@ unit os_linux; interface uses - Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym; + Classes, SysUtils, mufasatypes, xlib, x, xutil, IOManager, XKeyInput, ctypes, xtest, keysym, + syncobjs; type @@ -48,6 +49,10 @@ interface function ReturnData(xs, ys, width, height: Integer): TRetData; override; procedure FreeReturnData; override; + function GetError: String; override; + function ReceivedError: Boolean; override; + procedure ResetError; override; + function TargetValid: boolean; override; procedure ActivateClient; override; procedure GetMousePosition(var x,y: integer); override; @@ -69,6 +74,8 @@ interface buffer: PXImage; dirty: Boolean; //true if image loaded keyinput: TKeyInput; + + oldXHandler: TXErrorHandler; end; TIOManager = class(TIOManager_Abstract) @@ -92,19 +99,14 @@ implementation uses GraphType, interfacebase, lcltype; - // Too global. - function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint;cdecl; - begin; - result := 0; - Writeln('X Error: '); - writeln('Error code: ' + inttostr(para2^.error_code)); - writeln('Display: ' + inttostr(LongWord(para2^.display))); - writeln('Minor code: ' + inttostr(para2^.minor_code)); - writeln('Request code: ' + inttostr(para2^.request_code)); - writeln('Resource ID: ' + inttostr(para2^.resourceid)); - writeln('Serial: ' + inttostr(para2^.serial)); - writeln('Type: ' + inttostr(para2^._type)); - end; + { PROBLEM: .Create is called on the main thread. ErrorCS etc aren't + created on other threads. We will create them on the fly... } + threadvar + xerror: string; + threadvar + ErrorCS: syncobjs.TCriticalSection; + + //***implementation*** TKeyInput @@ -120,6 +122,60 @@ implementation //***implementation*** TWindow + // Too global. + + function MufasaXErrorHandler(para1:PDisplay; para2:PXErrorEvent):cint; cdecl; + + begin + { if someone understands the pascal syntax on how to define an array with + constant values, please change this to use an array } + case para2^.error_code of + 1: xerror := 'BadRequest'; + 2: xerror := 'BadValue'; + 3: xerror := 'BadWindow'; + 4: xerror := 'BadPixmap'; + 5: xerror := 'BadAtom'; + 6: xerror := 'BadCursor'; + 7: xerror := 'BadFont'; + 8: xerror := 'BadMatch'; + 9: xerror := 'BadDrawable'; + 10: xerror := 'BadAccess'; + 11: xerror := 'BadAlloc'; + 12: xerror := 'BadColor'; + 13: xerror := 'BadGC'; + 14: xerror := 'BadIDChoice'; + 15: xerror := 'BadName'; + 16: xerror := 'BadLength'; + 17: xerror := 'BadImplementation'; + else + xerror := 'UNKNOWN'; + end; + result := 0; + Writeln('X Error: '); + writeln('Error code: ' + inttostr(para2^.error_code)); + writeln('Display: ' + inttostr(LongWord(para2^.display))); + writeln('Minor code: ' + inttostr(para2^.minor_code)); + writeln('Request code: ' + inttostr(para2^.request_code)); + writeln('Resource ID: ' + inttostr(para2^.resourceid)); + writeln('Serial: ' + inttostr(para2^.serial)); + writeln('Type: ' + inttostr(para2^._type)); + end; + + function TWindow.GetError: String; + begin + exit(xerror); + end; + + function TWindow.ReceivedError: Boolean; + begin + result := xerror <> ''; + end; + + procedure TWindow.ResetError; + begin + xerror := ''; + end; + constructor TWindow.Create(display: PDisplay; screennum: integer; window: x.TWindow); begin inherited Create; @@ -127,14 +183,47 @@ implementation self.screennum:= screennum; self.window:= window; self.dirty:= false; - self.keyinput:= TKeyInput.Create + self.keyinput:= TKeyInput.Create; + + xerror := ''; + writeln('creating twindow'); + + { XXX FIXME TODO O GOD WTF } + if not assigned(ErrorCS) then + ErrorCS := syncobjs.TCriticalSection.Create; + ErrorCS.Enter; + try + oldXHandler:=XSetErrorHandler(@MufasaXErrorHandler); + finally + ErrorCS.Leave; + end; end; - destructor TWindow.Destroy; + destructor TWindow.Destroy; + var + erh: TXErrorHandler; begin FreeReturnData; keyinput.Free; - inherited Destroy; + + { XXX FIXME TODO O GOD WTF } + if not assigned(ErrorCS) then + ErrorCS := syncobjs.TCriticalSection.Create; + ErrorCS.Enter; + + if self.ReceivedError then + writeln('recieved error: ' + GetError) + else + writeln('got no error'); + + erh := XSetErrorHandler(oldXHandler); + try + if erh <> @MufasaXErrorHandler then + XSetErrorHandler(erh); + finally + ErrorCS.Leave; + end; + inherited Destroy; end; function TWindow.GetNativeWindow: TNativeWindow; @@ -144,12 +233,12 @@ implementation procedure TWindow.GetTargetDimensions(var w, h: integer); var - Old_Handler: TXErrorHandler; + // Old_Handler: TXErrorHandler; Attrib: TXWindowAttributes; newx, newy: integer; childwindow: x.TWindow; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); if XGetWindowAttributes(display, window, @Attrib) <> 0 Then begin { I don't think we need this XTranslateCoordinates... :D } @@ -162,35 +251,38 @@ implementation W := -1; H := -1; end; - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; function TWindow.TargetValid: boolean; var - old_handler: TXErrorHandler; + //old_handler: TXErrorHandler; Attrib: TXWindowAttributes; begin - old_handler := XSetErrorHandler(@MufasaXErrorHandler); + //old_handler := XSetErrorHandler(@MufasaXErrorHandler); //This was in the repos, but it doesn't seem to work... //Maybe I missed something? - result:= XGetWindowAttributes(display, window, @Attrib) <> 0; - XSetErrorHandler(old_handler); + + {result:= XGetWindowAttributes(display, window, @Attrib) <> 0; } + XGetWindowAttributes(display, window, @Attrib); + result := not ReceivedError; + //XSetErrorHandler(old_handler); end; procedure TWindow.ActivateClient; - var - Old_Handler: TXErrorHandler; + //var + //Old_Handler: TXErrorHandler; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); { TODO: Check if Window is valid? } XSetInputFocus(display,window,RevertToParent,CurrentTime); XFlush(display); - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; function TWindow.ReturnData(xs, ys, width, height: Integer): TRetData; var - Old_Handler: TXErrorHandler; + //Old_Handler: TXErrorHandler; w,h: integer; begin GetTargetDimensions(w,h); @@ -200,7 +292,7 @@ implementation raise Exception.CreateFmt('ReturnData was called again without freeing'+ ' the previously used data. Do not forget to'+ ' call FreeReturnData', []); - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); buffer := XGetImage(display, window, xs, ys, width, height, AllPlanes, ZPixmap); if buffer = nil then begin @@ -209,7 +301,7 @@ implementation ', ' + inttostr(width) + ', ' + inttostr(height)); Result.Ptr := nil; Result.IncPtrWith := 0; - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); raise Exception.CreateFMT('TMWindow.ReturnData: ReturnData: XGetImage Error', []); exit; end; @@ -217,7 +309,7 @@ implementation Result.IncPtrWith := 0; Result.RowLen := width; dirty:= true; - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; procedure TWindow.FreeReturnData; @@ -236,32 +328,32 @@ implementation b:integer; root, child: twindow; xmask: Cardinal; - Old_Handler: TXErrorHandler; + //Old_Handler: TXErrorHandler; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); XQueryPointer(display,window,@root,@child,@b,@b,@x,@y,@xmask); - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; procedure TWindow.MoveMouse(x,y: integer); var - Old_Handler: TXErrorHandler; + //Old_Handler: TXErrorHandler; w,h: integer; begin GetTargetDimensions(w, h); if (x < 0) or (y < 0) or (x > w) or (y > h) then raise Exception.CreateFmt('SetMousePos: X, Y (%d, %d) is not valid (0,0,%d,%d)', [x, y, w, h]); - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + //Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); XWarpPointer(display, 0, window, 0, 0, 0, 0, X, Y); XFlush(display); - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; procedure TWindow.HoldMouse(x,y: integer; button: TClickType); var ButtonP: cuint; _isPress: cbool; - Old_Handler: TXErrorHandler; + //Old_Handler: TXErrorHandler; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + // Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); _isPress := cbool(1); case button of mouse_Left: ButtonP:= Button1; @@ -269,15 +361,15 @@ implementation mouse_Right: ButtonP:= Button3; end; XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime); - XSetErrorHandler(Old_Handler); + // XSetErrorHandler(Old_Handler); end; procedure TWindow.ReleaseMouse(x,y: integer; button: TClickType); var ButtonP: cuint; _isPress: cbool; - Old_Handler: TXErrorHandler; + // Old_Handler: TXErrorHandler; begin - Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); + // Old_Handler := XSetErrorHandler(@MufasaXErrorHandler); _isPress := cbool(0); case button of mouse_Left: ButtonP:= Button1; @@ -285,7 +377,7 @@ implementation mouse_Right: ButtonP:= Button3; end; XTestFakeButtonEvent(display, ButtonP, _isPress, CurrentTime); - XSetErrorHandler(Old_Handler); + //XSetErrorHandler(Old_Handler); end; procedure TWindow.SendString(str: string); diff --git a/trunk/Units/MMLCore/os_windows.pas b/trunk/Units/MMLCore/os_windows.pas index 57576de..8514d8c 100644 --- a/trunk/Units/MMLCore/os_windows.pas +++ b/trunk/Units/MMLCore/os_windows.pas @@ -49,6 +49,10 @@ interface function ReturnData(xs, ys, width, height: Integer): TRetData; override; function GetColor(x,y : integer) : TColor; override; + function GetError: String; override; + function ReceivedError: Boolean; override; + procedure ResetError; override; + function TargetValid: boolean; override; procedure ActivateClient; override; procedure GetMousePosition(var x,y: integer); override; @@ -165,6 +169,21 @@ implementation inherited Destroy; end; + function TWindow.GetError: String; + begin + exit(''); + end; + + function TWindow.ReceivedError: Boolean; + begin + exit(false); + end; + + procedure TWindow.ResetError; + begin + + end; + function TWindow.GetNativeWindow: TNativeWindow; begin result := handle;