breakpoints.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: breakpoints.pas, released 11 Mar 2001.

The Initial Developer of the Original Code is J黵gen G黱therodt.

Portions created by J黵gen G黱therodt <[e-mail]>
are Copyright (C) 2001-2002 J黵gen G黱therodt. All Rights Reserved.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.

$Id: breakpoints.pas,v 1.4 2002/05/26 13:47:34 jguentherodt Exp $

You may retrieve the latest version of this file at the Open Perl IDE webpage,
located at http://open-perl-ide.sourceforge.net or http://www.lost-sunglasses.de
-------------------------------------------------------------------------------}
unit breakpoints;

interface

uses
  Classes, SysUtils;

type
  TBreakpointList = class;

  TBreakpoint = class
  private
    m_BreakpointList: TBreakpointList;
    m_nLine: Integer;
    m_sCondition: String;
  protected
    function GetAsString: String; virtual;
    procedure SetAsString(s: String); virtual;
  public
    constructor Create(ParentList: TBreakpointList; nLine: Integer = -1);
    destructor Destroy; override;
    property Line: Integer Read m_nLine;
    property Condition: String Read m_sCondition Write m_sCondition;
    property AsString: String Read GetAsString Write SetAsString;
  end;


  TBreakpointList = class
  private
    m_sName: String;
    m_slBreakpoints: TStringList;
    m_sSaved: String;
  protected
    function GetCount: Integer; virtual;
    function GetBreakpoints(i: Integer): TBreakpoint; virtual;
    procedure InternalInsertBreakpoint(bp: TBreakpoint); virtual;
    procedure InternalDeleteBreakpoint(bp: TBreakpoint); virtual;
    function GetAsString: String; virtual;
    procedure SetAsString(s: String); virtual;
  public
    constructor Create(sName: String);
    destructor Destroy; override;
    procedure Clear;
    procedure Save;
    function BreakpointByLine(nLine: Integer): TBreakpoint;
    property Name: String Read m_sName;
    property Count: Integer Read GetCount;
    property Breakpoints[i: Integer]: TBreakpoint Read GetBreakpoints; default;
    property AsString: String Read GetAsString Write SetAsString;
  end;

implementation


////////////////////////////////////////////////////////////////////////////////
//  TBreakpointList = class
////////////////////////////////////////////////////////////////////////////////
constructor TBreakpointList.Create(sName: String);
begin
  inherited Create;
  m_sName := sName;
  m_slBreakpoints := TStringList.Create;
  m_slBreakpoints.Sorted := True;
  m_slBreakpoints.Duplicates := dupIgnore;
end;


destructor TBreakpointList.Destroy;
begin
  Clear;
  m_slBreakpoints.Free;
  inherited Destroy;
end;


function TBreakpointList.BreakpointByLine(nLine: Integer): TBreakpoint;
var
  idx: Integer;
begin
  idx := m_slBreakpoints.IndexOf(IntToStr(nLine));
  if idx > -1
    then Result := TBreakpoint(m_slBreakpoints.Objects[idx])
    else Result := nil;
end;


function TBreakpointList.GetCount: Integer;
begin
  Result := m_slBreakpoints.Count;
end;


function TBreakpointList.GetBreakpoints(i: Integer): TBreakpoint;
begin
  Result := TBreakpoint(m_slBreakpoints.Objects[i]);
end;


procedure TBreakpointList.Save;
var
  sl: TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  for i := 0 to Count - 1 do
    sl.Add(Breakpoints[i].AsString);
  m_sSaved := sl.CommaText;
  sl.Free;
end;


procedure TBreakpointList.Clear;
begin
  while (m_slBreakpoints.Count > 0) do
    m_slBreakpoints.Objects[0].Free;
end;


procedure TBreakpointList.InternalInsertBreakpoint(bp: TBreakpoint);
var
  bpOld: TBreakpoint;
begin
  bpOld := BreakpointByLine(bp.Line);
  if bpOld <> bp then bpOld.Free;
  m_slBreakpoints.AddObject(IntToStr(bp.Line), bp);
end;


procedure TBreakpointList.InternalDeleteBreakpoint(bp: TBreakpoint);
var
  idx: Integer;
begin
  idx := m_slBreakpoints.IndexOf(IntToStr(bp.Line));
  if idx > -1 then m_slBreakpoints.Delete(idx);
end;


function TBreakpointList.GetAsString: String;
begin
  Result := m_sSaved;
end;


procedure TBreakpointList.SetAsString(s: String);
var
  sl: TStringList;
  i: Integer;
begin
  Clear;
  m_sSaved := s;
  sl := TStringList.Create;
  sl.CommaText := s;
  for i := 0 to sl.Count - 1 do
    TBreakpoint.Create(Self).AsString := sl[i];
  sl.Free;
end;


////////////////////////////////////////////////////////////////////////////////
//  TBreakpoint = class
////////////////////////////////////////////////////////////////////////////////
constructor TBreakpoint.Create(ParentList: TBreakpointList; nLine: Integer);
begin
  inherited Create;
  m_nLine := nLine;
  m_BreakpointList := ParentList;
  m_BreakpointList.InternalInsertBreakpoint(Self);
end;


destructor TBreakpoint.Destroy;
begin
  m_BreakpointList.InternalDeleteBreakpoint(Self);
  inherited Destroy;
end;


function TBreakpoint.GetAsString: String;
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Add(IntToStr(m_nLine));
  sl.Add(m_sCondition);
  Result := sl.CommaText;
  sl.Free;
end;


procedure TBreakpoint.SetAsString(s: String);
var
  sl: TStringList;
begin
  m_BreakpointList.InternalDeleteBreakpoint(Self);
  sl := TStringList.Create;
  sl.CommaText := s;
  if sl.Count > 0
    then m_nLine := StrToIntDef(sl[0], -1)
    else m_nLine := -1;
  if sl.Count > 1
    then m_sCondition := sl[1]
    else m_sCondition := '';
  sl.Free;
  m_BreakpointList.InternalInsertBreakpoint(Self);
end;


end.