~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/translations.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
{ $Id: translations.pas 29193 2011-01-25 12:02:56Z vincents $}
2
1
{
3
2
 *****************************************************************************
4
3
 *                                                                           *
65
64
unit Translations;
66
65
 
67
66
{$mode objfpc}{$H+}{$INLINE ON}
 
67
{$include include/lcl_defines.inc}
68
68
 
69
69
interface
70
70
 
71
71
uses
72
 
  Classes, SysUtils, LCLProc, FileUtil, StringHashList, LConvEncoding
73
 
  {$IFDEF UNIX}{$IFNDEF DisableCWString}, cwstring{$ENDIF}{$ENDIF};
 
72
  Classes, SysUtils, LCLProc, FileUtil, StringHashList, AvgLvlTree,
 
73
  LConvEncoding;
74
74
 
75
75
type
76
76
  TStringsType = (stLrt, stRst);
 
77
  TTranslateUnitResult = (turOK, turNoLang, turNoFBLang, turEmptyParam);
77
78
 
78
79
type
79
80
  { TPOFileItem }
82
83
  public
83
84
    Tag: Integer;
84
85
    Comments: string;
85
 
    Identifier: string;
 
86
    IdentifierLow: string; // lowercase
86
87
    Original: string;
87
88
    Translation: string;
88
89
    Flags: string;
89
90
    PreviousID: string;
90
91
    Context: string;
91
 
    constructor Create(const TheIdentifier, TheOriginal, TheTranslated: string);
 
92
    constructor Create(const TheIdentifierLow, TheOriginal, TheTranslated: string);
92
93
    procedure ModifyFlag(const AFlag: string; Check: boolean);
93
94
  end;
94
95
 
97
98
  TPOFile = class
98
99
  protected
99
100
    FItems: TFPList;// list of TPOFileItem
100
 
    FIdentifierToItem: TStringHashList;
101
 
    FIdentVarToItem: TStringHashList;
102
 
    FOriginalToItem: TStringHashList;
 
101
    FIdentifierLowToItem: TStringToPointerTree; // lowercase identifier to TPOFileItem
 
102
    FIdentLowVarToItem: TStringHashList; // of TPOFileItem
 
103
    FOriginalToItem: TStringHashList; // of TPOFileItem
103
104
    FCharSet: String;
104
105
    FHeader: TPOFileItem;
105
106
    FAllEntries: boolean;
122
123
    procedure Report;
123
124
    procedure CreateHeader;
124
125
    procedure UpdateStrings(InputLines:TStrings; SType: TStringsType);
 
126
    procedure SaveToStrings(OutLst: TStrings);
125
127
    procedure SaveToFile(const AFilename: string);
126
128
    procedure UpdateItem(const Identifier: string; Original: string);
127
129
    procedure UpdateTranslation(BasePOFile: TPOFile);
146
148
    // if you don't use UTF-8, install a proper widestring manager and set this
147
149
    // to false.
148
150
 
149
 
 
150
151
// translate resource strings for one unit
151
 
procedure TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
152
 
  Lang, FallbackLang: string); overload;
 
152
function TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
 
153
  Lang, FallbackLang: string):TTranslateUnitResult; overload;
153
154
function TranslateUnitResourceStrings(const ResUnitName, AFilename: string
154
155
  ): boolean; overload;
155
156
function TranslateUnitResourceStrings(const ResUnitName:string; po: TPOFile): boolean; overload;
165
166
 
166
167
implementation
167
168
 
 
169
function IsKey(Txt, Key: PChar): boolean;
 
170
begin
 
171
  if Txt=nil then exit(false);
 
172
  if Key=nil then exit(true);
 
173
  repeat
 
174
    if Key^=#0 then exit(true);
 
175
    if Txt^<>Key^ then exit(false);
 
176
    inc(Key);
 
177
    inc(Txt);
 
178
  until false;
 
179
end;
 
180
 
 
181
function GetUTF8String(TxtStart, TxtEnd: PChar): string; inline;
 
182
begin
 
183
  Result:=UTF8CStringToUTF8String(TxtStart,TxtEnd-TxtStart);
 
184
end;
 
185
 
 
186
function ComparePOItems(Item1, Item2: Pointer): Integer;
 
