Printers, refactored (partially reworked) bins support, implemented cups missing part

git-svn-id: trunk@41171 -

components/printers/unix/cupslcl.pas

@@ -5,7 +5,11 @@ unit cupslcl;
 interface
 
 uses
-  Classes, SysUtils, StdCtrls, OsPrinters, Printers, CupsDyn;
+  Classes, SysUtils,
+  {$ifdef DebugCUPS}
+  LCLProc,
+  {$endif}
+  StdCtrls, OsPrinters, Printers, CupsDyn;
 
 const
   C_SPACE       = 6;

components/printers/unix/cupsprinters.inc

@@ -19,6 +19,78 @@ begin
   Result:=InternalGetResolution(False);
 end;
 
+procedure TCUPSPrinter.DoEnumBins(Lst: TStrings);
+var
+  choice: Pppd_choice_t;
+  Option: Pppd_option_t;
+  c: Integer;
+begin
+  Lst.Clear;
+  if CupsPPD<>nil then
+  begin
+    Option := ppdFindOption(CupsPPD, PChar('InputSlot'));
+    if Option<>nil then
+    begin
+      Choice := Option^.choices;
+      c := 0;
+      while (Choice<>nil) and (c<Option^.num_choices) do
+      begin
+        lst.AddObject(Choice^.text, TObject(Choice));
+        inc(choice);
+        inc(c);
+      end;
+    end;
+  end;
+end;
+
+function TCUPSPrinter.DoGetDefaultBinName: string;
+var
+  Option: Pppd_option_t;
+  Choice: pppd_choice_t;
+begin
+  Result:=inherited DoGetDefaultBinName;
+
+  if CupsPPD<>nil then
+  begin
+    Option := ppdFindOption(CupsPPD, 'InputSlot');
+    if Option<>nil then
+    begin
+      choice := PPDOptionChoiceFrom('InputSlot', Option^.defchoice, true);
+      if choice<>nil then
+        result := choice^.text;
+    end;
+  end;
+end;
+
+function TCUPSPrinter.DoGetBinName: string;
+var
+  Choice: pppd_choice_t;
+begin
+  result := cupsGetOption('InputSlot');
+  if result<>'' then
+  begin
+    Choice := PPDOptionChoiceFrom('InputSlot', result, true);
+    if Choice<>nil then
+      result := Choice^.text
+    else
+      result := '';
+  end;
+
+  if result='' then
+    result := doGetDefaultBinName
+end;
+
+procedure TCUPSPrinter.DoSetBinName(aName: string);
+var
+  Choice: pppd_choice_t;
+begin
+  Choice := PPDOptionChoiceFrom('InputSlot', aName, false);
+  if Choice<>nil then
+    cupsAddOption('InputSlot', choice^.choice)
+  else
+    inherited doSetBinName(aName); // handle input slot not found
+end;
+
 //write count bytes from buffer to raw mode stream
 function TCUPSPrinter.Write(const Buffer; Count: Integer; var Written: Integer
   ): Boolean;
@@ -46,7 +118,7 @@ begin
   FCupsPapersCount := -1;
 end;
 
-destructor TCUPSPrinter.destroy;
+destructor TCUPSPrinter.Destroy;
 begin
   if assigned(fRawModeStream) then
     fRawModeStream.Free;
@@ -408,6 +480,36 @@ begin
 
 end;
 
+function TCUPSPrinter.PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string;
+  IsKey:boolean): pppd_choice_t;
+var
+  i: Integer;
+  option: pppd_option_t;
+  p: pchar;
+begin
+  result := nil;
+
+  if (fcupsPrinter=nil) or (fcupsppd=nil) or (option=nil) then
+    exit;
+
+  option := ppdFindOption(fcupsppd, pchar(OptionStr));
+  if option=nil then
+    exit;
+
+  for i:=0 to option^.num_choices-1 do
+  begin
+    if IsKey then
+      p := @option^.choices[i].choice
+    else
+      p := @option^.choices[i].text;
+    if strcomp(p, pchar(aKeyOrValue))=0 then
+    begin
+      result := @option^.choices[i];
+      break;
+    end;
+  end;
+end;
+
 
 //Set State of Job
 procedure TCUPSPrinter.SetJobState(aJobId : LongInt; aOp : ipp_op_t);

components/printers/unix/cupsprinters_h.inc

@@ -140,6 +140,11 @@ type
      function GetXDPI: Integer; override;
      function GetYDPI: Integer; override;
 
+     procedure DoEnumBins(Lst : TStrings); override;
+     function DoGetDefaultBinName: string; override;
+     function DoGetBinName: string; override;
+     procedure DoSetBinName(aName: string); override;
+
      {-------------------------------------------------
          SPECIFIC CUPS METHODS OR PROPERTIES
      --------------------------------------------------}
