← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/codetools/sourcelog.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
http://bugs.debian.org/708695
[ 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:
components/codetools/sourcelog.pas
36
36
  {$IFDEF MEM_CHECK}
37
37
  MemCheck,
38
38
  {$ENDIF}
39
 
  Classes, SysUtils, FileProcs;
 
39
  Classes, SysUtils, FileProcs, LazUTF8, lazutf8classes;
40
40
 
41
41
type
42
42
  TSourceLog = class;
110
110
    FOnMove: TOnSourceLogMove;
111
111
    FChangeHooks: {$ifdef fpc}^{$else}array of {$endif}TOnSourceChange;
112
112
    FChangeHookCount: integer;
 
113
    FChangeHookDelayed: boolean;
113
114
    FSource: string;
114
115
    FChangeStep: integer;
115
116
    FReadOnly: boolean;
123
124
    procedure SetReadOnly(const Value: boolean);
124
125
    function IndexOfChangeHook(AChangeHook: TOnSourceChange): integer;
125
126
  protected
126
 
    procedure IncreaseChangeStep; virtual;
 
127
    procedure IncreaseChangeStep; virtual; // any change
 
128
    procedure DoSourceChanged; virtual; // source change
127
129
    procedure DecodeLoaded(const AFilename: string;
128
130
                        var ASource, ADiskEncoding, AMemEncoding: string); virtual;
129
131
    procedure EncodeSaving(const AFilename: string; var ASource: string); virtual;
130
132
  public
131
133
    Data: Pointer;
 
134
    LastError: string;
132
135
    function LineCount: integer;
133
136
    function GetLine(Index: integer): string; // 0-based
134
137
    function GetLineLength(Index: integer): integer; // 0-based
135
138
    procedure GetLineRange(Index: integer; out LineRange: TLineRange);
 
139
    function GetLineStart(Index: integer): integer;
136
140
    property Items[Index: integer]: TSourceLogEntry
137
141
       read GetItems write SetItems; default;
138
142
    function Count: integer; // # Items
139
143
    property SourceLength: integer read fSrcLen;
140
 
    procedure ClearEntries;
 
144
    function ClearEntries: boolean;
141
145
    property ChangeStep: integer read FChangeStep;
142
146
    property Markers[Index: integer]: TSourceLogMarker read GetMarkers;
143
147
    function MarkerCount: integer;
154
158
    procedure AbsoluteToLineCol(Position: integer; out Line, Column: integer);
155
159
    function LineColIsOutside(Line, Column: integer): boolean;
156
160
    function LineColIsSpace(Line, Column: integer): boolean;
 
161
    function AbsoluteToLineColStr(Position: integer): string;
157
162
    procedure Insert(Pos: integer; const Txt: string);
158
163
    procedure Delete(Pos, Len: integer);
159
164
    procedure Replace(Pos, Len: integer; const Txt: string);
162
167
    function SaveToFile(const Filename: string): boolean; virtual;
163
168
    function GetLines(StartLine, EndLine: integer): string;
164
169
    function IsEqual(sl: TStrings): boolean;
 
170
    function OldIsEqual(sl: TStrings): boolean;
165
171
    procedure Assign(sl: TStrings);
166
172
    procedure AssignTo(sl: TStrings; UseAddStrings: Boolean);
167
 
    procedure LoadFromStream(s: TStream);
168
 
    procedure SaveToStream(s: TStream);
 
173
    procedure LoadFromStream(aStream: TStream);
 
174
    procedure SaveToStream(aStream: TStream);
169
175
    property ReadOnly: boolean read FReadOnly write SetReadOnly;
170
176
    property DiskEncoding: string read FDiskEncoding write FDiskEncoding;
171
177
    property MemEncoding: string read FMemEncoding write FMemEncoding;
364
370
    if Index<fLineCount-1 then
365
371
      LineLen:=fLineRanges[Index+1].StartPos-fLineRanges[Index].StartPos
366
372
    else
367
 
      LineLen:=fSrcLen-fLineRanges[Index].StartPos;
 
373
      LineLen:=fSrcLen-fLineRanges[Index].StartPos+1;
368
374
    SetLength(Result,LineLen);
369
375
    if LineLen>0 then
370
376
      System.Move(fSource[fLineRanges[Index].StartPos],Result[1],LineLen);
387
393
  LineRange:=FLineRanges[Index];
388
394
end;
389
395
 
390
 
procedure TSourceLog.ClearEntries;
 
396
function TSourceLog.GetLineStart(Index: integer): integer;
 
397
begin
 
398
  BuildLineRanges;
 
399
  if Index<FLineCount then
 
400
    Result:=FLineRanges[Index].StartPos
 
401
  else
 
402
    Result:=FSrcLen;
 
403
end;
 
404
 
 
405
function TSourceLog.ClearEntries: boolean;
391
406
var i: integer;
392
407
begin
 
408
  if (Count=0) and (FLog.Count=0) then exit(false);
 
409
  Result:=true;
393
410
  for i:=0 to Count-1 do Items[i].Free;
394
411
  FLog.Clear;
395
412
end;
397
414
procedure TSourceLog.Clear;
398
415
var i: integer;
399
416
  m: TSourceLogMarker;
 
417
  SourceChanged: Boolean;
400
418
begin
401
 
  ClearEntries;
 
419
  ClearEntries; // ignore if entries change
402
420
  // markers are owned by someone else, do not free them
403
421
  for i:=0 to FMarkers.Count-1 do begin
404
422
    m:=Markers[i];
405
423
    if m.Position>1 then
406
424
      m.Deleted:=true;
407
425
  end;
 
426
  SourceChanged:=FSource<>'';
408
427
  FSource:='';
409
428
  FSrcLen:=0;
410
429
  FModified:=false;
413
432
    FLineRanges:=nil;
414
433
  end;
415
434
  FLineCount:=-1;
416
 
  IncreaseChangeStep;
417
435
  Data:=nil;
418
436
  FReadOnly:=false;
 
437
  IncreaseChangeStep;
 
438
  if SourceChanged then
 
439
    DoSourceChanged;
419
440
  NotifyHooks(nil);
420
441
end;
421
442
 
447
468
procedure TSourceLog.NotifyHooks(Entry: TSourceLogEntry);
448
469
var i: integer;
449
470
begin
450
 
  if (FChangeHooks=nil) or (FChangeHookLock>0) then exit;
 
471
  if (FChangeHooks=nil) or (FChangeHookLock>0) then begin
 
472
    FChangeHookDelayed:=true;
 
473
    exit;
 
474
  end;
 
475
  FChangeHookDelayed:=false;
451
476
  for i:=0 to FChangeHookCount-1 do
452
477
    FChangeHooks[i](Self,Entry);
453
478
end;
461
486
begin
462
487
  if FChangeHookLock<=0 then exit;
463
488
  dec(FChangeHookLock);
464
 
  if FChangeHookLock=0 then NotifyHooks(nil);
 
489
  if (FChangeHookLock=0) and FChangeHookDelayed then
 
490
    NotifyHooks(nil);
465
491
end;
466
492
 
467
493
procedure TSourceLog.SetSource(const NewSrc: string);
475
501
      FSrcLen:=length(FSource);
476
502
      FLineCount:=-1;
477
503
      FReadOnly:=false;
 
504
      DoSourceChanged;
478
505
    finally
479
506
      dec(FChangeHookLock);
480
507
    end;
501
528
      NewSrcLogEntry.AdjustPosition(Markers[i].NewPosition);
502
529
  end;
503
530
  FModified:=true;
504
 
  IncreaseChangeStep;
 
531
  DoSourceChanged;
505
532
end;
506
533
 
507
534
procedure TSourceLog.Delete(Pos, Len: integer);
526
553
    end;
527
554
  end;
528
555
  FModified:=true;
529
 
  IncreaseChangeStep;
 
556
  DoSourceChanged;
530
557
end;
531
558
 
532
559
procedure TSourceLog.Replace(Pos, Len: integer; const Txt: string);
563
590
    end;
564
591
  end;
565
592
  FModified:=true;
566
 
  IncreaseChangeStep;
 
593
  DoSourceChanged;
567
594
end;
568
595
 
569
596
procedure TSourceLog.Move(Pos, Len, MoveTo: integer);
593
620
      NewSrcLogEntry.AdjustPosition(Markers[i].NewPosition);
594
621
  end;
595
622
  FModified:=true;
596
 
  IncreaseChangeStep;
 
623
  DoSourceChanged;
597
624
end;
598
625
 
599
626
function TSourceLog.AddMarker(Position: integer; SomeData: Pointer
652
679
  SrcStart:=PChar(FSource);
653
680
  SrcEnd:=SrcStart+FSrcLen;
654
681
  p:=SrcStart;
655
 
  while (p<SrcEnd) do begin
 
682
  repeat
656
683
    if (not (p^ in [#10,#13])) then begin
 
684
      if (p^=#0) and (p>=SrcEnd) then break;
657
685
      inc(p);
658
686
    end else begin
659
687
      // new line
669
697
        inc(p);
670
698
      FLineRanges[line].StartPos:=p-SrcStart+1;
671
699
    end;
672
 
  end;
 
700
  until false;
673
701
  FLineRanges[line].EndPos:=fSrcLen+1;
674
702
  FLineCount:=line;
675
703
  if not (FSource[FSrcLen] in [#10,#13]) then
773
801
  if (Column>1) and (p[Column-2]>' ') then exit(false);
774
802
end;
775
803
 
 
804
function TSourceLog.AbsoluteToLineColStr(Position: integer): string;
 
805
var
 
806
  Line: integer;
 
807
  Column: integer;
 
808
begin
 
809
  AbsoluteToLineCol(Position,Line,Column);
 
810
  Result:='p='+IntToStr(Position)+',line='+IntToStr(Line)+',col='+IntToStr(Column);
 
811
end;
 
812
 
776
813
function TSourceLog.LoadFromFile(const Filename: string): boolean;
777
814
var
778
815
  s: string;
779
 
  fs: TFileStream;
 
816
  fs: TFileStreamUTF8;
780
817
  p: Integer;
781
818
begin
782
 
  Result := True;
 
819
  Result := False;
 
820
  LastError:='';
783
821
  try
784
 
    fs := TFileStream.Create(UTF8ToSys(Filename), fmOpenRead or fmShareDenyNone);
 
822
    fs := TFileStreamUTF8.Create(Filename, fmOpenRead or fmShareDenyNone);
785
823
    try
786
824
      SetLength(s, fs.Size);
787
825
      if s <> '' then
807
845
    finally
808
846
      fs.Free;
809
847
    end;
 
848
    Result := True;
810
849
  except
811
 
    Result := False;
 
850
    on E: Exception do
 
851
      LastError:=E.Message;
812
852
  end;
813
853
end;
814
854
 
821
861
  //DebugLn('[TSourceLog.IncreaseChangeStep] ',FChangeStep,',',DbgS(Self));
822
862
end;
823
863
 
 
864
procedure TSourceLog.DoSourceChanged;
 
865
begin
 
866
  IncreaseChangeStep;
 
867
  //debugln(['TSourceLog.DoSourceChanged ']);
 
868
end;
 
869
 
824
870
function TSourceLog.SaveToFile(const Filename: string): boolean;
825
871
var 
826
 
  fs: TFileStream;
827
 
  TheFilename: String;
 
872
  fs: TFileStreamUTF8;
828
873
  s: String;
829
874
begin
830
875
  {$IFDEF VerboseCTSave}
831
876
  DebugLn(['TSourceLog.SaveToFile Self=',DbgS(Self),' ',Filename,' Size=',length(Source)]);
832
877
  CTDumpStack;
833
878
  {$ENDIF}
834
 
  Result := True;
 
879
  Result := False;
 
880
  LastError:='';
835
881
  try
836
882
    // keep filename case on disk
837
 
    TheFilename := FindDiskFilename(Filename);
838
 
    if FileExistsUTF8(TheFilename) then
839
 
    begin
840
 
      InvalidateFileStateCache(TheFilename);
841
 
      fs := TFileStream.Create(UTF8ToSys(TheFilename), fmOpenWrite or fmShareDenyNone);
 
883
    if FileExistsUTF8(Filename) then begin
 
884
      InvalidateFileStateCache(Filename);
 
885
      fs := TFileStreamUTF8.Create(Filename, fmOpenWrite or fmShareDenyNone);
842
886
      fs.Size := 0;
843
 
    end
844
 
    else begin
 
887
    end else begin
845
888
      InvalidateFileStateCache; // invalidate all (samba shares)
846
 
      fs := TFileStream.Create(UTF8ToSys(TheFilename), fmCreate);
 
889
      fs := TFileStreamUTF8.Create(Filename, fmCreate);
847
890
    end;
848
891
    try
849
892
      s := Source;
857
900
    finally
858
901
      fs.Free;
859
902
    end;
 
903
    Result := True;
860
904
  except
861
 
    Result := False;
 
905
    on E: Exception do
 
906
      LastError:=E.Message;
862
907
  end;
863
908
end;
864
909
 
883
928
end;
884
929
 
885
930
function TSourceLog.IsEqual(sl: TStrings): boolean;
 
931
var
 
932
  p: PChar;
 
933
  Line: String;
 
934
  l: PChar;
 
935
  y: Integer;
 
936
begin
 
937
  Result:=false;
 
938
  if sl=nil then exit;
 
939
  if (FSrcLen=0) and (sl.Count>0) then exit;
 
940
  if (FLineCount>=0) and (sl.Count<>FLineCount) then exit;
 
941
  p:=PChar(FSource);
 
942
  y:=0;
 
943
  while (y<sl.Count) do begin
 
944
    Line:=sl[y];
 
945
    if (Line<>'') then begin
 
946
      l:=PChar(Line);
 
947
      while (l^=p^) do begin
 
948
        if (l^=#0) then begin
 
949
          if l-PChar(Line)=length(Line) then begin
 
950
            // end of Line
 
951
            if (p-PChar(FSource)=FSrcLen) then begin
 
952
              // end of source
 
953
              Result:=y=sl.Count-1;
 
954
              exit;
 
955
            end;
 
956
            break;
 
957
          end else if p-PChar(FSource)=FSrcLen then begin
 
958
            // not at end of Line, end of source
 
959
            exit;
 
960
          end;
 
961
        end;
 
962
        inc(p);
 
963
        inc(l);
 
964
      end;
 
965
      if l^<>#0 then exit;
 
966
    end;
 
967
    // at end of Line
 
968
    if not (p^ in [#10,#13]) then begin
 
969
      // not between two lines in Source
 
970
      Result:=(y=sl.Count-1) and (p-PChar(FSource)=FSrcLen);
 
971
      exit;
 
972
    end;
 
973
    // skip line end
 
974
    if (p[1] in [#10,#13]) and (p^<>p[1]) then
 
975
      inc(p,2)
 
976
    else
 
977
      inc(p);
 
978
    inc(y);
 
979
  end;
 
980
  Result:=p-PChar(FSource)=FSrcLen;
 
981
end;
 
982
 
 
983
function TSourceLog.OldIsEqual(sl: TStrings): boolean;
886
984
var x,y,p,LineLen: integer;
887
985
  Line: string;
888
986
begin
916
1014
  if sl=nil then exit;
917
1015
  if IsEqual(sl) then exit;
918
1016
  IncreaseHookLock;
919
 
  Clear;
920
 
  fSource := sl.Text;
921
 
  fSrcLen := Length(fSource);
922
 
  DecreaseHookLock;
 
1017
  try
 
1018
    Clear;
 
1019
    fSource := sl.Text;
 
1020
    fSrcLen := Length(fSource);
 
1021
    DoSourceChanged;
 
1022
    NotifyHooks(nil);
 
1023
  finally
 
1024
    DecreaseHookLock;
 
1025
  end;
923
1026
end;
924
1027
 
925
1028
procedure TSourceLog.AssignTo(sl: TStrings; UseAddStrings: Boolean);
953
1056
  end;
954
1057
end;
955
1058
 
956
 
procedure TSourceLog.LoadFromStream(s: TStream);
 
1059
procedure TSourceLog.LoadFromStream(aStream: TStream);
 
1060
var
 
1061
  NewSrcLen: integer;
 
1062
  NewSource: String;
957
1063
begin
958
1064
  IncreaseHookLock;
959
 
  Clear;
960
 
  if s=nil then exit;
961
 
  s.Position:=0;
962
 
  fSrcLen:=s.Size-s.Position;
963
 
  if fSrcLen>0 then begin
964
 
    SetLength(fSource,fSrcLen);
965
 
    s.Read(fSource[1],fSrcLen);
 
1065
  try
 
1066
    if aStream=nil then exit;
 
1067
    aStream.Position:=0;
 
1068
    NewSrcLen:=aStream.Size-aStream.Position;
 
1069
    NewSource:='';
 
1070
    if NewSrcLen>0 then begin
 
1071
      SetLength(NewSource,NewSrcLen);
 
1072
      aStream.Read(NewSource[1],NewSrcLen);
 
1073
    end;
 
1074
    Source:=NewSource;
 
1075
  finally
 
1076
    DecreaseHookLock;
966
1077
  end;
967
 
  fLineCount:=-1;
968
 
  DecreaseHookLock;
969
1078
end;
970
1079
 
971
 
procedure TSourceLog.SaveToStream(s: TStream);
 
1080
procedure TSourceLog.SaveToStream(aStream: TStream);
972
1081
begin
973
 
  if fSource<>'' then s.Write(fSource[1],fSrcLen);
 
1082
  if fSource<>'' then aStream.Write(fSource[1],fSrcLen);
974
1083
end;
975
1084
 
976
1085
procedure TSourceLog.SetReadOnly(const Value: boolean);