187
begin
 
188
  Result := CompareText(TPOFileItem(Item1).IdentifierLow,
 
189
                        TPOFileItem(Item2).IdentifierLow);
 
190
end;
 
191
 
168
192
function UTF8ToSystemCharSet(const s: string): string; inline;
169
193
begin
170
194
  if SystemCharSetIsUTF8 then
176
200
  {$ENDIF}
177
201
end;
178
202
 
179
 
 
180
203
function StrToPoStr(const s:string):string;
181
204
var
182
205
  SrcPos, DestPos: Integer;
386
409
  end;
387
410
end;
388
411
 
389
 
procedure TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
390
 
  Lang, FallbackLang: string);
 
412
function TranslateUnitResourceStrings(const ResUnitName, BaseFilename,
 
413
  Lang, FallbackLang: string):TTranslateUnitResult;
391
414
begin
392
 
  if (ResUnitName='') or (BaseFilename='') then exit;
393
 
 
394
 
  //debugln('TranslateUnitResourceStrings BaseFilename="',BaseFilename,'"');
395
 
  if (FallbackLang<>'') then
396
 
    TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[FallbackLang]));
397
 
  if (Lang<>'') then
398
 
    TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[Lang]));
 
415
  Result:=turOK;                //Result: OK
 
416
  if (ResUnitName='') or (BaseFilename='') then
 
417
    Result:=turEmptyParam       //Result: empty Parameter
 
418
  else begin
 
419
    //debugln('TranslateUnitResourceStrings BaseFilename="',BaseFilename,'"');
 
420
    if (FallbackLang<>'') and FileExistsUTF8(Format(BaseFilename,[FallbackLang])) then
 
421
      TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[FallbackLang]))
 
422
    else
 
423
      Result:=turNoFBLang;      //Result: missing FallbackLang file
 
424
    if (Lang<>'') and FileExistsUTF8(Format(BaseFilename,[Lang])) then
 
425
      TranslateUnitResourceStrings(ResUnitName,Format(BaseFilename,[Lang]))
 
426
    else
 
427
      Result:=turNoLang;        //Result: missing Lang file
 
428
  end;
399
429
end;
400
430
 
401
431
function TranslateResourceStrings(po: TPOFile): boolean;
449
479
  Module: string;
450
480
  Item,VItem: TPOFileItem;
451
481
  i, p: Integer;
 
482
  VarName: String;
452
483
begin
453
484
  if FModuleList=nil then
454
485
    exit;
456
487
  // remove all module references that were not tagged
457
488
  for i:=FItems.Count-1 downto 0 do begin
458
489
    Item := TPOFileItem(FItems[i]);
459
 
    p := pos('.',Item.Identifier);
 
490
    p := pos('.',Item.IdentifierLow);
460
491
    if P=0 then
461
492
      continue; // module not found (?)
462
493
      
463
 
    Module :=LeftStr(Item.Identifier, p-1);
 
494
    Module :=LeftStr(Item.IdentifierLow, p-1);
464
495
    if (FModuleList.IndexOf(Module)<0) then
465
496
      continue; // module was not modified this time
466
497
 
468
499
      continue; // PO item was updated
469
500
      
470
501
    // this item is not more in updated modules, delete it
471
 
    FIdentifierToItem.Remove(Item.Identifier);
 
502
    FIdentifierLowToItem.Remove(Item.IdentifierLow);
472
503
    // delete it also from VarToItem
473
 
    Module := RightStr(Item.Identifier, Length(Item.Identifier)-P);
474
 
    VItem := TPoFileItem(FIdentVarToItem.Data[Module]);
 
504
    VarName := RightStr(Item.IdentifierLow, Length(Item.IdentifierLow)-P);
 
505
    VItem := TPoFileItem(FIdentLowVarToItem.Data[VarName]);
475
506
    if (VItem=Item) then
476
 
      FIdentVarToItem.Remove(Module);
 
507
      FIdentLowVarToItem.Remove(VarName);
477
508
 
478
 
    //FOriginalToItem.Remove(Item.Original); // isn't this tricky?
 
509
    FOriginalToItem.Remove(Item.Original, Item);
