fpspreadsheet: Implement writing and reading of ods formulas. Some issues with date/time formulas.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3510 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/fpsexprparser.pas

@@ -33,6 +33,9 @@
     - add boolean constants "TRUE" and "FALSE".
     - add property RPNFormula to interface the parser to RPN formulas of xls files.
     - accept funtions with zero parameters
+    - generalize scanner and parser to allow localized decimal and list separators
+    - add to spreadsheet format to parser to take account of formula "dialect"
+      (see OpenDocument using [] around cell addresses)
 
  ******************************************************************************}
 
@@ -87,6 +90,8 @@ type
   TsExpressionParser = class;
   TsBuiltInExpressionManager = class;
 
+  TsFormulaDialect = (fdExcel, fdOpenDocument);
+
   TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
     rtCell, rtCellRange, rtError, rtAny);
   TsResultTypes = set of TsResultType;
@@ -651,6 +656,7 @@ type
     function DoIdentifier: TsTokenType;
     function DoNumber: TsTokenType;
     function DoDelimiter: TsTokenType;
+    function DoSquareBracket: TsTokenType;
     function DoString: TsTokenType;
     function NextPos: Char; // inline;
     procedure SkipWhiteSpace; // inline;
@@ -681,6 +687,7 @@ type
     FHashList: TFPHashObjectlist;
     FDirty: Boolean;
     FWorksheet: TsWorksheet;
+    FDialect: TsFormulaDialect;
     procedure CheckEOF;
     procedure CheckNodes(var ALeft, ARight: TsExprNode);
     function ConvertNode(Todo: TsExprNode; ToType: TsResultType): TsExprNode;
@@ -743,6 +750,7 @@ type
     property Identifiers: TsExprIdentifierDefs read FIdentifiers write SetIdentifiers;
     property BuiltIns: TsBuiltInExprCategories read FBuiltIns write SetBuiltIns;
     property Worksheet: TsWorksheet read FWorksheet;
+    property Dialect: TsFormulaDialect read FDialect write FDialect;
   end;
 
   TsSpreadsheetParser = class(TsExpressionParser)
@@ -855,6 +863,8 @@ resourcestring
   SErrCommaExpected =  'Expected comma (,) at position %d, but got %s';
   SErrInvalidNumberChar = 'Unexpected character in number : %s';
   SErrInvalidNumber = 'Invalid numerical value : %s';
+  SErrInvalidCell = 'No valid cell address specification : %s';
+  SErrInvalidCellRange = 'No valid cell range specification : %s';
   SErrNoOperand = 'No operand for unary operation %s';
   SErrNoLeftOperand = 'No left operand for binary operation %s';
   SErrNoRightOperand = 'No left operand for binary operation %s';
@@ -1039,6 +1049,40 @@ begin
   Result := ttNumber;
 end;
 
+{ Scans until closing square bracket is reached. In OpenDocument, this is
+  a cell or cell range identifier. }
+function TsExpressionScanner.DoSquareBracket: TsTokenType;
+var
+  C: Char;
+  p: Integer;
+  r1,c1,r2,c2: Cardinal;
+  flags: TsRelFlags;
+begin
+  FToken := '';
+  C := NextPos;
+  while (C <> ']') do
+  begin
+    if C = cNull then
+      ScanError(SErrUnexpectedEndOfExpression);
+    FToken := FToken + C;
+    C := NextPos;
+  end;
+  FToken := Copy(FToken, 2, Length(FToken) - 2);  // Delete "[" and "]"
+  p := system.pos('.', FToken);                          // Delete up tp "."  (--> to be considered later!)
+  if p <> 0 then Delete(FToken, 1, p);
+  if system.pos(':', FToken) > 0 then
+  begin
+    if ParseCellRangeString(FToken, r1, c1, r2, c2, flags) then
+      Result := ttCellRange
+    else
+      ScanError(Format(SErrInvalidCellRange, [FToken]));
+  end else
+  if ParseCellString(FToken, r1, c1, flags) then
+    Result := ttCell
+  else
+    ScanError(Format(SErrInvalidCell, [FToken]));
+end;
+
 function TsExpressionScanner.DoString: TsTokenType;
 
   function TerminatingChar(C: Char): boolean;
@@ -1055,7 +1099,7 @@ begin
   C := NextPos;
   while not TerminatingChar(C) do
   begin
-    FToken := FToken+C;
+    FToken := FToken + C;
     if C = cDoubleQuote then
       NextPos;
     C := NextPos;
