paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-09 02:39:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ add forgotten dialogs

Browse Source 
git-svn-id: trunk@17750 -
This commit is contained in:
marc 2008-12-09 09:40:24 +00:00
parent 04fde3cce3
commit df49c8ebd2
4 changed files with 542 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -1582,6 +1582,9 @@ debian/patches/01_topmakefile.dpatch svneol=native#text/plain
debian/patches/02_components.dpatch svneol=native#text/plain debian/patches/02_components.dpatch svneol=native#text/plain
debian/rules svneol=native#text/plain debian/rules svneol=native#text/plain
debian/watch svneol=native#text/plain debian/watch svneol=native#text/plain
debugger/assemblerdlg.lfm svneol=native#text/pascal
debugger/assemblerdlg.lrs svneol=native#text/pascal
debugger/assemblerdlg.pp svneol=native#text/pascal
debugger/breakpointsdlg.lfm svneol=native#text/plain debugger/breakpointsdlg.lfm svneol=native#text/plain
debugger/breakpointsdlg.lrs svneol=native#text/pascal debugger/breakpointsdlg.lrs svneol=native#text/pascal
debugger/breakpointsdlg.pp svneol=native#text/pascal debugger/breakpointsdlg.pp svneol=native#text/pascal

46
debugger/assemblerdlg.lfm Normal file
View File

@ -0,0 +1,46 @@
inherited AssemblerDlg: TAssemblerDlg
Left = 488
Height = 301
Top = 143
Width = 400
HorzScrollBar.Page = 399
HorzScrollBar.Range = 399
VertScrollBar.Page = 300
VertScrollBar.Range = 300
AutoScroll = False
Caption = 'Assembler'
ClientHeight = 301
ClientWidth = 400
KeyPreview = True
OnKeyDown = FormKeyDown
OnResize = FormResize
object pbAsm: TPaintBox[0]
Height = 272
Width = 376
OnMouseDown = pbAsmMouseDown
OnMouseWheel = pbAsmMouseWheel
OnPaint = pbAsmPaint
end
object sbHorizontal: TScrollBar[1]
Height = 15
Top = 285
Width = 384
Max = 1000
PageSize = 200
TabOrder = 0
OnChange = sbHorizontalChange
end
object sbVertical: TScrollBar[2]
Left = 384
Height = 280
Width = 15
Kind = sbVertical
LargeChange = 10
Max = 1000
PageSize = 50
Position = 475
TabOrder = 1
OnChange = sbVerticalChange
OnScroll = sbVerticalScroll
end
end

18
debugger/assemblerdlg.lrs Normal file
View File

@ -0,0 +1,18 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TAssemblerDlg','FORMDATA',[
'TPF0'#241#13'TAssemblerDlg'#12'AssemblerDlg'#4'Left'#3#232#1#6'Height'#3'-'#1
+#3'Top'#3#143#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#19'HorzScrol'
+'lBar.Range'#3#143#1#18'VertScrollBar.Page'#3','#1#19'VertScrollBar.Range'#3
+','#1#10'AutoScroll'#8#7'Caption'#6#9'Assembler'#12'ClientHeight'#3'-'#1#11
+'ClientWidth'#3#144#1#10'KeyPreview'#9#9'OnKeyDown'#7#11'FormKeyDown'#8'OnRe'
+'size'#7#10'FormResize'#0#242#2#0#9'TPaintBox'#5'pbAsm'#6'Height'#3#16#1#5'W'
+'idth'#3'x'#1#11'OnMouseDown'#7#14'pbAsmMouseDown'#12'OnMouseWheel'#7#15'pbA'
+'smMouseWheel'#7'OnPaint'#7#10'pbAsmPaint'#0#0#242#2#1#10'TScrollBar'#12'sbH'
+'orizontal'#6'Height'#2#15#3'Top'#3#29#1#5'Width'#3#128#1#3'Max'#3#232#3#8'P'
+'ageSize'#3#200#0#8'TabOrder'#2#0#8'OnChange'#7#18'sbHorizontalChange'#0#0
+#242#2#2#10'TScrollBar'#10'sbVertical'#4'Left'#3#128#1#6'Height'#3#24#1#5'Wi'
+'dth'#2#15#4'Kind'#7#10'sbVertical'#11'LargeChange'#2#10#3'Max'#3#232#3#8'Pa'
+'geSize'#2'2'#8'Position'#3#219#1#8'TabOrder'#2#1#8'OnChange'#7#16'sbVertica'
+'lChange'#8'OnScroll'#7#16'sbVerticalScroll'#0#0#0
]);