479
510
    FItems.Delete(i);
480
511
    Item.Free;
481
512
  end;
486
517
  inherited Create;
487
518
  FAllEntries:=true;
488
519
  FItems:=TFPList.Create;
489
 
  FIdentifierToItem:=TStringHashList.Create(false);
490
 
  FIdentVarToItem:=TStringHashList.Create(false);
 
520
  FIdentifierLowToItem:=TStringToPointerTree.Create(true);
 
521
  FIdentLowVarToItem:=TStringHashList.Create(true);
491
522
  FOriginalToItem:=TStringHashList.Create(true);
492
523
end;
493
524
 
534
565
  for i:=0 to FItems.Count-1 do
535
566
    TObject(FItems[i]).Free;
536
567
  FItems.Free;
537
 
  FIdentVarToItem.Free;
538
 
  FIdentifierToItem.Free;
 
568
  FIdentLowVarToItem.Free;
 
569
  FIdentifierLowToItem.Free;
539
570
  FOriginalToItem.Free;
540
571
  inherited Destroy;
541
572
end;
549
580
msgstr ""
550
581
 
551
582
}
552
 
const
553
 
  sCommentIdentifier: PChar = '#: ';
554
 
  sCharSetIdentifier: PChar = '"Content-Type: text/plain; charset=';
555
 
  sMsgID: PChar = 'msgid "';
556
 
  sMsgStr: PChar = 'msgstr "';
557
 
  sMsgCtxt: Pchar = 'msgctxt "';
558
 
  sFlags: Pchar = '#, ';
559
 
  sPrevMsgID: PChar = '#| msgid "';
560
 
  sPrevStr: PChar = '#| "';
561
 
 
562
 
const
563
 
  ciNone      = 0;
564
 
  ciMsgID     = 1;
565
 
  ciMsgStr    = 2;
566
 
  ciPrevMsgID = 3;
567
 
  
 
583
type
 
584
  TMsg = (
 
585
    mid,
 
586
    mstr,
 
587
    mctx
 
588
    );
568
589
var
569
590
  l: Integer;
570
591
  LineLen: Integer;
572
593
  LineStart: PChar;
573
594
  LineEnd: PChar;
574
595
  Identifier: String;
575
 
  MsgID,MsgStr,PrevMsgID: String;
576
 
  Line: String;
 
596
  PrevMsgID: String;
577
597
  Comments: String;
578
 
  Context: string;
579
598
  Flags: string;
580
599
  TextEnd: PChar;
581
 
  i, CollectedIndex: Integer;
 
600
  i: Integer;
582
601
  OldLineStartPos: PtrUInt;
583
602
  NewSrc: String;
584
603
  s: String;
585
 
  
 
604
  Handled: Boolean;
 
605
  CurMsg: TMsg;
 
606
  Msg: array[TMsg] of string;
 
607
 
586
608
  procedure ResetVars;
587
609
  begin
588
 
    MsgId := '';
589
 
    MsgStr := '';
590
 
    Line := '';
 
610
    CurMsg:=mid;
 
611
    Msg[mid]:='';
 
612
    Msg[mstr]:='';
 
613
    Msg[mctx]:='';
591
614
    Identifier := '';
592
615
    Comments := '';
593
 
    Context := '';
594
616
    Flags := '';
595
617
    PrevMsgID := '';
596
 
    CollectedIndex := ciNone;
597
618
  end;
598
619
  
599
 
  procedure StoreCollectedLine;
600
 
  begin
601
 
    case CollectedIndex of
602
 
      ciMsgID: MsgID := Line;
603
 
      ciMsgStr: MsgStr := Line;
604
 
      ciPrevMsgID: PrevMsgID := Line;
605
 
    end;
606
 
    CollectedIndex := ciNone;
607
 
  end;
608
 
 
609
620
  procedure AddEntry;
610
621
  var
611
622
    Item: TPOFileItem;
612
623
  begin
613
 
    StoreCollectedLine;
614
624
    if Identifier<>'' then begin
615
625
      // check for unresolved duplicates in po file
616
 
      Item := TPOFileItem(FOriginalToItem.Data[MsgID]);
 
626
      Item := TPOFileItem(FOriginalToItem.Data[Msg[mid]]);