@@ -1082,7 +1126,9 @@ begin
   FToken := '';
   SkipWhiteSpace;
   C := FChar^;
-  if c = cNull then
+  if (FParser.Dialect = fdOpenDocument) and (C = '[') then
+    Result := DoSquareBracket
+  else if C = cNull then
     Result := ttEOF
   else if IsDelim(C) then
     Result := DoDelimiter
@@ -1156,6 +1202,7 @@ end;
 constructor TsExpressionParser.Create(AWorksheet: TsWorksheet);
 begin
   inherited Create;
+  FDialect := fdExcel;
   FWorksheet := AWorksheet;
   FIdentifiers := TsExprIdentifierDefs.Create(TsExprIdentifierDef);
   FIdentifiers.FParser := Self;
@@ -3723,6 +3770,8 @@ end;
 function TsCellExprNode.AsString: string;
 begin
   Result := GetCellString(FRow, FCol, FFlags);
+  if FParser.Dialect = fdOpenDocument then
+    Result := '[.' + Result + ']';
 end;
 
 procedure TsCellExprNode.GetNodeValue(var Result: TsExpressionResult);

components/fpspreadsheet/fpsopendocument.pas

@@ -193,7 +193,7 @@ type
 implementation
 
 uses
-  StrUtils, Variants, fpsStreams;
+  StrUtils, Variants, fpsStreams, fpsExprParser;
 
 const
   { OpenDocument general XML constants }
@@ -685,6 +685,7 @@ begin
   inherited Create(AWorkbook);
   FPointSeparatorSettings := DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator := '.';
+  FPointSeparatorSettings.ListSeparator := ';';  // for formulas
 
   FCellStyleList := TFPList.Create;
   FColumnStyleList := TFPList.Create;
@@ -1257,10 +1258,12 @@ var
   valueType: String;
   valueStr: String;
   node: TDOMNode;
+  parser: TsSpreadsheetParser;
+  p: Integer;
 begin
-
   // Create cell and apply format
-  if FIsVirtualMode then begin
+  if FIsVirtualMode then
+  begin
     InitCell(ARow, ACol, FVirtualCell);
     cell := @FVirtualCell;
   end else
@@ -1269,10 +1272,28 @@ begin
   styleName := GetAttrValue(ACellNode, 'table:style-name');
   ApplyStyleToCell(cell, stylename);
 
-  // Read formula, store in the cell's FormulaValue.FormulaStr
+  if (boReadFormulas in FWorkbook.Options) then begin
-  formula := GetAttrValue(ACellNode, 'table:formula');
+    // Read formula, trim it, ...
-  if formula <> '' then Delete(formula, 1, 3);  // delete "of:"
+    formula := GetAttrValue(ACellNode, 'table:formula');
-  cell^.FormulaValue := formula;
+    if formula <> '' then
+    begin
+      // formulas written by Spread begin with 'of:=', our's with '=' --> remove that
+      p := pos('=', formula);
+      Delete(formula, 1, p);
+    end;
+    // ... convert to Excel dialect used by fps by defailt
+    parser := TsSpreadsheetParser.Create(FWorksheet);
+    try
+      parser.Dialect := fdOpenDocument;
+      parser.Expression := formula;
+      parser.Dialect := fdExcel;
+      formula := parser.Expression;
+    finally
+      parser.Free;
+    end;
+    // ... and store in cell's FormulaValue field.
+    cell^.FormulaValue := formula;
+  end;
 
   // Read formula results
   // ... number value
@@ -2685,6 +2706,8 @@ end;
 procedure TsSpreadOpenDocWriter.WriteWorksheet(AStream: TStream;
   CurSheet: TsWorksheet);
 begin
+  FWorksheet := CurSheet;
+
   // Header
   AppendToStream(AStream,
     '<table:table table:name="' + CurSheet.Name + '" table:style-name="ta1">');
@@ -3069,6 +3092,7 @@ begin
 
   FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
   FPointSeparatorSettings.DecimalSeparator:='.';
+  FPointSeparatorSettings.ListSeparator := ';';   // for formulas
 
   // http://en.wikipedia.org/wiki/List_of_spreadsheet_software#Specifications
   FLimitations.MaxColCount := 1024;
@@ -3576,6 +3600,10 @@ procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
 var
   lStyle: String = '';
   lIndex: Integer;
+  parser: TsExpressionParser;
+  formula: String;
+  valuetype: String;
+  value: string;
 begin
   Unused(AStream, ARow, ACol);
 
