Logo Search packages:      
Sourcecode: lazarus version File versions

gtk1memostrings.inc

{%mainunit gtkwsstdctrls.pp}
{ $Id: gtk1memostrings.inc 10535 2007-01-29 23:07:59Z marc $}
{
 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

//////// Callbacks   //////

function GtkWS_GtkTextUnFreeze(GtkText: PGtkText): guint; cdecl;
begin
  gtk_text_thaw(GtkText);
  Result := 0;
end;

procedure GtkWS_GtkTextInserting(GtkEditable: PGtkEditable; NewText: pgchar;
  NewTextLength: gint; position: pgint; TextInserted:
  PGtkTextInsertEvent); cdecl;
begin
  TextInserted^(NewText, NewTextLength, position);
end;

procedure GtkWS_GtkTextDeleting(GtkEditable: PGtkEditable; StartPos,
  EndPos: gint; TextDeleted : PGtkTextDeleteEvent); cdecl;
begin
  TextDeleted^(StartPos, EndPos);
end;

//////// Code        //////

function TGtkMemoStrings.GetTextStr: string;
begin
  Result := gtk_editable_get_chars(PGtkEditable(FGtkText), 0,
                                   gtk_text_get_length(FGtkText));
end;

function TGtkMemoStrings.GetCount: integer;
begin
  Result := FCachedCount;
  if Get(FCachedCount-1) = '' then Dec(Result);
end;

function TGtkMemoStrings.Get(Index: Integer): string;
var
  LineStart,
  LineEnd: Integer;
begin
  LineStart := FLineStartPos[Index];
  if FCachedCount-1 = Index then begin
    LineEnd := gtk_text_get_length(FGtkText);
  end
  else begin
    LineEnd := FLineStartPos[Index+1]-Length(LineEnding);
  end;
  if LineStart=LineEnd then
    Result := ''
  else
    Result := gtk_editable_get_chars(@(FGtkText^.editable), LineStart, LineEnd);
end;

procedure TGtkMemoStrings.AdjustIndices(FromIndex, ToIndex: Integer;
  ACount: Integer; Back: Boolean);
var
  X: Integer;
begin
  for X := FromIndex to ToIndex do begin;
    if Back then
      Dec(FLineStartPos[X], ACount)
    else Inc(FLineStartPos[X], ACount);
  end;
end;

procedure TGtkMemoStrings.InsertIndices(StartIndex: Integer;
  AValue: array of integer; ACount: Integer);
var
  X: Integer;
begin
  SetCachedCount(FCachedCount+ACount);
  System.Move(FLineStartPos[StartIndex],FLineStartPos[StartIndex+ACount],
              (FCachedCount-StartIndex-ACount)*SizeOf(Integer));
  for X := 0 to ACount-1 do begin
    FLineStartPos[StartIndex+X] := Avalue[X];
  end;
end;

procedure TGtkMemoStrings.DeleteIndices(StartIndex, ACount: Integer);
begin
  System.Move(FLineStartPos[StartIndex+ACount],FLineStartPos[StartIndex],
              (FCachedCount-StartIndex)*SizeOf(Integer));
  SetCachedCount(FCachedCount-ACount);
end;

procedure TGtkMemoStrings.SetCachedCount(AValue: Integer);
begin
  if AValue = FCachedCount then exit;
  if AValue >= FLineStartCapacity then begin
    while AValue >= FLineStartCapacity do Inc(FLineStartCapacity, 50);
    SetLength(FLineStartPos, FLineStartCapacity);
  end
  else if FLineStartCapacity-50 > AValue then begin
    Dec(FLineStartCapacity, 50);
    if FLineStartCapacity < 0 then FLineStartCapacity := 0;
    SetLength(FLineStartPos, FLineStartCapacity);
  end;
  FCachedCount := AValue;
end;

procedure TGtkMemoStrings.TextInserted(NewText: pgchar; NewTextLength: gint;
  position: pgint);
var
  LineIndices: array of Integer;
  LineIndicesCapacity: Integer;
  LineCount: Integer;
  X: Integer;
  StartLine: Integer;
  RealStartLine: Integer;
begin
  if NewTextLength = 0 then exit;
  fDeleting := False;
  //If (FCachedCount = 0) and (NewTextLength > 0) then SetCachedCount(1);
  LineCount := 0;
  LineIndicesCapacity := 0;
  for X := 0 to NewTextLength-1 do begin
    if NewText[X] = #10 then begin
      if LineCount >= LineIndicesCapacity then begin
        Inc(LineIndicesCapacity, 50);
        SetLength(LineIndices, LineIndicesCapacity);
      end;
      LineIndices[LineCount] := Position^+X+1;
      Inc(LineCount);
    end;
  end;
  StartLine:= PositionToLine(Position^);
  RealStartLine := StartLine + Ord(Position^ >= FLineStartPos[StartLine]);

  if RealStartLine <= FCachedCount-1 then
    AdjustIndices(RealStartLine, FCachedCount, NewTextLength, False);

  if LineCount > 0 then
    InsertIndices(RealStartLine, LineIndices, LineCount);

  SetLength(LineIndices, 0);
  // detect lineendings and  Increase Count and Lines.InsertIndices(); and AdjustIndices();
  //debugln('TGtkMemoStrings.TextInserted ',DbgSName(Owner));
end;

procedure TGtkMemoStrings.TextDeleted(StartPos, EndPos: gint);
var
  ShrinkCount: Integer;
  StartLine,
  EndLine: Integer;
begin
  if EndPos - StartPos = 0 then Exit;
  fDeleting := True;
  ShrinkCount := 0;
  StartLine := PositionToLine(StartPos+1);
  EndLine := PositionToLine(EndPos+1, StartLine);
  ShrinkCount := EndLine - StartLine;

  if ShrinkCount > 0 then begin
    DeleteIndices(StartLine, ShrinkCount);
  end;
  AdjustIndices(StartLine, FCachedCount-1, EndPos-StartPos, True);
  
  //if (FCachedCount = 1) and (gtk_text_get_length(FGtkText)-(endpos-startpos) = 0) then SetCachedCount(0);
  // see if any Indices in the cache are within the array, shrink the array , adjust the indices
  fDeleting := False;

  //debugln('TGtkMemoStrings.TextDeleted ',DbgSName(Owner));
end;

function TGtkMemoStrings.PositionToLine(Position: Integer; StartLine: Integer = 0): Integer;
var
 X: Integer;
begin
 Result := 0;
 // TODO maybe make this work faster by moving by more than 1 Index at a time
 // although it doesn't seem slow....
 X := StartLine;
// if FCachedCount = 0 then Exit;

 while (FLineStartPos[X] < Position) and (X <= FCachedCount-1) do begin
   if (not fDeleting) and (X = FCachedCount-1) then Break;
   Inc(X);
 end;
 Result := X;
end;

constructor TGtkMemoStrings.Create(GtkText: PGtkText; TheOwner: TWinControl);
begin
  inherited Create;
  FGtkText := GtkText;
  FOwner := TheOwner;
  FLineStartCapacity := 50;
  SetLength(FLineStartPos, FLineStartCapacity);
  FLineStartPos[0] := 0;
  FCachedCount := 1;
  fDeleting := False;
  fTextInsertEvent := @TextInserted;
  fTextDeleteEvent := @TextDeleted;
  g_signal_connect(PGtkObject(FGtkText), 'insert-text', TGtkSignalFunc(@GtkWS_GtkTextInserting), @fTextInsertEvent);
  g_signal_connect(PGtkObject(FGtkText), 'delete-text', TGtkSignalFunc(@GtkWS_GtkTextDeleting), @fTextDeleteEvent);
end;

destructor TGtkMemoStrings.Destroy;
begin
  SetLength(FLineStartPos, 0);
  inherited Destroy;
end;

procedure TGtkMemoStrings.Assign(Source: TPersistent);
begin
  if (Source=Self) or (Source=nil) then exit;
  if Source is TStrings then begin
    SetText(PChar(TStrings(Source).Text));
    exit;
  end;
  Inherited Assign(Source);
end;

procedure TGtkMemoStrings.Clear;
begin
  LockOnChange(PGtkObject(FGtkText),+1);

  gtk_editable_delete_text(PGtkEditable(FGtkText), 0, gtk_text_get_length(FGtkText));
  LockOnChange(PGtkObject(FGtkText),-1);
  //SetCachedCount(0);
  //debugln('TGtkMemoStrings.Clear ',DbgSName(Owner));
end;

procedure TGtkMemoStrings.Delete(Index: integer);
var
  LineStart,
  LineEnd: Integer;
begin
  if Index = 0 then
    LineStart := 0
  else
    LineStart := FLineStartPos[Index];
  if FCachedCount-1 = Index then begin
    LineEnd := gtk_text_get_length(FGtkText);
  end
  else begin
    LineEnd := FLineStartPos[Index+1];
  end;
  gtk_editable_delete_text(PGtkEditable(FGtkText), LineStart, LineEnd);
  //debugln('TGtkMemoStrings.Delete ',DbgSName(Owner));
end;

procedure TGtkMemoStrings.Insert(Index: integer; const S: string);
var
  LineStart: Integer;
  NewLine: String;
begin
  if FGtkText^.freeze_count = 0 then begin
    gtk_text_freeze(FGtkText);
    gtk_idle_add(TGtkfunction(@GtkWS_GtkTextUnFreeze), FGtkText);
  end;

  LockOnChange(PGtkObject(FGtkText),+1);

  if Index < FCachedCount then begin
    //insert with LineEnding
    LineStart := FLineStartPos[Index];
    NewLine := S+LineEnding;
    gtk_editable_insert_text(PGtkEditable(FGtkText),PChar(NewLine), Length(NewLine), @LineStart);
  end
  else begin
    //append with a preceding and appending LineEnding
    LineStart := gtk_text_get_length(FGtkText);
    if (FCachedCount = Count) then
      NewLine := LineEnding+S+LineEnding
    else
      NewLine := S+LineEnding;
    gtk_editable_insert_text(PGtkEditable(FGtkText),PChar(NewLine), Length(NewLine), @LineStart)
  end;

  LockOnChange(PGtkObject(FGtkText),-1);
end;

procedure TGtkMemoStrings.SetText(TheText: PChar);
var
StartPos: Integer;
begin
  StartPos := 0;
  LockOnChange(PGtkObject(FGtkText),+1);
  Clear;
  if theText^<>#0 then
    gtk_editable_insert_text(PGtkEditable(FGtkText),TheText, Length(TheText), @StartPos);
  LockOnChange(PGtkObject(FGtkText),-1);
  //debugln('TGtkMemoStrings.SetText ',DbgSName(Owner),' "',TheText,'" ',dbgs(gtk_text_get_length(FGtkText)));
end;

Generated by  Doxygen 1.6.0   Back to index