617
627
      if (Item<>nil) then begin
618
628
        // fix old duplicate context
619
629
        if Item.Context='' then
620
 
          Item.Context:=Item.Identifier;
 
630
          Item.Context:=Item.IdentifierLow;
621
631
        // set context of new duplicate
622
 
        if Context='' then
623
 
          Context := Identifier;
 
632
        if Msg[mctx]='' then
 
633
          Msg[mctx] := Identifier;
624
634
        // if old duplicate was translated and
625
635
        // new one is not, provide a initial translation
626
 
        if MsgStr='' then
627
 
          MsgStr := Item.Translation;
 
636
        if Msg[mstr]='' then
 
637
          Msg[mstr] := Item.Translation;
628
638
      end;
629
 
      Add(Identifier,MsgID,MsgStr,Comments,Context,Flags,PrevMsgID);
 
639
      Add(Identifier,Msg[mid],Msg[mstr],Comments,Msg[mctx],Flags,PrevMsgID);
630
640
      ResetVars;
631
641
    end else
632
 
    if (Line<>'') and (FHeader=nil) then begin
633
 
      FHeader := TPOFileItem.Create('',MsgID,Line);
 
642
    if (Msg[CurMsg]<>'') and (FHeader=nil) then begin
 
643
      FHeader := TPOFileItem.Create('',Msg[mid],Msg[CurMsg]);
634
644
      FHeader.Comments:=Comments;
635
645
      ResetVars;
636
646
    end
637
647
  end;
638
648
 
639
 
  function TestPrefixStr(AIndex: Integer): boolean;
640
 
  var
641
 
    s: string;
642
 
    l: Integer;
643
 
  begin
644
 
    case aIndex of
645
 
      ciMsgID: s:=sMsgId;
646
 
      ciMsgStr: s:=sMsgStr;
647
 
      ciPrevMsgId: s:=sPrevMsgId;
648
 
    end;
649
 
    L := Length(s);
650
 
    result := CompareMem(LineStart, pchar(s), L);
651
 
    if Result then begin
652
 
      StoreCollectedLine;
653
 
      CollectedIndex := AIndex;
654
 
      Line:=UTF8CStringToUTF8String(LineStart+L,LineLen-L-1);
655
 
    end;
656
 
  end;
657
 
 
658
649
begin
659
650
  if Txt='' then exit;
660
651
  s:=Txt;
663
654
  LineStart:=p;
664
655
  TextEnd:=p+l;
665
656
 
666
 
  Identifier:='';
667
 
  Comments:='';
668
 
  Line:='';
669
 
  Flags:='';
670
 
  CollectedIndex := ciNone;
 
657
  ResetVars;
671
658
 
672
659
  while LineStart<TextEnd do begin
673
660
    LineEnd:=LineStart;
674
661
    while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
675
662
    LineLen:=LineEnd-LineStart;
676
663
    if LineLen>0 then begin
677
 
      if CompareMem(LineStart,sCommentIdentifier,3) then begin
678
 
        AddEntry;
679
 
        Identifier:=copy(s,LineStart-p+4,LineLen-3);
680
 
        // the RTL creates identifier paths with point instead of colons
681
 
        // fix it:
682
 
        for i:=1 to length(Identifier) do
683
 
          if Identifier[i]=':' then
684
 
            Identifier[i]:='.';
685
 
      end else if TestPrefixStr(ciMsgId) then begin
686
 
      end else if TestPrefixStr(ciMsgStr) then begin
687
 
      end else if TestPrefixStr(ciPrevMsgId) then begin
688
 
      end else if CompareMem(LineStart, sMsgCtxt,9) then begin
689
 
        Context:= Copy(LineStart, 10, LineLen-10);
690
 
      end else if CompareMem(LineStart, sFlags, 3) then begin
691
 
        Flags := copy(LineStart, 4, LineLen-3);
692
 
      end else if (LineStart^='"') then begin
693
 
        if (MsgID='') and CompareMem(LineStart,sCharSetIdentifier,35) then
694
 
        begin
695
 
          FCharSet:=copy(LineStart,36,LineLen-38);
696
 
          if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin
697
 
            // convert encoding to UTF-8
