Changeset 92 for trunk


Ignore:
Timestamp:
Feb 3, 2022, 10:08:07 PM (3 years ago)
Author:
chronos
Message:
  • Added: Detect used max line length. Default max line length should be 75 characters.
  • Added: Escape new lines in text strings.
  • Modified: Extended tests.
  • Fixed: Wrong max line length was used for UTF-8 strings during save.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormTest.pas

    r91 r92  
    4848
    4949uses
    50   UCore, UFormTestCase;
     50  UCore, UFormTestCase, UContact;
    5151
    5252{ TFormTest }
    … …  
    119119  with TestCases do begin
    120120    with TTestCaseLoadSave(AddNew('Load and save', TTestCaseLoadSave)) do begin
    121       Input := 'BEGIN:VCARD' + LineEnding +
     121      Input := VCardBegin + LineEnding +
    122122        'VERSION:2.1' + LineEnding +
    123123        'N:Surname;Name' + LineEnding +
    124124        'FN:Name Surname' + LineEnding +
    125         'END:VCARD' + LineEnding;
     125        VCardEnd + LineEnding;
     126      Output := Input;
     127    end;
     128    with TTestCaseLoadSave(AddNew('Long text', TTestCaseLoadSave)) do begin
     129      Input := VCardBegin + LineEnding +
     130        'VERSION:2.1' + LineEnding +
     131        'NOTE:This is some long test which is really multi-lined each line is on d' + LineEnding +
     132        ' ifferent line so it is on multiple lines.' + LineEnding +
     133        VCardEnd + LineEnding;
    126134      Output := Input;
    127135    end;
    128136    with TTestCaseLoadSave(AddNew('Multi-line', TTestCaseLoadSave)) do begin
    129       Input := 'BEGIN:VCARD' + LineEnding +
     137      Input := VCardBegin + LineEnding +
    130138        'VERSION:2.1' + LineEnding +
    131         'NOTE:This is some long test which is really multi-lined\neach line\nis on' + LineEnding +
    132         ' different\nline so it is on multiple\nlines.'  + LineEnding +
    133         'END:VCARD' + LineEnding;
     139        'NOTE:First line\nsecond line\nempty line\n\nlast line' + LineEnding +
     140        VCardEnd + LineEnding;
    134141      Output := Input;
    135142    end;
    … …  
    142149    end;
    143150    with TTestCaseLoadSave(AddNew('Begin only', TTestCaseLoadSave)) do begin
    144       Input := 'BEGIN:VCARD';
     151      Input := VCardBegin;
    145152      Output := '';
    146153    end;
    147154    with TTestCaseLoadSave(AddNew('Missing end', TTestCaseLoadSave)) do begin
    148       Input := 'BEGIN:VCARD' + LineEnding +
     155      Input := VCardBegin + LineEnding +
    149156        'VERSION:2.1' + LineEnding +
    150157        'N:Surname;Name' + LineEnding +
    151158        'FN:Name Surname' + LineEnding;
     159      Output := '';
     160    end;
     161    with TTestCaseLoadSave(AddNew('Missing start', TTestCaseLoadSave)) do begin
     162      Input := 'VERSION:2.1' + LineEnding +
     163        'N:Surname;Name' + LineEnding +
     164        'FN:Name Surname' + LineEnding +
     165        VCardEnd + LineEnding;
    152166      Output := '';
    153167    end;

  • trunk/UContact.pas

    r91 r92  
    127127    procedure SetModified(AValue: Boolean);
    128128    procedure DoOnModify;
     129    procedure DetectMaxLineLength(Text: string);
    129130  public
    130131    Properties: TContactProperties;
    … …  
    170171  TContactsFile = class(TDataFile)
    171172  private
     173    FMaxLineLength: Integer;
    172174    FOnError: TErrorEvent;
    173175    procedure Error(Text: string; Line: Integer);
    … …  
    184186    constructor Create; override;
    185187    destructor Destroy; override;
     188  published
    186189    property OnError: TErrorEvent read FOnError write FOnError;
     190    property MaxLineLength: Integer read FMaxLineLength write FMaxLineLength;
    187191  end;
    188192
    189193const
    190194  VCardFileExt = '.vcf';
     195  VCardBegin = 'BEGIN:VCARD';
     196  VCardEnd = 'END:VCARD';
    191197
    192198
    … …  
    197203
    198204const
    199   VCardBegin = 'BEGIN:VCARD';
    200   VCardEnd = 'END:VCARD';
     205  DefaultMaxLineLength = 75;
    201206
    202207resourcestring
    … …  
    323328  I: Integer;
    324329  O: Integer;
     330  InNewLine: Boolean;
    325331begin
    326332  Result := '';
    … …  
    330336  while I <= Length(Text) do begin
    331337    if Text[I] in [',', '\', ';'] then begin
     338      InNewLine := False;
     339      Result[O] := '\';
     340      SetLength(Result, Length(Result) + 1);
     341      Inc(O);
     342      Result[O] := Text[I];
     343      Inc(O);
     344    end else
     345    if Text[I] in [#13, #10] then begin
     346      if not InNewLine then begin
    332347        Result[O] := '\';
    333348        Inc(O);
    334         Result[O] := Text[I];
    335349        SetLength(Result, Length(Result) + 1);
     350        Result[O] := 'n';
    336351        Inc(O);
    337       end else begin
    338         Result[O] := Text[I];
    339         Inc(O);
     352        InNewLine := True;
    340353      end;
     354    end else begin
     355      InNewLine := False;
     356      Result[O] := Text[I];
     357      Inc(O);
     358    end;
    341359    Inc(I);
    342360  end;
    … …  
    357375  while I <= Length(Text) do begin
    358376    if Escaped then begin
    359       Result[O] := Text[I];
    360       Inc(O);
     377      if Text[I] = 'n' then begin
     378        Result[O] := #13;
     379        Inc(O);
     380        Result[O] := #10;
     381        Inc(O);
     382      end else begin
     383        Result[O] := Text[I];
     384        Inc(O);
     385      end;
    361386      Escaped := False;
    362387    end else begin
    … …  
    940965  Field: TContactField;
    941966begin
    942   if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     967  if not Assigned(ContactsFile) then
     968    raise Exception.Create(SContactHasNoParent);
    943969  Field := GetFields.GetByIndex(Index);
    944970  if Assigned(Field) then begin
    … …  
    947973      if Field.ValueIndex <> -1 then begin
    948974        Result := DecodeEscaped(Prop.ValueItem[Field.ValueIndex])
    949       end else Result := Prop.Value;
     975      end else begin
     976        if Field.DataType = dtString then Result := DecodeEscaped(Prop.Value)
     977          else Result := Prop.Value;
     978      end;
    950979    end else Result := '';
    951980  end else raise Exception.Create(SFieldIndexNotDefined);
    … …  
    958987  I: Integer;
    959988begin
    960   if not Assigned(ContactsFile) then raise Exception.Create(SContactHasNoParent);
     989  if not Assigned(ContactsFile) then
     990    raise Exception.Create(SContactHasNoParent);
    961991  Field := GetFields.GetByIndex(Index);
    962992  if Assigned(Field) then begin
    … …  
    9721002      if Field.ValueIndex <> -1 then begin
    9731003        Prop.ValueItem[Field.ValueIndex] := EncodeEscaped(AValue);
    974       end else Prop.Value := AValue;
     1004      end else begin
     1005        if Field.DataType = dtString then Prop.Value := EncodeEscaped(AValue)
     1006          else Prop.Value := EncodeEscaped(AValue);
     1007      end;
    9751008
    9761009      // Remove if empty
    … …  
    9931026begin
    9941027  if Assigned(FOnModify) then FOnModify(Self);
     1028end;
     1029
     1030procedure TContact.DetectMaxLineLength(Text: string);
     1031var
     1032  LineLength: Integer;
     1033begin
     1034  LineLength := UTF8Length(Text);
     1035  if LineLength > 1 then begin
     1036    // Count one character less for folded line
     1037    if Text[1] = ' ' then
     1038      Dec(LineLength);
     1039  end;
     1040  if LineLength > ContactsFile.MaxLineLength then
     1041    ContactsFile.MaxLineLength := LineLength;
    9951042end;
    9961043
    … …  
    10871134  LineIndex: Integer;
    10881135  OutText: string;
     1136  CutText: string;
    10891137  LinePrefix: string;
    10901138  CutLength: Integer;
    1091 const
    1092   MaxLineLength = 73;
    10931139begin
    10941140    with Output do begin
    … …  
    11151161          LinePrefix := '';
    11161162          while True do begin
    1117             if Length(OutText) > MaxLineLength then begin
    1118               CutLength := MaxLineLength;
     1163            if UTF8Length(OutText) > ContactsFile.MaxLineLength then begin
     1164              CutLength := ContactsFile.MaxLineLength;
    11191165              if Encoding = 'QUOTED-PRINTABLE' then begin
    11201166                // Do not cut encoded items
    … …  
    11241170                  Dec(CutLength, 1);
    11251171              end;
    1126               Add(LinePrefix + Copy(OutText, 1, CutLength));
     1172              CutText := UTF8Copy(OutText, 1, CutLength);
     1173              Add(LinePrefix + CutText);
    11271174              LinePrefix := ' ';
    1128               System.Delete(OutText, 1, CutLength);
     1175              System.Delete(OutText, 1, Length(CutText));
    11291176              Inc(LineIndex);
    11301177              Continue;
    … …  
    11571204  I := StartLine;
    11581205  while I < Lines.Count do begin
    1159     Line := Trim(Lines[I]);
     1206    Line := Lines[I];
     1207    DetectMaxLineLength(Line);
     1208
    11601209    if Line = '' then begin
    11611210      // Skip empty lines
    … …  
    11841233          if I >= Lines.Count then Break;
    11851234          Line2 := Lines[I];
     1235          DetectMaxLineLength(Line2);
    11861236          if (Length(Line2) > 0) and (Line2[1] = ' ') then begin
    1187             Value := Value + Trim(Line2);
     1237            Value := Value + Copy(Line2, 2, MaxInt);
    11881238          end else
    11891239          if (Length(Line2) > 0) and (Length(Value) > 0) and (Value[Length(Value)] = '=') and
    11901240            (Line2[1] = '=') then begin
    1191             Value := Value + Copy(Trim(Line2), 2, MaxInt);
     1241            Value := Value + Copy(Line2, 2, MaxInt);
    11921242          end else begin
    11931243            Dec(I);
    … …  
    12891339begin
    12901340  Contacts.Clear;
     1341  MaxLineLength := 10;
    12911342
    12921343  I := 0;
    … …  
    13531404  Contacts := TContacts.Create;
    13541405  Contacts.ContactsFile := Self;
     1406  MaxLineLength := DefaultMaxLineLength;
    13551407end;
    13561408

  • trunk/vCardStudio.lpi

    r91 r92  
    202202        <IsPartOfProject Value="True"/>
    203203        <ComponentName Value="FormTest"/>
     204        <HasResources Value="True"/>
    204205        <ResourceBaseClass Value="Form"/>
    205206      </Unit15>
    … …  
    212213        <IsPartOfProject Value="True"/>
    213214        <ComponentName Value="FormTestCase"/>
     215        <HasResources Value="True"/>
    214216        <ResourceBaseClass Value="Form"/>
    215217      </Unit17>
Note: See TracChangeset for help on using the changeset viewer.