accelerated cups printing and added targets sparc-linux and powerpc-linux

git-svn-id: trunk@6985 -

components/codetools/definetemplates.pas

@@ -95,11 +95,11 @@ const
   FPCOperatingSystemAlternative2Names: array[1..1] of shortstring =(
       'bsd' // see GetDefaultSrcOS2ForTargetOS
     );
-  FPCProcessorNames: array[1..4] of shortstring =(
+  FPCProcessorNames: array[1..5] of shortstring =(
-      'i386', 'powerpc', 'm68k', 'x86_64'
+      'i386', 'powerpc', 'm68k', 'x86_64', 'sparc'
     );
 
-  Lazarus_CPU_OS_Widget_Combinations: array[1..21] of string = (
+  Lazarus_CPU_OS_Widget_Combinations: array[1..25] of string = (
     'i386-linux-gtk',
     'i386-linux-gnome',
     'i386-linux-gtk2',
@@ -120,7 +120,11 @@ const
     'i386-win32-gtk',
     'powerpc-darwin-gtk',
     'powerpc-darwin-gtk2',
-    'powerpc-darwin-carbon'
+    'powerpc-darwin-carbon',
+    'powerpc-linux-gtk',
+    'powerpc-linux-gtk2',
+    'sparc-linux-gtk',
+    'sparc-linux-gtk2'
     );
 
 type

components/printers/linux/cupsdyn.pp

@@ -1360,7 +1360,7 @@ end;
 
 procedure FinalizeCups;
 begin
-  writeln('* FinalizeCups');
+  //debugln('* FinalizeCups');
   if RefCount>0 then
     Dec(RefCount);
     

components/printers/linux/cupsprinters.inc

@@ -422,7 +422,10 @@ var
 var
   NewOutputFileName: String;
 begin
+  if FBeginDocCount>0 then
+    raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?');
   inherited DoBeginDoc;
+  inc(FBeginDocCount);
 
   if (not TryTemporaryPath('~/tmp/'))
   and (not TryTemporaryPath('/tmp/'))
@@ -440,6 +443,10 @@ end;
 procedure TCUPSPrinter.DoEndDoc(aAborded: Boolean);
 begin
   inherited DoEndDoc(aAborded);
+  dec(FBeginDocCount);
+  Exclude(FStates,cpsPaperRectValid);
+
+  //exit;
   
   if not aAborded then
     PrintFile(TPostscriptPrinterCanvas(Canvas).OutPutFileName);
@@ -575,7 +582,9 @@ begin
     fCachedCopies:=GetAttributeInteger('copies-default',fCachedCopies);
     //Get Copies in options or return default value
     fCachedCopies:=StrToIntdef(cupsGetOption('copies'),fCachedCopies);
-    //TODO Include(FStates,cpsCopiesValid);
+    {$IFDEF UseCache}
+    Include(FStates,cpsCopiesValid);
+    {$ENDIF}
   end;
   Result:=fCachedCopies;
 end;
@@ -583,13 +592,16 @@ end;
 procedure TCUPSPrinter.DoSetCopies(aValue: Integer);
 var i : Integer;
 begin
-  //if aValue=DoGetCopies then exit;
+  {$IFDEF UseCache}
+  if aValue=DoGetCopies then exit;
+  Exclude(FStates,cpsCopiesValid);
+  {$ENDIF}
   inherited DoSetCopies(aValue);
 
   if Printers.Count>0 then
   begin
     if not Assigned(fcupsOptions) then
-         SetOptionsOfPrinter;
+      SetOptionsOfPrinter;
     i:=aValue;
     if i<1 then i:=1;
     cupsAddOption('copies',IntToStr(i));
@@ -611,7 +623,9 @@ begin
       //Calc result
       fCachedOrientation:=TPrinterOrientation(i-3);
     end;
-    //TODO Include(FStates,cpsOrientationValid);
+    {$IFDEF UseCache}
+    Include(FStates,cpsOrientationValid);
+    {$ENDIF}
   end;
   Result:=fCachedOrientation;
 end;
@@ -619,7 +633,10 @@ end;
 procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation);
 var St : String;
 begin
-  //if aValue=DoGetOrientation then exit;
+  {$IFDEF UseCache}
+  if aValue=DoGetOrientation then exit;
+  Exclude(FStates,cpsOrientationValid);
+  {$ENDIF}
   inherited DoSetOrientation(aValue);
 
   if Printers.Count>0 then
@@ -638,7 +655,9 @@ begin
     fCachedGetDefaultPaperName:=inherited DoGetDefaultPaperName;
     fCachedGetDefaultPaperName:=
                  GetAttributeString('media-default',fCachedGetDefaultPaperName);
-    //TODO Include(FStates,cpsDefaultPaperNameValid);
+    {$IFDEF UseCache}
+    Include(FStates,cpsDefaultPaperNameValid);
+    {$ENDIF}
   end;
   Result:=fCachedGetDefaultPaperName;
 end;
@@ -647,13 +666,19 @@ function TCUPSPrinter.DoGetPaperName: string;
 begin
   if not (cpsPaperNameValid in FStates) then begin
     fCachedPaperName:=cupsGetOption('PageSize');
-    //TODO Include(FStates,cpsPaperNameValid);
+    {$IFDEF UseCache}
+    Include(FStates,cpsPaperNameValid);
+    {$ENDIF}
   end;
   Result:=fCachedPaperName;
 end;
 
 procedure TCUPSPrinter.DoSetPaperName(aName: string);
 begin
+  {$IFDEF UseCache}
+  if aName=DoGetPaperName then exit;
+  Exclude(FStates,cpsPaperNameValid);
+  {$ENDIF}
   inherited DoSetPaperName(aName);
   cupsAddOption('PageSize',aName)
 end;
@@ -664,31 +689,53 @@ end;
 //          1 aPaperRc.WorkRect is really the work rect
 function TCUPSPrinter.DoGetPaperRect(aName: string;
   var aPaperRc: TPaperRect): Integer;
-var P : Pppd_size_t;
-begin
-  Result:=inherited DoGetPaperRect(aName, aPaperRc);
   
-  FillChar(aPaperRc,SizeOf(aPaperRc),0);
+  procedure SortInts(var a, b: Integer);
-  if not CUPSLibInstalled then Exit;
+  var
-
+    h: LongInt;
-  if Assigned(fcupsPPD) then
   begin
-    P:=nil;
+    if b<a then begin
-    P:=ppdPageSize(fcupsPPD,PChar(aName));
+      h:=a;
-    if Assigned(P) then
+      a:=b;
-    begin
+      b:=h;
-      Result:=0; //CUPS return margins
-      
-      aPaperRc. PhysicalRect.Right:=Trunc(P^.Width);
-      aPaperRc.PhysicalRect.Bottom:=Trunc(P^.Length);
-
-      //Margings
-      aPaperRc.WorkRect.Left:=Trunc(P^.Left);
-      aPaperRc.WorkRect.Right:=Trunc(P^.Right);
-      aPaperRc.WorkRect.Top:=Trunc(P^.Top);
-      aPaperRc.WorkRect.Bottom:=Trunc(P^.Bottom);
     end;
   end;
+  
+var P : Pppd_size_t;
+begin
+  if (not (cpsPaperRectValid in FStates))
+  or (fCachePaperRectName<>aName) then begin
+    fCachePaperRectName:=aName;
+    FillChar(fCachePaperRect,SizeOf(fCachePaperRect),0);
+    fCachePaperRectResult:=inherited DoGetPaperRect(aName, aPaperRc);
+    {$IFDEF UseCache}
+    Include(FStates,cpsPaperRectValid);
+    {$ENDIF}
+
+    if CUPSLibInstalled and Assigned(fcupsPPD) then
+    begin
+      P:=nil;
+      P:=ppdPageSize(fcupsPPD,PChar(aName));
+      if Assigned(P) then
+      begin
+        fCachePaperRectResult:=1; //CUPS return margins
+
+        fCachePaperRect.PhysicalRect.Right:=Trunc(P^.Width);
+        fCachePaperRect.PhysicalRect.Bottom:=Trunc(P^.Length);
+
+        //Margings
+        fCachePaperRect.WorkRect.Left:=Trunc(P^.Left);
+        fCachePaperRect.WorkRect.Right:=Trunc(P^.Right);
+        fCachePaperRect.WorkRect.Top:=Trunc(P^.Top);
+        fCachePaperRect.WorkRect.Bottom:=Trunc(P^.Bottom);
+        SortInts(fCachePaperRect.WorkRect.Top,fCachePaperRect.WorkRect.Bottom);
+        SortInts(fCachePaperRect.WorkRect.Left,fCachePaperRect.WorkRect.Right);
+        //debugln('TCUPSPrinter.DoGetPaperRect PhysicalRect=',dbgs(fCachePaperRect.PhysicalRect),' WorkRect=',dbgs(fCachePaperRect.WorkRect));
+      end;
+    end;
+  end;
+  Result:=fCachePaperRectResult;
+  aPaperRc:=fCachePaperRect;
 end;
 
 

components/printers/linux/cupsprinters_h.inc

@@ -61,7 +61,8 @@ type
     cpsDefaultPaperNameValid,
     cpsOrientationValid,
     cpsPaperNameValid,
-    cpsCopiesValid
+    cpsCopiesValid,
+    cpsPaperRectValid
     );
   TCUPSPrinterStates = set of TCUPSPrinterState;
 
