lazarus/components/synedit/synguttercodefolding.pp
2010-08-08 00:35:06 +00:00

653 lines
20 KiB
ObjectPascal

unit SynGutterCodeFolding;
{$I synedit.inc}
interface
uses
SysUtils, Classes, Controls, Graphics, Menus, LCLIntf, SynGutterBase, SynEditMiscProcs,
SynEditFoldedView, SynEditMouseCmds, SynEditHighlighterFoldBase, LCLProc, ImgList;
type
{ TSynEditMouseActionsGutterFold }
TSynEditMouseActionsGutterFold = class(TSynEditMouseActions)
public
procedure ResetDefaults; override;
end;
// Line with [-] => ALL nodes expanded
{ TSynEditMouseActionsGutterFoldExpanded }
TSynEditMouseActionsGutterFoldExpanded = class(TSynEditMouseActions)
public
procedure ResetDefaults; override;
end;
// Line with [+] => at LEAST ONE node collapsed
{ TSynEditMouseActionsGutterFoldCollapsed }
TSynEditMouseActionsGutterFoldCollapsed = class(TSynEditMouseActions)
public
procedure ResetDefaults; override;
end;
{ TSynGutterCodeFolding }
TSynGutterCodeFolding = class(TSynGutterPartBase)
private
FMouseActionsCollapsed: TSynEditMouseActions;
FMouseActionsExpanded: TSynEditMouseActions;
FPopUp: TPopupMenu;
FMenuInf: Array of TFoldViewNodeInfo;
FIsFoldHidePreviousLine: Boolean;
FPopUpImageList: TImageList;
FReversePopMenuOrder: Boolean;
procedure SetMouseActionsCollapsed(const AValue: TSynEditMouseActions);
procedure SetMouseActionsExpanded(const AValue: TSynEditMouseActions);
function FoldTypeForLine(AScreenLine: Integer): TSynEditFoldLineCapability;
function IsFoldHidePreviousLine(AScreenLine: Integer): Boolean;
function IsSingleLineHide(AScreenLine: Integer): Boolean;
procedure InitPopUpImageList;
procedure DrawNodeSymbol(Canvas: TCanvas; Rect: TRect;
NodeType: TSynEditFoldLineCapability;
SubType: Integer);
protected
function PreferedWidth: Integer; override;
procedure CreatePopUpMenuEntries(APopUp: TPopupMenu; ALine: Integer); virtual;
procedure PopClicked(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint(Canvas: TCanvas; AClip: TRect; FirstLine, LastLine: integer);
override;
procedure DoOnGutterClick(X, Y: integer); override;
function MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean; override;
function DoHandleMouseAction(AnAction: TSynEditMouseAction;
var AnInfo: TSynEditMouseActionInfo): Boolean; override;
published
property MarkupInfo;
property MouseActionsExpanded: TSynEditMouseActions
read FMouseActionsExpanded write SetMouseActionsExpanded;
property MouseActionsCollapsed: TSynEditMouseActions
read FMouseActionsCollapsed write SetMouseActionsCollapsed;
property ReversePopMenuOrder: Boolean
read FReversePopMenuOrder write FReversePopMenuOrder default True;
end;
implementation
uses
SynEdit;
{ TSynGutterCodeFolding }
procedure TSynGutterCodeFolding.SetMouseActionsCollapsed(const AValue: TSynEditMouseActions);
begin
if AValue = nil then
FMouseActionsCollapsed.Clear
else
FMouseActionsCollapsed.Assign(AValue);
end;
procedure TSynGutterCodeFolding.SetMouseActionsExpanded(const AValue: TSynEditMouseActions);
begin
if AValue = nil then
FMouseActionsExpanded.Clear
else
FMouseActionsExpanded.Assign(AValue);
end;
function TSynGutterCodeFolding.FoldTypeForLine(AScreenLine: Integer): TSynEditFoldLineCapability;
var
tmp, tmp2: TSynEditFoldLineCapabilities;
begin
tmp := FoldView.FoldType[AScreenLine];
tmp2 := FoldView.FoldType[AScreenLine-1];
FIsFoldHidePreviousLine := False;
if (AScreenLine = 0) and (FoldView.TextIndexToViewPos(FoldView.TextIndex[0]) = 1) and
(cfCollapsedHide in tmp2)
then begin
Result := cfCollapsedHide;
FIsFoldHidePreviousLine := True;
end
//if tmp * [cfHideStart, cfFoldStart, cfCollapsedFold] = [cfHideStart, cfFoldStart, cfCollapsedFold]
// then Result := cfHideStart
else if cfCollapsedFold in tmp then Result := cfCollapsedFold
else if cfCollapsedHide in tmp then Result := cfCollapsedHide
else if cfFoldStart in tmp then Result := cfFoldStart
else if cfHideStart in tmp then Result := cfHideStart
else if cfFoldEnd in tmp then Result := cfFoldEnd
else if cfFoldBody in tmp then Result := cfFoldBody
else
Result := cfNone;
if Result in [cfFoldBody, cfFoldEnd] then begin
tmp := FoldView.FoldType[AScreenLine - 1];
if tmp * [cfHideStart, cfFoldStart, cfCollapsedFold, cfCollapsedHide]
= [cfHideStart, cfFoldStart]
then begin
FIsFoldHidePreviousLine := True;
Result := cfHideStart // hide for previous line
end;
end;
end;
function TSynGutterCodeFolding.IsFoldHidePreviousLine(AScreenLine: Integer): Boolean;
begin
FoldTypeForLine(AScreenLine);
Result := FIsFoldHidePreviousLine;
end;
function TSynGutterCodeFolding.IsSingleLineHide(AScreenLine: Integer): Boolean;
var
tmp: TSynEditFoldLineCapabilities;
begin
Result := False;
tmp := FoldView.FoldType[AScreenLine];
if tmp * [cfHideStart, cfFoldStart, cfCollapsedFold] =
[cfHideStart, cfFoldStart, cfCollapsedFold]
then
Result := True;
if cfSingleLineHide in tmp then
Result := True;
end;
procedure TSynGutterCodeFolding.InitPopUpImageList;
var
img: TBitmap;
procedure NewImg;
begin
img := TBitmap.Create;
img.SetSize(16, 16);
img.Canvas.Brush.Color := clWhite;
img.Canvas.FillRect(0,0,16,16);
img.TransparentColor := clWhite;
img.Canvas.Pen.Color := clBlack;
img.Canvas.Pen.Width := 1;
end;
begin
FPopUpImageList.DrawingStyle := dsTransparent;
NewImg;
DrawNodeSymbol(img.Canvas, Rect(3,3,14,14), cfFoldStart, 0); // [-]
FPopUpImageList.Add(img, nil);
img.Free;
NewImg;
DrawNodeSymbol(img.Canvas, Rect(3,3,14,14), cfCollapsedFold, 0); // [+]
FPopUpImageList.Add(img, nil);
img.Free;
NewImg;
DrawNodeSymbol(img.Canvas, Rect(3,3,14,14), cfHideStart, 0); // [.]
FPopUpImageList.Add(img, nil);
img.Free;
NewImg;
DrawNodeSymbol(img.Canvas, Rect(3,3,14,14), cfCollapsedHide, 0); // [v]
FPopUpImageList.Add(img, nil);
img.Free;
end;
procedure TSynGutterCodeFolding.CreatePopUpMenuEntries(APopUp: TPopupMenu;
ALine: Integer);
function AddPopUpItem(const ACaption: String): TMenuItem;
begin
Result := TMenuItem.Create(APopUp);
Result.OnClick := {$IFDEF FPC}@{$ENDIF}PopClicked;
Result.Caption := ACaption;
if FReversePopMenuOrder then
APopUp.Items.Add(Result)
else
APopUp.Items.Insert(0, Result);
end;
var
c, i: Integer;
inf: TFoldViewNodeInfo;
m: TMenuItem;
s, s2: String;
begin
c := FoldView.OpenFoldCount(ALine-1);
if c > 0 then begin
SetLength(FMenuInf,c);
for i := c-1 downto 0 do begin
inf := FoldView.OpenFoldInfo(ALine-1, i);
if sfaInvalid in inf.HNode.FoldAction then
continue;
FMenuInf[i] := inf;
if (i < c-1) and (FMenuInf[i+1].LineNum = ALine) and (inf.LineNum <> ALine)
then begin
m := AddPopUpItem(cLineCaption);
m.Tag := -1;
end;
s := copy(inf.Text, 1, inf.HNode.LogXStart-1);
if length(s) > 30 then s := copy(s,1,15) + '...' + copy(s, inf.HNode.LogXStart-11,10);
s := s + copy(inf.Text, inf.HNode.LogXStart, 30 + (30 - length(s)));
s2 := '';
if inf.OpenCount > 1 then
s2 := format(' (%d/%d)', [inf.ColIndex+1, inf.OpenCount]);
if inf.FNode.IsInFold then begin
m := AddPopUpItem(format('%4d %s '#9'%s', [ inf.LineNum, inf.Keyword+s2+':', s]));
m.Tag := i;
if inf.FNode.IsHide then
m.ImageIndex := 3
else
m.ImageIndex := 1;
end
else begin
if sfaFoldFold in inf.HNode.FoldAction then begin
m := AddPopUpItem(format('%4d %s '#9'%s', [ inf.LineNum, inf.Keyword+s2+':', s]));
m.Tag := i;
m.ImageIndex := 0;
end;
if sfaFoldHide in inf.HNode.FoldAction then begin
if sfaFoldFold in inf.HNode.FoldAction then
m := AddPopUpItem(format('%4d %s ', [ inf.LineNum, inf.Keyword+s2 ]))
else
m := AddPopUpItem(format('%4d %s '#9'%s', [ inf.LineNum, inf.Keyword+s2+':', s]));
m.Tag := i;
m.ImageIndex := 2;
end;
end;
end;
end;
end;
constructor TSynGutterCodeFolding.Create(AOwner: TComponent);
begin
FReversePopMenuOrder := true;
FMouseActions := TSynEditMouseActionsGutterFold.Create(self);
FMouseActionsExpanded := TSynEditMouseActionsGutterFoldExpanded.Create(self);
FMouseActionsCollapsed := TSynEditMouseActionsGutterFoldCollapsed.Create(self);
FMouseActions.ResetDefaults;
FMouseActionsCollapsed.ResetDefaults;
FMouseActionsExpanded.ResetDefaults;
FPopUpImageList := TImageList.Create(nil);
InitPopUpImageList;
FPopUp := TPopupMenu.Create(nil);
FPopUp.Images := FPopUpImageList;
inherited Create(AOwner);
MarkupInfo.Background := clNone;
MarkupInfo.Foreground := clDkGray;
MarkupInfo.FrameColor := clNone;
end;
destructor TSynGutterCodeFolding.Destroy;
begin
FreeAndNil(FMouseActions);
FreeAndNil(FMouseActionsCollapsed);
FreeAndNil(FMouseActionsExpanded);
FreeAndNil(FPopUp);
FreeAndNil(FPopUpImageList);
inherited Destroy;
end;
procedure TSynGutterCodeFolding.PopClicked(Sender: TObject);
var
inf: TFoldViewNodeInfo;
begin
inf := FMenuInf[(Sender as TMenuItem).tag];
if inf.LineNum < 0 then exit;
case (Sender as TMenuItem).ImageIndex of
0: FoldView.FoldAtTextIndex(inf.LineNum-1, inf.ColIndex, 1, False);
1: FoldView.UnFoldAtTextIndex(inf.LineNum-1, inf.ColIndex, 1, False);
2: FoldView.FoldAtTextIndex(inf.LineNum-1, inf.ColIndex, 1, False, 0);
3: FoldView.UnFoldAtTextIndex(inf.LineNum-1, inf.ColIndex, 1, False, 0);
end;
end;
procedure TSynGutterCodeFolding.DoOnGutterClick(X, Y : integer);
begin
// Do Nothing
end;
function TSynGutterCodeFolding.MaybeHandleMouseAction(var AnInfo: TSynEditMouseActionInfo;
HandleActionProc: TSynEditMouseActionHandler): Boolean;
var
tmp: TSynEditFoldLineCapability;
begin
Result := False;
tmp := FoldTypeForLine(FoldView.TextIndexToScreenLine(AnInfo.NewCaret.LinePos-1));
case tmp of
cfCollapsedFold, cfCollapsedHide:
Result := HandleActionProc(MouseActionsCollapsed, AnInfo);
cfFoldStart, cfHideStart:
Result := HandleActionProc(MouseActionsExpanded, AnInfo);
end;
if not Result then
Result := HandleActionProc(MouseActions, AnInfo);
end;
function TSynGutterCodeFolding.DoHandleMouseAction(AnAction: TSynEditMouseAction;
var AnInfo: TSynEditMouseActionInfo): Boolean;
var
i, line, ScrLine: Integer;
ACommand: Word;
KeepVisible: Integer;
begin
Result := False;
if AnAction = nil then exit;
ACommand := AnAction.Command;
if (ACommand = emcNone) then exit;
line := AnInfo.NewCaret.LinePos;
ScrLine := FoldView.TextIndexToScreenLine(Line-1);
KeepVisible := 1;
if FoldTypeForLine(ScrLine) = cfHideStart then KeepVisible := 0;
if (FoldTypeForLine(ScrLine) = cfCollapsedHide) then begin
if IsFoldHidePreviousLine(ScrLine) then
line := FoldView.TextIndex[ScrLine-1] + 1;
inc(line);
KeepVisible := 0;
end
else
if IsFoldHidePreviousLine(ScrLine) then dec(line);
Result := True;
case ACommand of
emcCodeFoldCollaps:
begin
case AnAction.Option of
emcoCodeFoldCollapsOne:
begin
FoldView.FoldAtTextIndex(Line-1, -1, 1, True, KeepVisible);
end;
emcoCodeFoldCollapsAll:
begin
FoldView.FoldAtTextIndex(Line-1, -1, 0, False, KeepVisible);
end;
emcoCodeFoldCollapsAtCaret:
// Keyword at mouseclick/caret position
begin
i := FoldView.LogicalPosToNodeIndex(Line-1, AnInfo.NewCaret.BytePos, False);
if i >= 0 then
FoldView.FoldAtTextIndex(Line-1, i, 1, False, KeepVisible)
else
Result := False;
end;
emcoCodeFoldCollapsPreCaret:
// mouseclick/caret position anywhere inside the fold
begin
i := FoldView.LogicalPosToNodeIndex(Line-1, AnInfo.NewCaret.BytePos, True);
if i >= 0 then
FoldView.FoldAtTextIndex(Line-1, i, 1, False, KeepVisible)
else begin
i := FoldView.ExpandedLineForBlockAtLine(Line);
if i > 0 then
FoldView.FoldAtTextIndex(i-1, -1, 1, True, KeepVisible);
end;
end;
end;
end;
emcCodeFoldExpand:
begin
case AnAction.Option of
emcoCodeFoldExpandOne:
FoldView.UnFoldAtTextIndex(line-1, 0, 1, True, KeepVisible);
emcoCodeFoldExpandAll:
FoldView.UnFoldAtTextIndex(line-1, -1, 0, False, KeepVisible);
end;
end;
emcCodeFoldContextMenu:
begin
FPopUp.Items.Clear;
CreatePopUpMenuEntries(FPopUp, line);
FPopUp.PopUp;
end;
else
Result := False;
end;
end;
procedure TSynGutterCodeFolding.DrawNodeSymbol(Canvas: TCanvas; Rect: TRect;
NodeType: TSynEditFoldLineCapability; SubType: Integer);
var
Points: Array [0..3] of TPoint;
X, Y: Integer;
begin
Canvas.Rectangle(Rect);
X := (Rect.Left - 1 + Rect.Right) div 2;
Y := (Rect.Top - 1 + Rect.Bottom) div 2;
case NodeType of
cfFoldStart:
begin
// [-]
Canvas.MoveTo(X - 2, Y);
Canvas.LineTo(X + 3, Y);
end;
cfHideStart:
begin
// [.]
Canvas.MoveTo(X, Y);
Canvas.LineTo(X + 1, Y);
end;
cfCollapsedFold:
begin
// [+]
Canvas.MoveTo(X - 2, Y);
Canvas.LineTo(X + 3, Y);
Canvas.MoveTo(X, Y - 2);
Canvas.LineTo(X, Y + 3);
end;
cfCollapsedHide:
begin
case SubType of
0: begin
// [v]
Points[0].X := X;
Points[0].y := Y + 2;
Points[1].X := X - 2;
Points[1].y := Y;
Points[2].X := X + 2;
Points[2].y := Y;
Points[3].X := X;
Points[3].y := Y + 2;
end;
1: begin
// [v]
Points[0].X := X;
Points[0].y := Y - 2;
Points[1].X := X - 2;
Points[1].y := Y;
Points[2].X := X + 2;
Points[2].y := Y;
Points[3].X := X;
Points[3].y := Y - 2;
end;
end;
Canvas.Polygon(Points);
end;
end;
end;
function TSynGutterCodeFolding.PreferedWidth: Integer;
begin
Result := 10;
end;
procedure TSynGutterCodeFolding.Paint(Canvas : TCanvas; AClip : TRect; FirstLine, LastLine : integer);
const cNodeOffset = 1;
var
iLine: integer;
rcLine: TRect;
rcCodeFold: TRect;
tmp: TSynEditFoldLineCapability;
LineHeight, LineOffset, BoxSize: Integer;
procedure DrawNodeBox(rcCodeFold: TRect; NodeType: TSynEditFoldLineCapability);
var
rcNode: TRect;
ptCenter : TPoint;
isPrevLine: Boolean;
i: Integer;
begin
isPrevLine := IsFoldHidePreviousLine(iLine);
LineOffset := 0;
//center of the draw area
ptCenter.X := (rcCodeFold.Left + rcCodeFold.Right) div 2;
ptCenter.Y := (rcCodeFold.Top + rcCodeFold.Bottom) div 2;
// If belongs to line above, draw at very top
if isPrevLine then
ptCenter.Y := rcCodeFold.Top + (BoxSize div 2) - 1;
//area of drawbox
rcNode.Left := ptCenter.X - (BoxSize div 2) + 1;
rcNode.Right := ptCenter.X + (BoxSize div 2);
rcNode.Top := ptCenter.Y - (BoxSize div 2) + 1;
rcNode.Bottom := ptCenter.Y + (BoxSize div 2);
Canvas.Brush.Style := bsClear;
//draw Paragraph end
if isPrevLine and (cfFoldEnd in FoldView.FoldType[iLine]) and
(rcCodeFold.Bottom-1 > rcNode.Bottom)
then begin
Canvas.MoveTo(ptCenter.X, rcNode.Bottom);
Canvas.LineTo(ptCenter.X, rcCodeFold.Bottom-1);
Canvas.LineTo(rcCodeFold.Right, rcCodeFold.Bottom-1);
LineOffset := min(2, (rcCodeFold.Top + rcCodeFold.Bottom) div 2);
end
else
//draw bottom handle to paragraph line
if (cfFoldBody in FoldView.FoldType[iLine + 1]) and
(not IsSingleLineHide(iLine))
then begin
Canvas.MoveTo(ptCenter.X, rcNode.Bottom);
Canvas.LineTo(ptCenter.X, rcCodeFold.Bottom);
end;
if (NodeType in [cfCollapsedFold, cfCollapsedHide]) and
(MarkupInfo.FrameColor <> clNone)
then
Canvas.Pen.Color := MarkupInfo.FrameColor;
i:= 0;
if isPrevLine and (NodeType = cfCollapsedHide) then i := 1;
DrawNodeSymbol(Canvas, rcNode, NodeType, i);
Canvas.Pen.Color := MarkupInfo.Foreground;
Canvas.Brush.Style := bsSolid;
end;
procedure DrawParagraphContinue(rcCodeFold: TRect);
var
iCenter : integer;
begin
//center of the draw area
iCenter := (rcCodeFold.Left + rcCodeFold.Right) div 2;
Canvas.MoveTo(iCenter, rcCodeFold.Top + LineOffset);
Canvas.LineTo(iCenter, rcCodeFold.Bottom);
LineOffset := 0;
end;
procedure DrawParagraphEnd(rcCodeFold: TRect);
var
X : Integer;
begin
//center of the draw area
X := (rcCodeFold.Left + rcCodeFold.Right) div 2;
Canvas.MoveTo(X, rcCodeFold.Top + LineOffset);
Canvas.LineTo(X, rcCodeFold.Bottom - 1);
Canvas.LineTo(rcCodeFold.Right, rcCodeFold.Bottom - 1);
LineOffset := min(2, (rcCodeFold.Top + rcCodeFold.Bottom) div 2);
end;
begin
if not Visible then exit;
LineHeight := TSynEdit(SynEdit).LineHeight;
LineOffset := 0;
if (FirstLine > 0) and
(FoldView.FoldType[FirstLine-1] - [cfFoldBody] = [cfFoldEnd]) then
LineOffset := 2;
BoxSize := Min(Width, LineHeight - cNodeOffset*2);
if MarkupInfo.Background <> clNone then
begin
Canvas.Brush.Color := MarkupInfo.Background;
LCLIntf.SetBkColor(Canvas.Handle, Canvas.Brush.Color);
Canvas.FillRect(AClip);
end;
with Canvas do
begin
Pen.Color := MarkupInfo.Foreground;
Pen.Width := 1;
rcLine.Bottom := FirstLine * LineHeight;
for iLine := FirstLine to LastLine do
begin
// next line rect
rcLine.Top := rcLine.Bottom;
Inc(rcLine.Bottom, LineHeight);
rcCodeFold.Left := AClip.Left;
rcCodeFold.Right := AClip.Left + self.Width;
rcCodeFold.Top := rcLine.Top;
rcCodeFold.Bottom := rcLine.Bottom;
tmp := FoldTypeForLine(iLine);
case tmp of
cfFoldStart, cfHideStart, cfCollapsedFold, cfCollapsedHide:
DrawNodeBox(rcCodeFold, tmp);
cfFoldBody:
DrawParagraphContinue(rcCodeFold);
cfFoldEnd:
DrawParagraphEnd(rcCodeFold);
else
LineOffset := 0;
end;
end;
end;
end;
{ TSynEditMouseActionsGutterFold }
procedure TSynEditMouseActionsGutterFold.ResetDefaults;
begin
Clear;
AddCommand(emcCodeFoldContextMenu, False, mbRight, ccSingle, cdUp, [], []);
AddCommand(emcCodeFoldCollaps, False, mbMiddle, ccAny, cdDown, [], [ssShift], emcoCodeFoldCollapsOne);
AddCommand(emcCodeFoldCollaps, False, mbMiddle, ccAny, cdDown, [ssShift], [ssShift], emcoCodeFoldCollapsAll);
AddCommand(emcNone, False, mbLeft, ccAny, cdDown, [], []);
end;
{ TSynEditMouseActionsGutterFoldExpanded }
procedure TSynEditMouseActionsGutterFoldExpanded.ResetDefaults;
begin
Clear;
AddCommand(emcCodeFoldCollaps, False, mbLeft, ccAny, cdDown, [], [], emcoCodeFoldCollapsOne);
end;
{ TSynEditMouseActionsGutterFoldCollapsed }
procedure TSynEditMouseActionsGutterFoldCollapsed.ResetDefaults;
begin
Clear;
AddCommand(emcCodeFoldExpand, False, mbLeft, ccAny, cdDown, [ssCtrl], [ssCtrl], emcoCodeFoldExpandOne);
AddCommand(emcCodeFoldExpand, False, mbLeft, ccAny, cdDown, [], [ssCtrl], emcoCodeFoldExpandAll);
end;
end.