475
debugger/assemblerdlg.pp Normal file
View File

@ -0,0 +1,475 @@
unit AssemblerDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ComCtrls, StdCtrls, Grids, ExtCtrls, LclType, DebuggerDlg, Debugger,
EditorOptions, Maps, Math;
type
{ TAssemblerDlg }
TAsmDlgLineMapState = (
lmsUnknown,
lmsInvalid, // debugger couldn't disassemble this address
lmsStatement, // display line as assembler
lmsSource // display line as source
);
TAssemblerDlg = class(TDebuggerDlg)
pbAsm: TPaintBox;
sbHorizontal: TScrollBar;
sbVertical: TScrollBar;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormResize(Sender: TObject);
procedure pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure pbAsmPaint(Sender: TObject);
procedure sbHorizontalChange(Sender: TObject);
procedure sbVerticalChange(Sender: TObject);
procedure sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
private
FDebugger: TDebugger;
FTopLine: Integer;
FSelectLine: Integer;
FLineCount: Integer;
FLineHeight: Integer;
FLineMap: array[Byte] of record // cyclic buffer
State: TAsmDlgLineMapState;
Line: Integer;
Addr: TDbgPtr;
Dump: String;
Statement: String;
end;
FLineMapMin: Byte;
FLineMapMax: Byte;
FLineMapValid: Boolean;
FCharWidth: Integer;
FGutterWidth: Integer;
FUpdating: Boolean;
FUpdateNeeded: Boolean;
procedure ClearLineMap;
procedure UpdateLineData(ALine: Integer);
procedure SetSelection(ALine: Integer; AMakeVisible: Boolean);
procedure SetTopLine(ALine: Integer);
protected
procedure InitializeWnd; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetLocation(ADebugger: TDebugger; const AAddr: TDBGPtr);
end;
implementation
{ TAssemblerDlg }
procedure TAssemblerDlg.ClearLineMap;
var
n: Integer;
begin
FLineMapMin := 0;
FLineMapMax := 0;
FLineMapValid := False;
for n := Low(FLineMap) to High(FLineMap) do
begin
FLineMap[n].Line := n;
FLineMap[n].State := lmsUnknown;
end;
end;
constructor TAssemblerDlg.Create(AOwner: TComponent);
begin
FLineHeight := Abs(EditorOpts.EditorFontHeight) + EditorOpts.ExtraLineSpacing;
FGutterWidth := 32;
inherited Create(AOwner);
// DoubleBuffered := True;
pbAsm.Font.Name := EditorOpts.EditorFont;
pbAsm.Font.Height := EditorOpts.EditorFontHeight;
end;
destructor TAssemblerDlg.Destroy;
begin
inherited Destroy;
end;
procedure TAssemblerDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Shift <> [] then Exit;
case Key of
VK_UP: begin
SetSelection(FSelectLine - 1, True);
Exit;
end;
VK_DOWN: begin
SetSelection(FSelectLine + 1, True);
Exit;
end;
VK_PRIOR: begin
Dec(FSelectLine, FLineCount);
SetTopline(FTopLine - FLineCount);
end;
VK_NEXT: begin
Inc(FSelectLine, FLineCount);
SetTopline(FTopLine + FLineCount);
end;
VK_LEFT: sbHorizontal.Position := sbHorizontal.Position - sbHorizontal.SmallChange;
VK_RIGHT: sbHorizontal.Position := sbHorizontal.Position + sbHorizontal.SmallChange;
VK_HOME: sbHorizontal.Position := 0;
end;
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.FormResize(Sender: TObject);
var
R: TRect;
n: Integer;
begin
R := ClientRect;
Dec(R.Right, sbVertical.Width);
Dec(R.Bottom, sbHorizontal.Height);
sbVertical.Left := R.Right;
sbVertical.Height := R.Bottom;
sbHorizontal.Top := R.Bottom;
sbHorizontal.Width := R.Right;
sbHorizontal.PageSize := R.Right;
sbHorizontal.LargeChange := R.Right div 3;
FLineCount := R.Bottom div FLineHeight;
UpdateLineData(FTopLine + FLineCount);
pbAsm.SetBounds(0, 0, R.Right, R.Bottom);
end;
procedure TAssemblerDlg.InitializeWnd;
begin
inherited InitializeWnd;
FCharWidth := EditorOpts.ExtraCharSpacing + pbAsm.Canvas.TextExtent('X').cx;
sbHorizontal.SmallChange := FCHarWidth;
end;
procedure TAssemblerDlg.pbAsmMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
SetSelection(FTopLine + Y div FLineHeight, True);
end;
procedure TAssemblerDlg.pbAsmMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
Handled := True;
SetSelection(FSelectLine - (WheelDelta div 120), True);
end;
procedure TAssemblerDlg.pbAsmPaint(Sender: TObject);
var
R: TRect;
n, X, Y, Line, idx: Integer;
S: String;
Addr: TDbgPtr;
State: TAsmDlgLineMapState;
begin
R := pbAsm.ClientRect;
// pbAsm.Canvas.Brush.Color := clWindow;
pbAsm.Canvas.FillRect(R);
Inc(R.Left, FGutterWidth);
X := FGutterWidth - sbHorizontal.Position;
Y := 0;
Line := FTopLine;
idx := Cardinal(Line) mod Length(FLineMap);
for n := 0 to FLineCount do
begin
if Line = FSelectLine
then begin
pbAsm.Canvas.Brush.Color := clHighlight;
pbAsm.Canvas.Font.Color := clHighlightText;
pbAsm.Canvas.FillRect(R.Left, n * FLineHeight, R.Right, (n + 1) * FLineHeight);
end
else begin
pbAsm.Canvas.Brush.Color := pbAsm.Color;
pbAsm.Canvas.Font.Color := pbAsm.Font.Color;
end;
S := '';
//S := Format('[a:%8.8u l:%8.8d i:%3.3u] ', [Cardinal(FLineMap[idx].Addr), Line, idx]);
if FDebugger <> nil
then S := S + HexStr(FLineMap[idx].Addr, FDebugger.TargetWidth div 4) + ' ';
if FLineMap[idx].Line = Line
then begin
case FLineMap[idx].State of
lmsUnknown: S := S + '??????';
lmsInvalid: S := S + '......';
lmsStatement: S := S + Copy(FLineMap[idx].Dump + ' ', 1, 17) + FLineMap[idx].Statement;
end;
end;
pbAsm.Canvas.TextRect(R, X, Y, S);
Inc(Y, FLineHeight);
Inc(Line);
if idx < High(FLineMap)
then Inc(Idx)
else Idx := 0;
end;
end;
procedure TAssemblerDlg.sbHorizontalChange(Sender: TObject);
begin
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.sbVerticalChange(Sender: TObject);
begin
sbVertical.Position := 475;
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.sbVerticalScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
case ScrollCode of
scLineUp: begin
SetTopline(FTopLine - 1);
end;
scLineDown: begin
SetTopline(FTopLine + 1);
end;
scPageUp: begin
SetTopline(FTopLine - FLineCount);
end;
scPageDown: begin
SetTopline(FTopLine + FLineCount);
end;
scPosition: begin
// doesn't work on gtk
end;
scTrack: begin
// --- remove when scPosition works
ScrollPos := 475;
Exit;
// ---
if ScrollPos = 475 then Exit;
if ScrollPos < 475
then SetTopline(FTopLine - 1)
else SetTopline(FTopLine + 1);
end;
// scTop, // = SB_TOP
// scBottom, // = SB_BOTTOM
// scEndScroll // = SB_ENDSCROLL
end;
end;
procedure TAssemblerDlg.SetLocation(ADebugger: TDebugger; const AAddr: TDBGPtr);
begin
FDebugger := ADebugger;
ClearLineMap;
FLineMapMin := 0;
FLineMapMax := 0;
FLineMap[0].Addr := AAddr;
FLineMap[0].Line := 0;
FLineMapValid := True;
FTopLine := 0;
FSelectLine := FTopLine;
UpdateLineData(0); // start
UpdateLineData(FLineCount); // rest
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.SetSelection(ALine: Integer; AMakeVisible: Boolean);
var
OldLine: Integer;
begin
if Aline = FSelectLine then Exit;
// UpdateLineData may cause eventhandling, so we enter here again
// set variable first
OldLine := FSelectLine;
FSelectLine := Aline;
if AMakeVisible
then begin
if FSelectLine < OldLine
then begin
if FTopLine > FSelectLine
then SetTopLine(FSelectLine);
end
else begin
if FTopLine + FLineCount <= FSelectLine
then SetTopLine(FSelectLine - FLineCount + 1);
end;
end;
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.SetTopLine(ALine: Integer);
var
OldTop: Integer;
begin
if FTopLine = ALine then Exit;
if not FLineMapValid
then begin
FTopLine := ALine;
pbAsm.Invalidate;
Exit;
end;
// UpdateLineData may cause eventhandling, so we enter here again
// set variable first
OldTop := FTopLine;
FTopLine := ALine;
if FTopLine < OldTop
then begin
// before
UpdateLineData(FTopLine);
end
else begin
// after
UpdateLineData(FTopLine + FLineCount);
end;
pbAsm.Invalidate;
end;
procedure TAssemblerDlg.UpdateLineData(ALine: Integer);
var
Addr, NextAddr: TDbgPtr;
OK: Boolean;
Line: Integer;
Idx: Byte;
Dump, Statement: String;
begin
if FDebugger = nil then Exit;
if not FLineMapValid then Exit;
// while accessing external debugger, events are handled, so we could enter here again
if FUpdating
then begin
FUpdateNeeded := True;
Exit;
end;
FUpdating := True;
try
while FLineMap[FLineMapMin].Line > ALine do
begin
// get lines before min
Addr := FLineMap[FLineMapMin].Addr;
Line := FLineMap[FLineMapMin].Line - 1;
if FLineMapMin = 0
then FLineMapMin := High(FLineMap)
else Dec(FLineMapMin);
// check if we overlap with our end
if FLineMapMin = FLineMapMax
then begin
if FLineMapMax = 0
then FLineMapMax := High(FLineMap)
else Dec(FLineMapMax);
end;
FLineMap[FLineMapMin].State := lmsUnknown;
FLineMap[FLineMapMin].Line := Line;
OK := FDebugger.Disassemble(Addr, True, NextAddr, Dump, Statement);
if OK
then begin
FLineMap[FLineMapMin].State := lmsStatement;
FLineMap[FLineMapMin].Dump := Dump;
FLineMap[FLineMapMin].Statement := Statement;
end
else begin
FLineMap[FLineMapMin].State := lmsInvalid;
NextAddr := Addr - 1;
end;
FLineMap[FLineMapMin].Addr := NextAddr;
if OK and (Line = ALine) then Exit;
end;
if FLineMap[FLineMapMax].Line < ALine
then begin
// get lines after max
// get startingpoint
Addr := FLineMap[FLineMapMax].Addr;
if not FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement)
then NextAddr := Addr + 1;
while FLineMap[FLineMapMax].Line < ALine do
begin
Addr := NextAddr;
Line := FLineMap[FLineMapMax].Line + 1;
if FLineMapMax = High(FLineMap)
then FLineMapMax := 0
else Inc(FLineMapMax);
// check if we overlap with our start
if FLineMapMin = FLineMapMax
then begin
if FLineMapMin = High(FLineMap)
then FLineMapMin := 0
else Inc(FLineMapMin);
end;
FLineMap[FLineMapMax].State := lmsUnknown;
FLineMap[FLineMapMax].Line := Line;
FLineMap[FLineMapMax].Addr := Addr;
OK := FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement);
if OK
then begin
FLineMap[FLineMapMax].State := lmsStatement;
FLineMap[FLineMapMax].Dump := Dump;
FLineMap[FLineMapMax].Statement := Statement;
end
else begin
FLineMap[FLineMapMax].State := lmsInvalid;
NextAddr := Addr + 1;
end;
if OK and (Line = ALine) then Exit;
end;
end;
idx := Cardinal(ALine) mod Length(FLineMap);
if FLineMap[idx].State <> lmsUnknown then Exit;
FLineMap[idx].Line := ALine;
Addr := FLineMap[idx].Addr;
if FDebugger.Disassemble(Addr, False, NextAddr, Dump, Statement)
then begin
FLineMap[idx].State := lmsStatement;
FLineMap[idx].Dump := Dump;
FLineMap[idx].Statement := Statement;
end
else begin
FLineMap[idx].State := lmsUnknown;
end;
finally
FUpdating := False;
if FUpdateNeeded
then begin
FUpdateNeeded := False;
// check begin and end
UpdateLineData(FTopLine);
UpdateLineData(FTopLine + FLineCount);
end;
end;
end;
initialization
{$I assemblerdlg.lrs}
end.