698
 
            OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1;
699
 
            NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)),
700
 
                                    FCharSet,EncodingUTF8);
701
 
            // replace text and update all pointers
702
 
            s:=copy(s,1,OldLineStartPos-1)+NewSrc;
703
 
            l:=length(s);
704
 
            p:=PChar(s);
705
 
            TextEnd:=p+l;
706
 
            LineStart:=p+(OldLineStartPos-1);
707
 
            LineEnd:=LineStart;
708
 
            while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
709
 
            LineLen:=LineEnd-LineStart;
710
 
          end;
711
 
        end;
712
 
        Line := Line + UTF8CStringToUTF8String(LineStart+1,LineLen-2);
713
 
      end else if CompareMem(LineStart, sPrevStr, 4) then begin
714
 
        Line := Line + UTF8CStringToUTF8String(LineStart+5,LineLen-6);
715
 
      end else if LineStart^='#' then begin
716
 
        if Comments<>'' then
717
 
          Comments := Comments + LineEnding;
718
 
        Comments := Comments + Copy(LineStart, 1, LineLen);
719
 
      end else
 
664
      Handled:=false;
 
665
      case LineStart^ of
 
666
      '#':
 
667
        begin
 
668
          case LineStart[1] of
 
669
          ':':
 
670
            if LineStart[2]=' ' then begin
 
671
              // '#: '
 
672
              AddEntry;
 
673
              Identifier:=copy(s,LineStart-p+4,LineLen-3);
 
674
              // the RTL creates identifier paths with point instead of colons
 
675
              // fix it:
 
676
              for i:=1 to length(Identifier) do
 
677
                if Identifier[i]=':' then
 
678
                  Identifier[i]:='.';
 
679
              Handled:=true;
 
680
            end;
 
681
          '|':
 
682
            if IsKey(LineStart,'#| msgid "') then begin
 
683
              PrevMsgID:=PrevMsgID+GetUTF8String(LineStart+length('#| msgid "'),LineEnd-1);
 
684
              Handled:=true;
 
685
            end else if IsKey(LineStart, '#| "') then begin
 
686
              Msg[CurMsg] := Msg[CurMsg] + GetUTF8String(LineStart+length('#| "'),LineEnd-1);
 
687
              Handled:=true;
 
688
            end;
 
689
          ',':
 
690
            if LineStart[2]=' ' then begin
 
691
              // '#, '
 
692
              Flags := GetUTF8String(LineStart+3,LineEnd);
 
693
              Handled:=true;
 
694
            end;
 
695
          end;
 
696
          if not Handled then begin
 
697
            // '#'
 
698
            if Comments<>'' then
 
699
              Comments := Comments + LineEnding;
 
700
            Comments := Comments + GetUTF8String(LineStart+1,LineEnd);
 
701
            Handled:=true;
 
702
          end;
 
703
        end;
 
704
      'm':
 
705
        if (LineStart[1]='s') and (LineStart[2]='g') then begin
 
706
          case LineStart[3] of
 
707
          'i':
 
708
            if IsKey(LineStart,'msgid "') then begin
 
709
              CurMsg:=mid;
 
710
              Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgid "'),LineEnd-1);
 
711
              Handled:=true;
 
712
            end;
 
713
          's':
 
714
            if IsKey(LineStart,'msgstr "') then begin
 
715
              CurMsg:=mstr;
 
716
              Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgstr "'),LineEnd-1);
 
717
              Handled:=true;
 
718
            end;
 
719
          'c':
 
720
            if IsKey(LineStart, 'msgctxt "') then begin
 
721
              CurMsg:=mctx;
 
722
              Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+length('msgctxt "'), LineEnd-1);
 
723
              Handled:=true;
 
724
            end;
 
725
          end;
 
726
        end;
 
727
      '"':
 
728
        begin
 
729
          if (Msg[mid]='')
 
730
          and IsKey(LineStart,'"Content-Type: text/plain; charset=') then
 
731
          begin
 
732
            FCharSet:=GetUTF8String(LineStart+length('"Content-Type: text/plain; charset='),LineEnd);
 
733
            if SysUtils.CompareText(FCharSet,'UTF-8')<>0 then begin
 