@@ -79,6 +80,10 @@ type
      fCachedOrientation: TPrinterOrientation;
      fCachedPaperName: string;
      fCachedCopies: integer;
+     fCachePaperRectName: string;
+     fCachePaperRect: TPaperRect;
+     fCachePaperRectResult: Integer;
+     FBeginDocCount: Integer;
 
      function GetCupsRequest : Pipp_t;
      procedure DoCupsConnect;
@@ -102,7 +107,8 @@ type
      function DoGetDefaultPaperName: string; override;
      function DoGetPaperName: string; override;
      procedure DoSetPaperName(aName : string); override;
-     function DoGetPaperRect(aName : string; var aPaperRc: TPaperRect): Integer; override;
+     function DoGetPaperRect(aName : string;
+                             var aPaperRc: TPaperRect): Integer; override;
      function DoGetPrinterState: TPrinterState; override;
      
      function GetPrinterType : TPrinterType; override;

components/printers/printer4lazarus.lpk

@@ -19,6 +19,7 @@
         </Debugging>
       </Linking>
       <Other>
+        <CustomOptions Value="-dUseCache"/>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>

docs/DesignGuidelines.txt

@@ -9,6 +9,10 @@ Coding style:
   growing allows to split it.
 - Minimize the number of calls from Interfaces to LCL, when performing an
   action requested by the LCL.
