paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-18 21:50:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented popupmenu items in source editor for breakpoints

Browse Source 
git-svn-id: trunk@4233 -
This commit is contained in:
mattias 2003-06-04 16:34:11 +00:00
parent 80d74a8fe7
commit e601180b90
6 changed files with 109 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ide/basedebugmanager.pas
View File

@ -76,6 +76,7 @@ type
): TModalResult; virtual; abstract;
function DoDeleteBreakPointAtMark(const ASourceMark: TSourceMark
): TModalResult; virtual; abstract;
function DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint): TModalresult; virtual; abstract;
function DoCreateWatch(const AExpression: string): TModalResult; virtual; abstract;
public

62
ide/debugmanager.pas
View File

@ -151,6 +151,7 @@ type
ALine: integer): TModalResult; override;
function DoDeleteBreakPointAtMark(
const ASourceMark: TSourceMark): TModalResult; override;
function DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint): TModalresult; override;
function DoCreateWatch(const AExpression: string): TModalResult; override;
end;
@ -168,21 +169,26 @@ type
private
FMaster: TDBGBreakPoint;
FSourceMark: TSourceMark;
procedure SetSourceMark(const AValue: TSourceMark);
procedure OnSourceMarkPositionChanged(Sender: TObject);
procedure OnSourceMarkBeforeFree(Sender: TObject);
procedure OnSourceMarkGetHint(SenderMark: TSourceMark; var Hint: string);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure DoChanged; override;
function GetHitCount: Integer; override;
function GetValid: TValidState; override;
procedure AssignTo(Dest: TPersistent); override;
procedure DoChanged; override;
procedure OnSourceMarkBeforeFree(Sender: TObject);
procedure OnSourceMarkCreatePopupMenu(SenderMark: TSourceMark;
const AddMenuItem: TAddMenuItemProc);
procedure OnSourceMarkGetHint(SenderMark: TSourceMark; var Hint: string);
procedure OnSourceMarkPositionChanged(Sender: TObject);
procedure OnToggleEnableMenuItemClick(Sender: TObject);
procedure OnDeleteMenuItemClick(Sender: TObject);
procedure OnViewPropertiesMenuItemClick(Sender: TObject);
procedure SetEnabled(const AValue: Boolean); override;
procedure SetExpression(const AValue: String); override;
procedure SetLocation(const ASource: String; const ALine: Integer); override;
procedure SetSourceMark(const AValue: TSourceMark);
procedure UpdateSourceMark;
procedure UpdateSourceMarkImage;
procedure UpdateSourceMarkLineColor;
procedure UpdateSourceMark;
public
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
@ -251,6 +257,7 @@ begin
FSourceMark.Line:=Line;
FSourceMark.Visible:=true;
FSourceMark.AddGetHintHandler(@OnSourceMarkGetHint);
FSourceMark.AddCreatePopupMenuHandler(@OnSourceMarkCreatePopupMenu);
UpdateSourceMark;
end;
end;
@ -260,6 +267,21 @@ begin
Changed;
end;
procedure TManagedBreakPoint.OnToggleEnableMenuItemClick(Sender: TObject);
begin
Enabled:=not Enabled;
end;
procedure TManagedBreakPoint.OnDeleteMenuItemClick(Sender: TObject);
begin
Free;
end;
procedure TManagedBreakPoint.OnViewPropertiesMenuItemClick(Sender: TObject);
begin
DebugBoss.DoViewBreakPointProperties(Self);
end;
procedure TManagedBreakPoint.OnSourceMarkBeforeFree(Sender: TObject);
begin
SourceMark:=nil;
@ -274,6 +296,20 @@ begin
+'Condition: '+Expression;
end;
procedure TManagedBreakPoint.OnSourceMarkCreatePopupMenu(
SenderMark: TSourceMark; const AddMenuItem: TAddMenuItemProc);
begin
// add enable/disable toggle menu item
if Enabled then
AddMenuItem('Disable Breakpoint',true,@OnToggleEnableMenuItemClick)
else
AddMenuItem('Enable Breakpoint',true,@OnToggleEnableMenuItemClick);
AddMenuItem('Delete Breakpoint',true,@OnDeleteMenuItemClick);
AddMenuItem('View Breakpoint Properties',false,@OnViewPropertiesMenuItemClick);
// add separator
AddMenuItem('-',true,nil);
end;
procedure TManagedBreakPoint.AssignTo(Dest: TPersistent);
begin
inherited AssignTo(Dest);
@ -572,7 +608,7 @@ begin
if (ADebugger<>FDebugger) or (ADebugger=nil) then
RaiseException('TDebugManager.OnDebuggerChangeState');
if Destroying then exit;
if Destroying or (MainIDE=nil) or (MainIDE.ToolStatus=itExiting) then exit;
WriteLN('[TDebugManager.OnDebuggerChangeState] state: ', STATENAME[FDebugger.State]);
@ -1310,6 +1346,13 @@ writeln('TDebugManager.DoDeleteBreakPointAtMark B ',OldBreakPoint.ClassName,' ',
Result:=DoEndChangeDebugger;
end;
function TDebugManager.DoViewBreakPointProperties(ABreakpoint: TIDEBreakPoint
): TModalresult;
begin
Result:=mrCancel;
// ToDo
end;
function TDebugManager.DoCreateWatch(const AExpression: string): TModalResult;
var
NewWatch: TDBGWatch;
@ -1375,6 +1418,9 @@ end.
{ =============================================================================
$Log$
Revision 1.47 2003/06/04 16:34:11 mattias
implemented popupmenu items in source editor for breakpoints
Revision 1.46 2003/06/04 13:34:58 mattias
implemented breakpoints hints for source editor

4
ide/lazarusidestrconsts.pas
View File

@ -931,8 +931,8 @@ resourcestring
uemReadOnly = 'Read Only';
uemUnitInfo = 'Unit Info';
uemDebugWord = 'Debug';
uemToggleBreakpoint = '&Toggle Breakpoint';
uemAddWatchAtCursor = '&Add Watch At Cursor';
uemAddBreakpoint = '&Add Breakpoint';
uemAddWatchAtCursor = 'Add &Watch At Cursor';
uemRunToCursor='&Run to Cursor';
uemMoveEditorLeft='Move Editor Left';
uemMoveEditorRight='Move Editor Right';

1
ide/mainbar.pas
View File

@ -58,6 +58,7 @@ type
// The IDE is at anytime in a specific state:
TIDEToolStatus = (
itNone, // The default mode. All editing allowed.
itExiting, // the ide is shutting down
itBuilder, // compiling (the project, a package, an external tool)
// Loading/Saving/Debugging is not allowed.
itDebugger, // debugging the project.

38
ide/sourcemarks.pas
View File

@ -38,7 +38,7 @@ unit SourceMarks;
interface
uses
Classes, SysUtils, LCLProc, LResources, Graphics, GraphType, Controls,
Classes, SysUtils, LCLProc, LResources, Graphics, GraphType, Controls, Menus,
AVL_Tree, SynEdit, IDEProcs, EditorOptions;
type
@ -49,11 +49,18 @@ type
TGetSourceMarkHintEvent =
procedure(SenderMark: TSourceMark; var Hint: string) of object;
TAddMenuItemProc =
function (const NewCaption: string; const NewEnabled: boolean;
const NewOnClick: TNotifyEvent): TMenuItem of object;
TCreateSourceMarkPopupMenuEvent =
procedure(SenderMark: TSourceMark;
const AddMenuItem: TAddMenuItemProc) of object;
TSourceMarkHandler = (
smhPositionChanged,
smhBeforeFree,
smhGetHint
smhGetHint,
smhCreatePopupMenu
);
TSourceMark = class(TSynEditMark)
@ -91,6 +98,7 @@ type
ALine: integer): integer;
function GetFilename: string;
function GetHint: string; virtual;
procedure CreatePopupMenuItems(AddMenuItemProc: TAddMenuItemProc);
public
// handlers
procedure RemoveAllHandlersForObject(HandlerObject: TObject);
@ -100,6 +108,10 @@ type
procedure RemoveBeforeFreeHandler(OnBeforeFree: TNotifyEvent);
procedure AddGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
procedure RemoveGetHintHandler(OnGetHint: TGetSourceMarkHintEvent);
procedure AddCreatePopupMenuHandler(
OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
procedure RemoveCreatePopupMenuHandler(
OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
public
// properties
property Data: TObject read FData write SetData;
@ -380,6 +392,16 @@ begin
TGetSourceMarkHintEvent(FHandlers[smhGetHint][i])(Self,Result);
end;
procedure TSourceMark.CreatePopupMenuItems(AddMenuItemProc: TAddMenuItemProc);
var
i: Integer;
begin
i:=FHandlers[smhCreatePopupMenu].Count;
while FHandlers[smhCreatePopupMenu].NextDownIndex(i) do
TCreateSourceMarkPopupMenuEvent(FHandlers[smhCreatePopupMenu][i])
(Self,AddMenuItemProc);
end;
procedure TSourceMark.RemoveAllHandlersForObject(HandlerObject: TObject);
var
HandlerType: TSourceMarkHandler;
@ -421,6 +443,18 @@ begin
FHandlers[smhGetHint].Remove(TMethod(OnGetHint));
end;
procedure TSourceMark.AddCreatePopupMenuHandler(
OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
begin
AddHandler(smhCreatePopupMenu,TMethod(OnCreatePopupMenu));
end;
procedure TSourceMark.RemoveCreatePopupMenuHandler(
OnCreatePopupMenu: TCreateSourceMarkPopupMenuEvent);
begin
FHandlers[smhCreatePopupMenu].Remove(TMethod(OnCreatePopupMenu));
end;
{ TSourceMarks }
function TSourceMarks.GetItems(Index: integer): TSourceMark;

16
lcl/forms.pp
View File

@ -1142,8 +1142,11 @@ begin
CreateNew(TheOwner,0);
if (ClassType <> TDataModule) and not (csDesigning in ComponentState) then
begin
{$IFDEF UseFCLInitResourceComponent}
if not Inic.InitInheritedComponent(Self, TDataModule) then begin
{$ELSE}
if not InitResourceComponent(Self, TForm) then begin
//if not InitInheritedComponent(Self, TDataModule) then
{$ENDIF}
raise EResNotFound.CreateFmt(lisLCLResourceSNotFound, [ClassName]);
end;
if OldCreateOrder then DoCreate;
@ -1339,6 +1342,13 @@ end;
{$I hintwindow.inc}
{$IFDEF UseFCLInitResourceComponent}
function LCLInitComponent(Instance: TComponent; RootAncestor: TClass): boolean;
begin
Result:=InitResourceComponent(Instance,RootAncestor);
end;
{$ENDIF}
initialization
FocusCount := 0;
Focusmessages := True;
@ -1346,6 +1356,10 @@ initialization
LCLProc.OwnerFormDesignerModifiedProc:=@IfOwnerIsFormThenDesignerModified;
Screen:= TScreen.Create(nil);
Application:= TApplication.Create(nil);
{$IFDEF UseFCLInitResourceComponent}
RegisterInitComponentHandler(TComponent,@LCLInitComponent);
{$ENDIF}
finalization
//writeln('forms.pp - finalization section');