734
              // convert encoding to UTF-8
 
735
              OldLineStartPos:=PtrUInt(LineStart-PChar(s))+1;
 
736
              NewSrc:=ConvertEncoding(copy(s,OldLineStartPos,length(s)),
 
737
                                      FCharSet,EncodingUTF8);
 
738
              // replace text and update all pointers
 
739
              s:=copy(s,1,OldLineStartPos-1)+NewSrc;
 
740
              l:=length(s);
 
741
              p:=PChar(s);
 
742
              TextEnd:=p+l;
 
743
              LineStart:=p+(OldLineStartPos-1);
 
744
              LineEnd:=LineStart;
 
745
              while (not (LineEnd^ in [#0,#10,#13])) do inc(LineEnd);
 
746
              LineLen:=LineEnd-LineStart;
 
747
            end;
 
748
          end;
 
749
          // continuation
 
750
          Msg[CurMsg]:=Msg[CurMsg]+GetUTF8String(LineStart+1,LineEnd-1);
 
751
          Handled:=true;
 
752
        end;
 
753
      end;
 
754
      if not Handled then
720
755
        AddEntry;
721
756
    end;
722
757
    LineStart:=LineEnd+1;
723
 
    while (LineStart<TextEnd) and (LineStart^ in [#10,#13]) do inc(LineStart);
 
758
    while (LineStart^ in [#10,#13]) do inc(LineStart);
724
759
  end;
725
760
  AddEntry;
726
761
end;
732
767
  p: Integer;
733
768
begin
734
769
  if (not FAllEntries) and (TranslatedValue='') then exit;
735
 
  Item:=TPOFileItem.Create(Identifier,OriginalValue,TranslatedValue);
 
770
  Item:=TPOFileItem.Create(lowercase(Identifier),OriginalValue,TranslatedValue);
736
771
  Item.Comments:=Comments;
737
772
  Item.Context:=Context;
738
773
  Item.Flags:=Flags;
739
774
  Item.PreviousID:=PreviousID;
740
775
  Item.Tag:=FTag;
741
776
  FItems.Add(Item);
742
 
  
743
 
  //debugln('TPOFile.Add %8x Tag=%d Id="%s" Org="%s" Trn="%s"',
744
 
  //    [ptrint(Item),FTag,Identifier,dbgstr(OriginalValue),dbgstr(TranslatedValue)]);
745
 
  FIdentifierToItem.Add(Identifier,Item);
 
777
 
 
778
  //debugln(['TPOFile.Add Identifier=',Identifier,' Orig="',dbgstr(OriginalValue),'" Transl="',dbgstr(TranslatedValue),'"']);
 
779
  FIdentifierLowToItem[Item.IdentifierLow]:=Item;
746
780
  P := Pos('.', Identifier);
747
781
  if P>0 then
748
 
    FIdentVarToItem.Add(copy(Identifier, P+1, Length(IDentifier)), Item);
749
 
  
750
 
  //if FIdentifierToItem.Data[UpperCase(Identifier)]=nil then raise Exception.Create('');
751
 
  FOriginalToItem.Add(OriginalValue,Item);
752
 
  //if FOriginalToItem.Data[OriginalValue]=nil then raise Exception.Create('');
 
782
    FIdentLowVarToItem.Add(copy(Item.IdentifierLow, P+1, Length(Item.IdentifierLow)), Item);
 
783
 
 
784
  if OriginalValue<>'' then
 
785
    FOriginalToItem.Add(OriginalValue,Item);
753
786
end;
754
787
 
755
788
function TPOFile.Translate(const Identifier, OriginalValue: String): String;
756
789
var
757
790
  Item: TPOFileItem;
758
791
begin
759
 
  Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]);
 
792
  Item:=TPOFileItem(FIdentifierLowToItem[lowercase(Identifier)]);
760
793
  if Item=nil then
761
794
    Item:=TPOFileItem(FOriginalToItem.Data[OriginalValue]);
762
795
  if Item<>nil then begin
778
811
    DebugLn('No header found in po file')
779
812
  else begin
780
813
    DebugLn('Comments=',FHeader.Comments);
781
 
    DebugLn('Identifier=',FHeader.Identifier);
 
814
    DebugLn('Identifier=',FHeader.IdentifierLow);
782
815
    DebugLn('msgid=',FHeader.Original);
783
816
    DebugLn('msgstr=', FHeader.Translation);
784
817
  end;
790
823
    DebugLn('#',dbgs(i),': ');
791
824
    Item := TPOFileItem(FItems[i]);
792
825
    DebugLn('Comments=',Item.Comments);
793
 
    DebugLn('Identifier=',Item.Identifier);
 
826
    DebugLn('Identifier=',Item.IdentifierLow);
794
827
    DebugLn('msgid=',Item.Original);
795
828
    DebugLn('msgstr=', Item.Translation);
796
829
    DebugLn;
829
862
begin
830
863
  ClearModuleList;
831
864
  UntagAll;
832
 
  // for each string in lrt/rst list check if it's already
833
 
  // in PO if not add it
 
865
  // for each string in lrt/rst list check if it's already in PO
 
866
  // if not add it
834
867
  Value := '';
835
868
  Identifier := '';
836
869
  i := 0;
933
966
  RemoveUntaggedModules;
934
967
end;
935
968
 
936
 
procedure TPOFile.RemoveTaggedItems(aTag: Integer);
937
 
var
938
 
  Item: TPOFileItem;
939
 
  i: Integer;
940
 
begin
941
 
  // get rid of all entries that have Tag=aTag
942
 
  for i:=FItems.Count-1 downto 0 do begin
943
 
    Item := TPOFileItem(FItems[i]);
944
 
    if Item.Tag<>aTag then
945
 
      Continue;
946
 
    FIdentifierToItem.Remove(Item.Identifier);
947
 
    //FOriginalToItem.Remove(Item.Original); // isn't this tricky?
948
 
    FItems.Delete(i);
949
 
    Item.Free;
950
 
  end;
951
 
end;
952
 
 
953
 
function ComparePOItems(Item1, Item2: Pointer): Integer;
954
 
begin
955
 
  result := CompareText(TPOFileItem(Item1).Identifier,
956
 
                        TPOFileItem(Item2).Identifier);
957
 
end;
958
 
 
959
 
procedure TPOFile.SaveToFile(const AFilename: string);
960
 
var
961
 
  OutLst: TStringList;
 
969
procedure TPOFile.SaveToStrings(OutLst: TStrings);
 
970
var
962
971
  j: Integer;
963
972
 
964
973
  procedure WriteLst(const AProp, AValue: string );
968
977
  begin
969
978
    if (AValue='') and (AProp='') then
970
979
      exit;
971
 
      
 
980
 
972
981
    FHelperList.Text:=AValue;
973
982
    if FHelperList.Count=1 then begin
974
983
      if AProp='' then OutLst.Add(FHelperList[0])
987
996
      end;
988
997
    end;
989
998
  end;
990
 
  
 
999
 
991
1000
  procedure WriteItem(Item: TPOFileItem);
992
1001
  begin
993
1002
    WriteLst('',Item.Comments);
994
 
    if Item.Identifier<>'' then
995
 
      OutLst.Add('#: '+Item.Identifier);
 
1003
    if Item.IdentifierLow<>'' then
 
1004
      OutLst.Add('#: '+Item.IdentifierLow);
996
1005
    if Trim(Item.Flags)<>'' then
997
1006
      OutLst.Add('#, '+Trim(Item.Flags));
998
1007
    if Item.PreviousID<>'' then
1003
1012
    WriteLst('msgstr', StrToPoStr(Item.Translation));
1004
1013
    OutLst.Add('');
1005
1014
  end;
1006
 
  
 
1015
 
1007
1016
begin
1008
1017
  if FHeader=nil then
1009
1018
    CreateHeader;
1010
 
    
 
1019
 
1011
1020
  if FHelperList=nil then
1012
1021
    FHelperList:=TStringList.Create;
1013
 
    
 
1022
 
 
1023
  // write header
 
1024
  WriteItem(FHeader);
 
1025
 
 
1026
  // Sort list of items by identifier
 
1027
  FItems.Sort(@ComparePOItems);
 
1028
 
 
1029
  for j:=0 to Fitems.Count-1 do
 
1030
    WriteItem(TPOFileItem(FItems[j]));
 
1031
end;
 
1032
 
 
1033
procedure TPOFile.RemoveTaggedItems(aTag: Integer);
 
1034
var
 
1035
  Item: TPOFileItem;
 
1036
  i: Integer;
 
1037
begin
 
1038
  // get rid of all entries that have Tag=aTag
 
1039
  for i:=FItems.Count-1 downto 0 do begin
 
1040
    Item := TPOFileItem(FItems[i]);
 
1041
    if Item.Tag<>aTag then
 
1042
      Continue;
 
1043
    FIdentifierLowToItem.Remove(Item.IdentifierLow);
 
1044
    FOriginalToItem.Remove(Item.Original, Item);
 
1045
    FItems.Delete(i);
 
1046
    Item.Free;
 
1047
  end;
 
1048
end;
 
1049
 
 
1050
procedure TPOFile.SaveToFile(const AFilename: string);
 
1051
var
 
1052
  OutLst: TStringList;
 
1053
begin
1014
1054
  OutLst := TStringList.Create;
1015
1055
  try
1016
 
    // write header
1017
 
    WriteItem(FHeader);
1018
 
    
1019
 
    // Sort list of items by identifier
1020
 
    FItems.Sort(@ComparePOItems);
1021
 
    
1022
 
    for j:=0 to Fitems.Count-1 do
1023
 
      WriteItem(TPOFileItem(FItems[j]));
1024
 
      
1025
 
    //if not DirectoryExistsUTF8(ExtractFileDir(AFilename)) then
1026
 
    //  ForceDirectoriesUTF8(ExtractFileDir(AFilename));
1027
 
      
 
1056
    SaveToStrings(OutLst);
1028
1057
    OutLst.SaveToFile(UTF8ToSys(AFilename));
1029
 
    
1030
1058
  finally
1031
1059
    OutLst.Free;
1032
1060
  end;
1033
 
  
1034
1061
end;
1035
1062
 
1036
1063
function SkipLineEndings(var P: PChar; var DecCount: Integer): Integer;
1095
1122
    FHelperList := TStringList.Create;
1096
1123
 
1097
1124
  // try to find PO entry by identifier
1098
 
  Item:=TPOFileItem(FIdentifierToItem.Data[Identifier]);
 
1125
  Item:=TPOFileItem(FIdentifierLowToItem[lowercase(Identifier)]);
1099
1126
  if Item<>nil then begin
1100
1127
    // found, update item value
1101
 
    AddToModuleList(IDentifier);
 
1128
    AddToModuleList(Identifier);
1102
1129
 
1103
1130
    if CompareMultilinedStrings(Item.Original, Original)<>0 then begin
1104
1131
      FModified := True;
1122
1149
  if Item<>nil then begin
1123
1150
    // old item don't have context, add one
1124
1151
    if Item.Context='' then
1125
 
      Item.Context := Item.Identifier;
 
1152
      Item.Context := Item.IdentifierLow;
1126
1153
      
1127
1154
    // if old item it's already translated use translation
1128
1155
    if Item.Translation<>'' then
1151
1178
  ClearModuleList;
1152
1179
  for i:=0 to BasePOFile.Items.Count-1 do begin
1153
1180
    Item := TPOFileItem(BasePOFile.Items[i]);
1154
 
    UpdateItem(Item.Identifier, Item.Original);
 
1181
    UpdateItem(Item.IdentifierLow, Item.Original);
1155
1182
  end;
1156
1183
  RemoveTaggedItems(0); // get rid of any item not existing in BasePOFile
1157
1184
end;
1188
1215
 
1189
1216
{ TPOFileItem }
1190
1217
 
1191
 
constructor TPOFileItem.Create(const TheIdentifier, TheOriginal,
 
1218
constructor TPOFileItem.Create(const TheIdentifierLow, TheOriginal,
1192
1219
  TheTranslated: string);
1193
1220
begin
1194
 
  Identifier:=TheIdentifier;
 
1221
  IdentifierLow:=TheIdentifierLow;
1195
1222
  Original:=TheOriginal;
1196
1223
  Translation:=TheTranslated;
1197
1224
end;