mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-24 20:59:29 +02:00
TTextStrings improvements (Exchange, Put), clean ups
git-svn-id: trunk@6293 -
This commit is contained in:
mattias
parent
784cf31d12
commit
ff0abfca3e
@ -1753,7 +1753,7 @@ end;
|
||||
|
||||
procedure TDebugManager.ProcessCommand(Command: word; var Handled: boolean);
|
||||
begin
|
||||
debugln('TDebugManager.ProcessCommand ',dbgs(Command));
|
||||
//debugln('TDebugManager.ProcessCommand ',dbgs(Command));
|
||||
Handled:=true;
|
||||
case Command of
|
||||
ecPause: DoPauseProject;
|
||||
@ -1941,6 +1941,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.79 2004/11/24 08:18:13 mattias
|
||||
TTextStrings improvements (Exchange, Put), clean ups
|
||||
|
||||
Revision 1.78 2004/11/23 11:01:10 mattias
|
||||
added key handling for debug manager
|
||||
|
||||
|
||||
10
ide/main.pp
10
ide/main.pp
@ -238,6 +238,7 @@ type
|
||||
procedure mnuConfigBuildFileClicked(Sender: TObject);
|
||||
|
||||
// components menu
|
||||
// see pkgmanager.pas
|
||||
|
||||
// tools menu
|
||||
procedure mnuToolConfigureClicked(Sender: TObject);
|
||||
@ -264,7 +265,7 @@ type
|
||||
// windows menu
|
||||
|
||||
// help menu
|
||||
// see HelpManager.pas
|
||||
// see helpmanager.pas
|
||||
|
||||
procedure OpenFileDownArrowClicked(Sender: TObject);
|
||||
procedure mnuOpenFilePopupClick(Sender: TObject);
|
||||
@ -323,7 +324,8 @@ type
|
||||
procedure OnPropHookGetMethods(TypeData:PTypeData; Proc:TGetStringProc);
|
||||
function OnPropHookMethodExists(const AMethodName:ShortString;
|
||||
TypeData: PTypeData;
|
||||
var MethodIsCompatible,MethodIsPublished,IdentIsMethod: boolean):boolean;
|
||||
var MethodIsCompatible, MethodIsPublished,
|
||||
IdentIsMethod: boolean): boolean;
|
||||
function OnPropHookCreateMethod(const AMethodName:ShortString;
|
||||
ATypeInfo:PTypeInfo): TMethod;
|
||||
procedure OnPropHookShowMethod(const AMethodName:ShortString);
|
||||
@ -5353,6 +5355,7 @@ Begin
|
||||
ProjectDesc.CreateStartFiles(Project1);
|
||||
|
||||
// rebuild codetools defines
|
||||
RescanCompilerDefines(true);
|
||||
// (i.e. remove old project specific things and create new)
|
||||
IncreaseCompilerParseStamp;
|
||||
Project1.DefineTemplates.AllChanged;
|
||||
@ -10962,6 +10965,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.798 2004/11/24 08:18:13 mattias
|
||||
TTextStrings improvements (Exchange, Put), clean ups
|
||||
|
||||
Revision 1.797 2004/11/23 11:01:10 mattias
|
||||
added key handling for debug manager
|
||||
|
||||
|
||||
@ -44,7 +44,7 @@ type
|
||||
function GetCount: integer; virtual; abstract;
|
||||
function GetItems(Index: integer): TNewIDEItemTemplate; virtual; abstract;
|
||||
public
|
||||
constructor Create(const AName: string); virtual; {$IFNDEF VER1_0}abstract;{$ENDIF}
|
||||
constructor Create(const AName: string); virtual;
|
||||
procedure Clear; virtual; abstract;
|
||||
procedure Add(ATemplate: TNewIDEItemTemplate); virtual; abstract;
|
||||
function LocalizedName: string; virtual; abstract;
|
||||
@ -131,16 +131,13 @@ begin
|
||||
NewIDEItems.UnregisterItem(NewItem);
|
||||
end;
|
||||
|
||||
{ TNewIDEItemCategory }
|
||||
|
||||
{$IFDEF VER1_0}
|
||||
constructor TNewIDEItemCategory.Create(const AName: string);
|
||||
//fpc 1.0 doesn't support virtual abstract constructors,
|
||||
//so we just make it virtual
|
||||
|
||||
{ TNewIDEItemCategory }
|
||||
constructor TNewIDEItemCategory.Create(const AName: string);
|
||||
begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{ TNewIDEItemTemplate }
|
||||
|
||||
|
||||
@ -26,13 +26,9 @@
|
||||
UNDER CONSTRUCTION by Mattias Gaertner
|
||||
|
||||
ToDo:
|
||||
- Exchange
|
||||
- Put
|
||||
- Sort
|
||||
- CustomSort
|
||||
- Find
|
||||
- Index
|
||||
- Add
|
||||
- Move
|
||||
- IndexOf
|
||||
}
|
||||
unit TextStrings;
|
||||
|
||||
@ -50,7 +46,7 @@ type
|
||||
StartPos: integer; // start of line in Text
|
||||
EndPos: integer; // end of line in Text (= start of newline character(s))
|
||||
Line: string; // cached line as string
|
||||
TheObject: TObject;
|
||||
TheObject: TObject; // user data
|
||||
end;
|
||||
|
||||
TTextStrings = class(TStrings)
|
||||
@ -64,6 +60,7 @@ type
|
||||
FLineRanges: ^TTextLineRange;// array of TTextLineRange
|
||||
FText: string;
|
||||
FUpdateCount: integer;
|
||||
FChangedWhileUpdate: boolean;
|
||||
function GetTextStr: string; override;
|
||||
procedure SetTextStr(const AValue: string); override;
|
||||
procedure BuildArrays; virtual;
|
||||
@ -73,6 +70,7 @@ type
|
||||
function Get(Index: Integer): string; override;
|
||||
procedure ClearArrays;
|
||||
function GetObject(Index: Integer): TObject; override;
|
||||
procedure Put(Index: Integer; const S: string); override;
|
||||
procedure PutObject(Index: Integer; AnObject: TObject); override;
|
||||
function GetLineLen(Index: integer; IncludeNewLineChars: boolean): integer;
|
||||
public
|
||||
@ -82,7 +80,14 @@ type
|
||||
procedure Insert(Index: Integer; const S: string); override;
|
||||
procedure Delete(Index: Integer); override;
|
||||
procedure Exchange(Index1, Index2: Integer); override;
|
||||
procedure Move(CurIndex, NewIndex: Integer); override;
|
||||
procedure MakeTextBufferUnique;
|
||||
procedure BeginUpdate;
|
||||
procedure EndUpdate;
|
||||
function GetText: PChar; override;
|
||||
function IndexOf(const S: string): Integer; override;
|
||||
function Add(const S: string): Integer; override;
|
||||
procedure AddStrings(TheStrings: TStrings); override;
|
||||
public
|
||||
property Text: string read FText write SetTextStr;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
@ -167,8 +172,12 @@ begin
|
||||
end;
|
||||
|
||||
procedure TTextStrings.Changed;
|
||||
// called after text changed
|
||||
begin
|
||||
if (FUpdateCount=0) then
|
||||
if (FUpdateCount>0) then begin
|
||||
FChangedWhileUpdate:=true;
|
||||
exit;
|
||||
end;
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
@ -215,6 +224,48 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TTextStrings.Put(Index: Integer; const S: string);
|
||||
var
|
||||
OldLineLen: Integer;
|
||||
NewLineLen: Integer;
|
||||
Movement: Integer;
|
||||
OldStartPos: LongInt;
|
||||
OldEndPos: LongInt;
|
||||
MoveLen: Integer;
|
||||
i: Integer;
|
||||
NewEndPos: Integer;
|
||||
begin
|
||||
if not FArraysValid then BuildArrays;
|
||||
OldStartPos:=FLineRanges[Index].StartPos;
|
||||
OldEndPos:=FLineRanges[Index].EndPos;
|
||||
NewLineLen:=length(s);
|
||||
OldLineLen:=OldEndPos-OldStartPos;
|
||||
Movement:=NewLineLen-OldLineLen;
|
||||
NewEndPos:=OldEndPos+Movement;
|
||||
// move text behind
|
||||
MoveLen:=length(FText)-OldEndPos;
|
||||
if (Movement<>0) and (MoveLen>0) then begin
|
||||
SetLength(FText,length(FText)+Movement);
|
||||
System.Move(FText[OldEndPos],FText[NewEndPos],MoveLen);
|
||||
for i:=Index+1 to FLineCount-1 do begin
|
||||
inc(FLineRanges[i].StartPos,Movement);
|
||||
inc(FLineRanges[i].EndPos,Movement);
|
||||
end;
|
||||
end;
|
||||
FLineRanges[Index].EndPos:=NewEndPos;
|
||||
// copy text
|
||||
if NewLineLen>0 then
|
||||
System.Move(S[1],FText[OldStartPos],NewLineLen);
|
||||
FLineRanges[Index].Line:=S;
|
||||
// check if arrays need rebuild
|
||||
i:=NewLineLen;
|
||||
while (i>0) and (not (S[i] in [#10,#13])) do dec(i);
|
||||
if i>0 then begin
|
||||
// S contains new line chars => rebuild needed
|
||||
FArraysValid:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTextStrings.PutObject(Index: Integer; AnObject: TObject);
|
||||
begin
|
||||
if not FArraysValid then BuildArrays;
|
||||
@ -262,23 +313,29 @@ var
|
||||
NewLineCharCount: Integer;
|
||||
NewLineLen: Integer;
|
||||
i: Integer;
|
||||
SEndsInNewLine: boolean;
|
||||
begin
|
||||
if not FArraysValid then BuildArrays;
|
||||
NewLineLen:=length(S);
|
||||
SEndsInNewLine:=(S<>'') and (S[NewLineLen] in [#10,#13]);
|
||||
if Index<FLineCount then
|
||||
NewStartPos:=FLineRanges[Index].StartPos
|
||||
else
|
||||
NewStartPos:=length(FText);
|
||||
NewLineCharCount:=0;
|
||||
if (NewLineLen>0) and (S[NewLineLen] in [#10,#13]) then begin
|
||||
if SEndsInNewLine then begin
|
||||
inc(NewLineCharCount);
|
||||
if (NewLineLen>1)
|
||||
and (S[NewLineLen-1] in [#10,#13])
|
||||
and (S[NewLineLen-1]<>S[NewLineLen]) then
|
||||
inc(NewLineCharCount);
|
||||
end;
|
||||
// adjust text
|
||||
System.Insert(S,FText,NewStartPos);
|
||||
end else begin
|
||||
// append missing newline char
|
||||
System.Insert(S+LineEnding,FText,NewStartPos);
|
||||
NewLineCharCount:=length(LineEnding);
|
||||
inc(NewLineLen,NewLineCharCount);
|
||||
end;
|
||||
// adjust arrays
|
||||
if FLineCount=FLineCapacity then begin
|
||||
if FLineCapacity<8 then
|
||||
@ -327,19 +384,113 @@ begin
|
||||
end;
|
||||
|
||||
procedure TTextStrings.Exchange(Index1, Index2: Integer);
|
||||
|
||||
procedure RaiseIndex1Neg;
|
||||
begin
|
||||
raise Exception.Create('TTextStrings.Exchange Index1<=0');
|
||||
end;
|
||||
|
||||
procedure RaiseIndex2Neg;
|
||||
begin
|
||||
raise Exception.Create('TTextStrings.Exchange Index2<=0');
|
||||
end;
|
||||
|
||||
procedure RaiseIndex1Big;
|
||||
begin
|
||||
raise Exception.Create('TTextStrings.Exchange Index1>=FLineCount');
|
||||
end;
|
||||
|
||||
procedure RaiseIndex2Big;
|
||||
begin
|
||||
raise Exception.Create('TTextStrings.Exchange Index2>=FLineCount');
|
||||
end;
|
||||
|
||||
var
|
||||
LineLen1: Integer;
|
||||
LineLen2: Integer;
|
||||
buf: Pointer;
|
||||
Dummy: Integer;
|
||||
OldBetweenStart: Integer;
|
||||
NewBetweenStart: Integer;
|
||||
BetweenLength: Integer;
|
||||
StartPos1: LongInt;
|
||||
StartPos2: LongInt;
|
||||
DummyRange: TTextLineRange;
|
||||
i: Integer;
|
||||
Movement: Integer;
|
||||
begin
|
||||
// check values
|
||||
if Index1=Index2 then exit;
|
||||
if Index1<=0 then RaiseIndex1Neg;
|
||||
if Index2<=0 then RaiseIndex2Neg;
|
||||
if Index1>=FLineCount then RaiseIndex1Big;
|
||||
if Index2>=FLineCount then RaiseIndex2Big;
|
||||
|
||||
// make sure Index1<Index2
|
||||
if Index1>Index2 then begin
|
||||
Dummy:=Index1;
|
||||
Index1:=Index2;
|
||||
Index2:=Dummy;
|
||||
end;
|
||||
|
||||
// get line lengths including new line chars
|
||||
if not FArraysValid then BuildArrays;
|
||||
LineLen1:=GetLineLen(Index1,true);
|
||||
LineLen2:=GetLineLen(Index2,true);
|
||||
if (LineLen1<1) and (LineLen2<1) then exit;
|
||||
|
||||
// adjust text
|
||||
MakeTextBufferUnique;
|
||||
|
||||
// save the bigger line
|
||||
StartPos1:=FLineRanges[Index1].StartPos;
|
||||
StartPos2:=FLineRanges[Index2].StartPos;
|
||||
if LineLen1>=LineLen2 then begin
|
||||
GetMem(buf,LineLen1);
|
||||
System.Move(FText[StartPos1],buf^,LineLen1);
|
||||
end else begin
|
||||
GetMem(buf,LineLen2);
|
||||
System.Move(FText[StartPos2],buf^,LineLen2);
|
||||
end;
|
||||
|
||||
// move text in between
|
||||
OldBetweenStart:=StartPos1+LineLen1;
|
||||
BetweenLength:=StartPos2-OldBetweenStart;
|
||||
NewBetweenStart:=StartPos1+LineLen2;
|
||||
if (BetweenLength>0) and (OldBetweenStart<>NewBetweenStart) then
|
||||
System.Move(FText[OldBetweenStart],FText[NewBetweenStart],BetweenLength);
|
||||
|
||||
// move both lines
|
||||
if LineLen1>=LineLen2 then begin
|
||||
System.Move(FText[StartPos2],FText[StartPos1],LineLen2);
|
||||
System.Move(buf^,FText[StartPos2],LineLen1);
|
||||
end else begin
|
||||
System.Move(FText[StartPos1],FText[StartPos2],LineLen1);
|
||||
System.Move(buf^,FText[StartPos1],LineLen2);
|
||||
end;
|
||||
|
||||
// adjust line ranges
|
||||
if LineLen1<>LineLen2 then begin
|
||||
System.Move(FLineRanges[Index1],DummyRange,SizeOf(TTextLineRange));
|
||||
System.Move(FLineRanges[Index2],FLineRanges[Index1],SizeOf(TTextLineRange));
|
||||
System.Move(DummyRange,FLineRanges[Index2],SizeOf(TTextLineRange));
|
||||
if (BetweenLength>0) and (OldBetweenStart<>NewBetweenStart) then begin
|
||||
Movement:=NewBetweenStart-OldBetweenStart;
|
||||
for i:=Index1+1 to Index2-1 do begin
|
||||
inc(FLineRanges[i].StartPos,Movement);
|
||||
inc(FLineRanges[i].EndPos,Movement);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// clean up
|
||||
FreeMem(buf);
|
||||
end;
|
||||
|
||||
procedure TTextStrings.Move(CurIndex, NewIndex: Integer);
|
||||
begin
|
||||
// TODO
|
||||
inherited Move(CurIndex, NewIndex);
|
||||
end;
|
||||
|
||||
procedure TTextStrings.MakeTextBufferUnique;
|
||||
@ -348,5 +499,49 @@ begin
|
||||
UniqueString(FText);
|
||||
end;
|
||||
|
||||
procedure TTextStrings.BeginUpdate;
|
||||
begin
|
||||
inc(FUpdateCount);
|
||||
end;
|
||||
|
||||
procedure TTextStrings.EndUpdate;
|
||||
begin
|
||||
if FUpdateCount<=0 then
|
||||
raise Exception.Create('TTextStrings.EndUpdate');
|
||||
dec(FUpdateCount);
|
||||
if FUpdateCount=0 then begin
|
||||
if FChangedWhileUpdate then
|
||||
Changed;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTextStrings.GetText: PChar;
|
||||
begin
|
||||
Result:=PChar(FText);
|
||||
end;
|
||||
|
||||
function TTextStrings.IndexOf(const S: string): Integer;
|
||||
begin
|
||||
// TODO
|
||||
Result:=inherited IndexOf(S);
|
||||
end;
|
||||
|
||||
function TTextStrings.Add(const S: string): Integer;
|
||||
begin
|
||||
// TODO
|
||||
Result:=inherited Add(S);
|
||||
end;
|
||||
|
||||
procedure TTextStrings.AddStrings(TheStrings: TStrings);
|
||||
var
|
||||
s: String;
|
||||
begin
|
||||
if (FText<>'') and (not (FText[length(FText)] in [#10,#13])) then
|
||||
s:=LineEnding
|
||||
else
|
||||
s:='';
|
||||
Text:=Text+s+TheStrings.Text;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user