@@ -3585,15 +3613,65 @@ begin
   end else
     lStyle := '';
 
+  // Convert string formula to the format needed by ods: semicolon list separators!
+  parser := TsSpreadsheetParser.Create(FWorksheet);
+  try
+    parser.Dialect := fdOpenDocument;
+    parser.Expression := ACell^.FormulaValue;
+    formula := Parser.LocalizedExpression[FPointSeparatorSettings];
+  finally
+    parser.Free;
+  end;
+
+  case ACell^.ContentType of
+    cctNumber:
+      begin
+        valuetype := 'float';
+        value := FormatFloat('%g', ACell^.NumberValue, FPointSeparatorSettings);
+      end;
+    cctDateTime:
+      begin
+        valuetype := 'float';
+        value := FormatFloat('%g', ACell^.DateTimeValue, FPointSeparatorSettings);
+      end;
+    cctUTF8String:
+      begin
+        valuetype := 'string';
+        value := ACell^.UTF8StringValue;
+      end;
+    cctBool:
+      begin
+        valuetype := 'boolean';
+        value := BoolToStr(ACell^.BoolValue, 'true', 'false');
+      end;
+    cctError:
+      begin
+        valuetype := 'error';
+        value := GetErrorValueStr(ACell^.ErrorValue);
+      end;
+  end;
+
+  { Fix special xml characters }
+  formula := UTF8TextToXMLText(formula);
+
   { We are writing a very rudimentary formula here without result and result
     data type. Seems to work... }
-  AppendToStream(AStream, Format(
+  if ACell^.CalcState=csCalculated then
-    '<table:table-cell table:formula="%s" %s>' +
+    AppendToStream(AStream, Format(
-    '</table:table-cell>', [
+      '<table:table-cell table:formula="=%s" office:value-type="%s" office-value="%s" %s>' +
-    ACell^.FormulaValue, lStyle
+        '<text:p>%s</text:p>'+
-  ]));
+      '</table:table-cell>', [
+      formula, valuetype, value, lStyle,
+      value
+    ]))
+  else
+    AppendToStream(AStream, Format(
+      '<table:table-cell table:formula="=%s" %s/>', [
+      formula, lStyle
+    ]));
 end;
 
+
 {
   Writes a cell with text content
 

components/fpspreadsheet/tests/formulatests.pas

@@ -47,6 +47,8 @@ type
     procedure Test_Write_Read_FormulaStrings_BIFF8;
     { OOXML Tests }
     procedure Test_Write_Read_FormulaStrings_OOXML;
+    { ODS Tests }
+    procedure Test_Write_Read_FormulaStrings_ODS;
 
     // Writes out and calculates rpn formulas, read back
     { BIFF2 Tests }
@@ -185,6 +187,11 @@ begin
   TestWriteReadFormulaStrings(sfOOXML, true);
 end;
 
+procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS;
+begin
+  TestWriteReadFormulaStrings(sfOpenDocument, true);
+end;
+
 
 { Test calculation of formulas }
 

components/fpspreadsheet/tests/spreadtestgui.lpi

@@ -48,10 +48,12 @@
       <Unit1>
         <Filename Value="datetests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="datetests"/>
       </Unit1>
       <Unit2>
         <Filename Value="stringtests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="stringtests"/>
       </Unit2>
       <Unit3>
         <Filename Value="numberstests.pas"/>
@@ -61,7 +63,6 @@
       <Unit4>
         <Filename Value="manualtests.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="manualtests"/>
       </Unit4>
       <Unit5>
         <Filename Value="testsutility.pas"/>
@@ -71,6 +72,7 @@
       <Unit6>
         <Filename Value="internaltests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="internaltests"/>
       </Unit6>
       <Unit7>
         <Filename Value="formattests.pas"/>
@@ -80,6 +82,7 @@
       <Unit8>
         <Filename Value="colortests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="colortests"/>
       </Unit8>
       <Unit9>
         <Filename Value="fonttests.pas"/>
@@ -96,7 +99,6 @@
       <Unit12>
         <Filename Value="rpnformulaunit.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="rpnFormulaUnit"/>
       </Unit12>
       <Unit13>
         <Filename Value="formulatests.pas"/>
@@ -110,10 +112,12 @@
       <Unit15>
         <Filename Value="errortests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="errortests"/>
       </Unit15>
       <Unit16>
         <Filename Value="virtualmodetests.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="virtualmodetests"/>
       </Unit16>
     </Units>
   </ProjectOptions>