@@ -156,7 +161,8 @@ type
 
      procedure cupsAddOption(aName,aValue: string);
      function GetResolutionOption: string;
-      function IsOptionValueValid(AKeyword,AValue: pchar): boolean;
+     function IsOptionValueValid(AKeyword,AValue: pchar): boolean;
+     function PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string; IsKey:boolean): pppd_choice_t;
   public
     constructor Create; override;
     destructor Destroy; override;

components/printers/win32/winprinters.inc

@@ -45,16 +45,9 @@ begin
   if fPrinterHandle <> 0 then
     ClosePrinter(fPrinterHandle);
 
-  if fBins<>nil then
-    fBins.Destroy;
   inherited Destroy;
 end;
 
-Procedure TWinPrinter.RestoreDefaultBin;
-begin
-  DoSetBinName(DoGetDefaultBinName);
-end;
-
 function TWinPrinter.Write(const Buffer; Count: Integer;
   var Written: Integer): Boolean;
 begin
@@ -233,15 +226,6 @@ begin
   fLastHandleType:=htNone;
 end;
 
-Procedure TWinPrinter.CheckfBins;
-begin
-  if fbins<>nil then exit;
-  fbins := TStringList.Create;
-  DoEnumBins(fBins);
-  if fBins=nil then
-    EPrinter.Create('checkfBins error : can not create list of bins');
-end;
-
 // Based on MS Article Q167345
 function TWinPrinter.UpdateDevMode(APrinterIndex:Integer): boolean;
 var
@@ -833,11 +817,6 @@ begin
                                    [SysErrorMessage(GetlastError)]);
     end;
 
-    if fbins<>nil then begin
-      fbins.Free;
-      fbins:=nil;
-    end;
-
     if UpdateDevMode(i) then
       Result := i
     else
@@ -1045,7 +1024,11 @@ var
     PDev   : TPrinterDevice;
     arBins : Array[0..255] of Word;
 begin
-  inherited DoEnumBins(Lst);
+
+  if Lst=nil then
+    exit;
+
+  Lst.Clear;
 
   if (Printers.Count>0) then
   begin
@@ -1126,18 +1109,16 @@ function TWinPrinter.DoGetDefaultBinName: string;
 var i    : Integer;
     PDev : TPrinterDevice;
 begin
-  CheckfBins;
   Result:=inherited DoGetDefaultBinName;
 
-  if (Printers.Count>0) then
-  begin
-    PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
-    with fBins do begin
+  with SupportedBins do
+    if (Printers.Count>0) then
+    begin
+      PDev:=TPrinterDevice(Printers.Objects[PrinterIndex]);
       i:=IndexOfObject(TObject(ptrint(PDev.DefaultBin)));
       if i<>-1 then
         Result:= Strings[i];
     end;
-  end;
 end;
 
 function TWinPrinter.DoGetBinName: string;
@@ -1149,13 +1130,12 @@ var
   dm: PDeviceMode;
   {$ENDIF}
 begin
-  CheckfBins;
   Result:=inherited DoGetBinName;
   if GetCurrentDevMode(dm) then
-    with fBins do begin
+    with SupportedBins do begin
       i := IndexOfObject(TObject(ptrInt(dm^.dmDefaultSource)));
       if i>=0 then
-        result := fBins[i];
+        result := Strings[i];
     end;
 end;
 
@@ -1168,21 +1148,19 @@ var
   dm: PDeviceMode;
   {$ENDIF}
 begin
-  CheckfBins;
-  inherited DoSetBinName(aName);
-  if GetCurrentDevMode(dm) then begin
-    i:=fBins.IndexOf(aName);
-    if i<>-1 then begin
-      ClearDC;
-      dm^.dmDefaultSource := SHORT(ptrint(fBins.Objects[i]));
-    end;
-  end;
-end;
+  with SupportedBins do begin
 
-function TWinPrinter.GetBins: TStrings;
-begin
-  CheckfBins;
-  result := fbins;
+    if not GetCurrentDevMode(dm) then
+      raise EPrinter.Create('DoSetBinName error : unable to get current DevMode');
+
+    i := IndexOf(aName);
+    if (i>=0) then begin
+      ClearDC;
+      dm^.dmDefaultSource := SHORT(ptrint(Objects[i]));
+    end else
+      inherited DoSetBinName(aName); // handle uknown bin name
+
+  end;
 end;
 
 initialization

components/printers/win32/winprinters_h.inc

