added gtk1 check for current desktop on focussing windows from Andrew Haines

git-svn-id: trunk@6974 -

lcl/interfaces/gtk/gtkproc.pp

@@ -43,7 +43,7 @@ uses
     {$IFDEF GTK1}
       // MWE:
       // TODO: check if the new keyboard routines require X on GTK2
-      X, XLib, XUtil, //Font retrieval and Keyboard handling
+      X, XLib, XUtil, XAtom, //Font retrieval and Keyboard handling
     {$ENDIF not Gtk1}
   {$ENDIF}
   InterfaceBase,
@@ -65,6 +65,12 @@ uses
 const
   gdkdll = gdklib;
 {$ENDIF}
+
+{$IFDEF GTK1}
+  function GDK_GET_CURRENT_DESKTOP(): gint;
+  function GDK_GET_DESKTOP_OF_WINDOW(Window: PGdkWindowPrivate): gint;
+  function GDK_SET_DESKTOP_OF_WINDOW(Window: PGdkWindowPrivate; Desktop: gint): gint;
+{$ENDIF}
   
 
 {$IFNDEF GTK2}
@@ -1059,6 +1065,93 @@ begin
 {$endif}
 end;
 
+{$IFDEF GTK1}
+function GDK_GET_CURRENT_DESKTOP(): gint;
+var
+  XDisplay: PDisplay;
+  XScreen: PScreen;
+  XWindow: TWindow;
+  AtomType: TAtom;
+  Format: gint;
+  nitems: gulong;
+  bytes_after: gulong;
+  current_desktop: pguint;
+begin
+  Result := -1;
+  xdisplay := XOpenDisplay(nil);
+  xscreen := XDefaultScreenOfDisplay(xdisplay);
+  xwindow := XRootWindowOfScreen(xscreen);
+
+  XGetWindowProperty (xdisplay, xwindow,
+             XInternAtom(xdisplay, '_NET_CURRENT_DESKTOP', false),
+             0, MaxInt, False, XA_CARDINAL, @atomtype, @format, @nitems,
+             @bytes_after, gpointer(@current_desktop));
+
+  if (atomtype = XA_CARDINAL) and (format = 32) and  (nitems > 0) then
+  begin
+    Result := current_desktop[0];
+    XFree (current_desktop);
+  end;
+  XCloseDisplay(xdisplay);
+end;
+
+
+function GDK_GET_DESKTOP_OF_WINDOW(Window: PGdkWindowPrivate): gint;
+var
+  xdisplay: PDisplay;
+  xwindow: TWindow;
+
+ atomtype: TAtom;
+ format: gint;
+ nitems: gulong;
+ bytes_after: gulong;
+ current_desktop: pguint;
+begin
+
+  Result := -1;
+  XWindow := GDK_WINDOW_XWINDOW (Window);
+  XDisplay := GDK_WINDOW_XDISPLAY (Window);
+  XGetWindowProperty (xdisplay, xwindow,
+             XInternAtom(xdisplay, '_NET_WM_DESKTOP', false),
+             0, MaxInt, False, XA_CARDINAL, @atomtype, @format, @nitems,
+             @bytes_after, gpointer(@current_desktop));
+
+  if (atomtype = XA_CARDINAL) and (format = 32) and  (nitems > 0) then
+  begin
+    Result := current_desktop[0];
+    XFree (current_desktop);
+  end;
+end;
+
+function GDK_SET_DESKTOP_OF_WINDOW(Window: PGdkWindowPrivate; Desktop: gint): gint;
+var
+  XDisplay: PDisplay;
+  XScreen: PScreen;
+  XRootWindow,
+  XWindow: TWindow;
+  XEvent: TXClientMessageEvent;
+  _NET_WM_DESKTOP: Integer;
+begin
+
+  Result := -1;
+
+  XDisplay := GDK_WINDOW_XDISPLAY (Window);
+  XScreen := XDefaultScreenOfDisplay(xdisplay);
+  XRootWindow := XRootWindowOfScreen(xscreen);
+  XWindow := GDK_WINDOW_XWINDOW (Window);
+
+  _NET_WM_DESKTOP := XInternAtom(xdisplay, '_NET_WM_DESKTOP', false);
+
+  XEvent._type := ClientMessage;
+  XEvent.window := XWindow;
+  XEvent.message_type := _NET_WM_DESKTOP;
+  XEvent.format := 32;
+  XEvent.data.l[0] := Desktop;
+
+  XSendEvent(XDisplay, XRootWindow, False, SubstructureNotifyMask, @XEvent);
+end;
+{$ENDIF}
+
 initialization
   InitGTKProc;
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -235,6 +235,7 @@ begin
       {$IFDEF DebugGDKTraps}
       BeginGDKErrorTrap;
       {$ENDIF}