+- All code must work with all checks (range, io, overflow, stack) on. Beside
+  that this helps debugging, some users put these checks into their fpc.cfg, so
+  they are applied to whole lazarus. Including packages and examples.
+
 
 New files:
 - Every file should start with a header containing the license and a few lines
@@ -28,5 +32,3 @@ Dialogs (modal forms):
 Main Menu Items:
 - Should have a key in keymapping.pp
 
-
-

lcl/interfaces/gtk/gtkproc.pp

@@ -1071,7 +1071,7 @@ var
   XDisplay: PDisplay;
   XScreen: PScreen;
   XWindow: TWindow;
-  AtomType: TAtom;
+  AtomType: x.TAtom;
   Format: gint;
   nitems: gulong;
   bytes_after: gulong;
@@ -1101,13 +1101,12 @@ var
   xdisplay: PDisplay;
   xwindow: TWindow;
 
- atomtype: TAtom;
+  atomtype: x.TAtom;
- format: gint;
+  format: gint;
- nitems: gulong;
+  nitems: gulong;
- bytes_after: gulong;
+  bytes_after: gulong;
- current_desktop: pguint;
+  current_desktop: pguint;
 begin
-
   Result := -1;
   XWindow := GDK_WINDOW_XWINDOW (Window);
   XDisplay := GDK_WINDOW_XDISPLAY (Window);

packager/addtopackagedlg.pas

@@ -788,15 +788,19 @@ var
   ok: Boolean;
   CurParams: TAddToPkgResult;
 begin
-  ok:=true;
+  ok:=false;
   try
     LastParams:=nil;
     for i:=0 to FilesListView.Items.Count-1 do begin
       Filename:=FilesListView.Items[i].Caption;
       LazPackage.LongenFilename(Filename);
+
+      // skip directories
+      if DirPathExists(Filename) then continue;
+      
       NewFileType:=FileNameToPkgFileType(Filename);
 
-      if not FileExists(Filename) then begin
+      if (not FileExists(Filename)) then begin
         MessageDlg(lisFileNotFound,
           Format(lisPkgMangFileNotFound, ['"', Filename, '"']),
           mtError,[mbCancel],0);
@@ -837,7 +841,7 @@ begin
         end;
 
         // check unitname
-        if AnsiCompareText(CurParams.UnitName,
+        if CompareText(CurParams.UnitName,
           ExtractFileNameOnly(CurParams.UnitFilename))<>0
         then begin
           MessageDlg(lisA2PInvalidUnitName,
@@ -848,9 +852,13 @@ begin
       end;
       LastParams:=CurParams;
     end;
+    ok:=LastParams<>nil;
   finally
     if not ok then Params.Clear;
   end;
+  if LastParams=nil then begin
+    exit;
+  end;
   ModalResult:=mrOk;
 end;