@@ -45,7 +45,6 @@ Type
     procedure ClearDC;
     procedure FreeDC;
     function UpdateDevMode(APrinterIndex:Integer): boolean;
-    Procedure CheckfBins;
 
   protected
     function GetDefaultPrinter: string;
@@ -67,7 +66,6 @@ Type
     function DoGetDefaultBinName: string; override;
     function DoGetBinName: string; override;
     procedure DoSetBinName(aName: string); override;
-    function GetBins: TStrings; override;
 
     function DoSetPrinter(aName : string): Integer; override;
     
@@ -90,7 +88,6 @@ Type
     constructor Create; override;
     destructor Destroy; override;
     
-    Procedure RestoreDefaultBin; override;
     function Write(const Buffer; Count:Integer; var Written: Integer): Boolean; override;
 
     //Warning not portable functions here

lcl/printers.pas

@@ -198,6 +198,7 @@ type
     fPaperSize   : TPaperSize;
     fRawMode     : Boolean;
     fCanvasClass : TPrinterCanvasRef;
+    fBins        : TStrings;
 
     function GetCanvas: TCanvas;
     procedure CheckPrinting(Value: Boolean);
@@ -209,6 +210,7 @@ type
     function GetPageWidth: Integer;
     function GetPaperSize: TPaperSize;
     Function GetBinName: string;
+    function GetDefaultBinName: string;
     function GetPrinterIndex: integer;
     function GetPrinterName: string;
     function GetPrinters: TStrings;
@@ -219,7 +221,6 @@ type
     procedure SetRawMode(const AValue: boolean);
     procedure SetBinName(const aName: string);
   protected
-     fBins        : TStringList;
      procedure SelectCurrentPrinterOrDefault;
      
      procedure DoBeginDoc; virtual;
@@ -293,6 +294,7 @@ type
      property XDPI : Integer read GetXDPI;
      property YDPI : Integer read GetYDPI;
      property RawMode: boolean read FRawMode write SetRawMode;
+     property DefaultBinName: string read GetDefaultBinName;
      property BinName: string read GetBinName write SetBinName;
      property SupportedBins: TStrings read GetBins;
   end;
@@ -324,7 +326,8 @@ begin
   if Printing then
     Abort;
 
- 
+  fBins.free;
+
   if Assigned(fCanvas) then
     fCanvas.Free;
     
@@ -486,9 +489,9 @@ begin
   PrinterSelected;
 end;
 
-Procedure TPrinter.RestoreDefaultBin;
+procedure TPrinter.RestoreDefaultBin;
 begin
-  // override this function
+  DoSetBinName(DoGetDefaultBinName);
 end;
 
 function TPrinter.Write(const Buffer; Count:Integer; var Written: Integer): Boolean;
@@ -537,7 +540,7 @@ begin
     Result := FCanvasClass;
 end;
 
-procedure TPrinter.CheckRawMode(const Value:boolean; msg:string ='');
+procedure TPrinter.CheckRawMode(const Value: boolean; Msg: string);
 begin
   if FRawMode<>Value then
   begin
@@ -617,10 +620,16 @@ begin
   Result:=fPaperSize;
 end;
 
-Function TPrinter.GetBinName: string;
+function TPrinter.GetBinName: string;
 begin
   result := doGetBinName;
 end;
+
+function TPrinter.GetDefaultBinName: string;
+begin
+  result := doGetDefaultBinName;
+end;
+
 //Return the current selected printer
 function TPrinter.GetPrinterIndex: integer;
 begin
@@ -673,7 +682,12 @@ end;
 
 function TPrinter.GetBins: TStrings;
 begin
-    result := nil;
+  if fBins=nil then
+    fBins := TStringList.Create;
+
+  doEnumBins(fBins);
+
+  result := fBins;
 end;
 
 //Set copies number
@@ -791,9 +805,7 @@ end;
 
 procedure TPrinter.DoEnumBins(Lst : TStrings);
 begin
-  //DebugLn(['TPrinter.DoEnumBins ',dbgsName(Self)]);
-
- //Override this method
+  // Override this method
 end;
 
 // This method is called once after the printer list
@@ -861,17 +873,17 @@ end;
 function TPrinter.DoGetDefaultBinName: string;
 begin
   Result:='';
-  //Override this method
 end;
 
 function TPrinter.DoGetBinName: string;
 begin
-  //Override this method
+  result := '';
 end;
 
 procedure TPrinter.DoSetBinName(aName: string);
 begin
-  //Override this method
+  if SupportedBins.Count>0 then
+    DebugLn('Warning: bin %s is not allowed',[aName]);
 end;
 
 //Initialise aPaperRc with the aName paper rect