+      gdk_window_show(GdkWindow);
       gdk_window_raise(GdkWindow);
       {$IFDEF DebugGDKTraps}
       EndGDKErrorTrap;
@@ -246,6 +247,8 @@ begin
       if FormWindow<>nil then begin
         XWindow := GDK_WINDOW_XWINDOW (FormWindow);
         XDisplay := GDK_WINDOW_XDISPLAY (FormWindow);
+        if GDK_GET_CURRENT_DESKTOP <> GDK_GET_DESKTOP_OF_WINDOW(FormWindow) then
+          GDK_SET_DESKTOP_OF_WINDOW(FormWindow, GDK_GET_CURRENT_DESKTOP);
         XMapWindow(XDisplay, XWindow);
         // a horrible horrible hack to give "something" time to unminimize the window
         gtk_timeout_add(50, TGtkFunction(@InternalGtkShowWindow), AForm);
@@ -9002,6 +9005,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.412  2005/03/17 10:10:51  mattias
+  added gtk1 check for current desktop on focussing windows  from Andrew Haines
+
   Revision 1.411  2005/03/16 17:45:28  mattias
   published TStringGrid.OnResize/OnChangeBounds and fixed gtk1 intf check in focussing
 

lcl/postscriptcanvas.pas

@@ -74,14 +74,14 @@ Type
     FirstUpdatefont: Boolean;
     
     procedure WriteHeader(St : String);
-    procedure Write(St : String; Lst : TstringList{$IFNDEF VER1_0}=nil{$ENDIF}); overload;
+    procedure Write(const St : String; Lst : TstringList{$IFNDEF VER1_0}=nil{$ENDIF}); overload;
     {$IFDEF VER1_0} //added because fpc 1.0 doesn't have default parameters
-    procedure Write(St : String); overload;
+    procedure Write(const St : String); overload;
     {$ENDIF}
-    procedure WriteB(St : string);
+    procedure WriteB(const St : string);
     procedure ClearBuffer;
     procedure Write(Lst : TStringList); overload;
-    procedure WriteComment(St : string);
+    procedure WriteComment(const St : string);
     
     Procedure TranslateCoord(Var X,Y : Integer);
     procedure SetPosition(X,Y : Integer);
@@ -528,7 +528,7 @@ begin
 end;
 
 //Write an instruction in the document
-procedure TPostscriptPrinterCanvas.Write(St: String; Lst : TStringList{$IFNDEF VER1_0}=Nil{$ENDIF});
+procedure TPostscriptPrinterCanvas.Write(const St: String; Lst : TStringList{$IFNDEF VER1_0}=Nil{$ENDIF});
 begin
   If not Assigned(Lst) then
     Lst:=fDocument;
@@ -537,14 +537,14 @@ begin
 end;
 
 {$IFDEF VER1_0}
-procedure TPostscriptPrinterCanvas.Write(St: String);
+procedure TPostscriptPrinterCanvas.Write(const St: String);
 begin
   Write(St, nil);
 end;
 {$ENDIF}
 
 //Write data in fBuffer
-procedure TPostscriptPrinterCanvas.WriteB(St: string);
+procedure TPostscriptPrinterCanvas.WriteB(const St: string);
 begin
   Write(St,fBuffer);
 end;
@@ -562,7 +562,7 @@ begin
 end;
 
 //Write an comment in the document
-procedure TPostscriptPrinterCanvas.WriteComment(St: string);
+procedure TPostscriptPrinterCanvas.WriteComment(const St: string);
 begin
   fDocument.Add('%'+St);
 end;

lcl/printers.pas

@@ -126,6 +126,7 @@ type
     fFonts       : TStrings;     //Accepted font by printer
     fPageNumber  : Integer;      //Current page number
     fPrinters    : TStrings;     //Printers names list
+    fPrintersValid: Boolean;
     fPrinterIndex: Integer;      //selected printer index
     fTitle       : string;       //Title of current document
     fPrinting    : Boolean;      //Printing
@@ -430,8 +431,10 @@ begin
   Result:=fPrinters;
   
   //Only 1 initialization
-  if fPrinters.Count=0 then
+  if not fPrintersValid then begin
+    fPrintersValid:=true;
     DoEnumPrinters(fPrinters);
+  end;
 end;
 
 //Return XDPI
@@ -453,7 +456,7 @@ begin
   CheckPrinting(False);
   if aValue<1 then aValue:=1;
   if Printers.Count>0 then
-     DoSetCopies(aValue)
+    DoSetCopies(aValue)
   else raise EPrinter.Create('zero printer definied !');
 end;
 
@@ -468,6 +471,7 @@ end;
 procedure TPrinter.SetPrinterIndex(AValue: integer);
 Var aName : String;
 begin
+  if fPrinterIndex=AValue then exit;
   CheckPrinting(False);
   if Printers.Count>0 then
   begin