add a scroll preview control, close #169

lazproj/coedit.lpi

@@ -10,10 +10,10 @@
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
       <XPManifest>
-        <DpiAware Value="True"/>
+        <DpiAware Value="True/PM"/>
       </XPManifest>
       <Icon Value="0"/>
-      <Resources Count="102">
+      <Resources Count="104">
         <Resource_0 FileName="../icons/window/layout_add.png" Type="RCDATA" ResourceName="LAYOUT_ADD"/>
         <Resource_1 FileName="../icons/window/layout.png" Type="RCDATA" ResourceName="LAYOUT"/>
         <Resource_2 FileName="../icons/window/application_go.png" Type="RCDATA" ResourceName="APPLICATION_GO"/>
@@ -109,21 +109,20 @@
         <Resource_92 FileName="../icons/other/play.png" Type="RCDATA" ResourceName="PLAY"/>
         <Resource_93 FileName="../icons/other/power.png" Type="RCDATA" ResourceName="POWER"/>
         <Resource_94 FileName="../icons/other/stop.png" Type="RCDATA" ResourceName="STOP"/>
-        <Resource_95 FileName="../icons/other/breaks.png" Type="RCDATA" ResourceName="BREAKS"/>
+        <Resource_95 FileName="../icons/other/step.png" Type="RCDATA" ResourceName="STEP"/>
-        <Resource_96 FileName="../icons/other/step.png" Type="RCDATA" ResourceName="STEP"/>
+        <Resource_96 FileName="../icons/arrow/go_down.png" Type="RCDATA" ResourceName="GO_DOWN"/>
-        <Resource_97 FileName="../icons/arrow/go_down.png" Type="RCDATA" ResourceName="GO_DOWN"/>
+        <Resource_97 FileName="../icons/arrow/go_jump.png" Type="RCDATA" ResourceName="GO_JUMP"/>
-        <Resource_98 FileName="../icons/arrow/go_jump.png" Type="RCDATA" ResourceName="GO_JUMP"/>
+        <Resource_98 FileName="../icons/window/watch_window.png" Type="RCDATA" ResourceName="WATCH_WINDOW"/>
-        <Resource_99 FileName="../icons/window/watch_window.png" Type="RCDATA" ResourceName="WATCH_WINDOW"/>
+        <Resource_99 FileName="../icons/other/camera_go.png" Type="RCDATA" ResourceName="CAMERA_GO"/>
-        <Resource_100 FileName="../icons/other/camera_go.png" Type="RCDATA" ResourceName="CAMERA_GO"/>
+        <Resource_100 FileName="../icons/other/camera_add.png" Type="RCDATA" ResourceName="CAMERA_ADD"/>
-        <Resource_101 FileName="../icons/other/camera_add.png" Type="RCDATA" ResourceName="CAMERA_ADD"/>
+        <Resource_101 FileName="../icons/other/warning.png" Type="RCDATA" ResourceName="WARNING"/>
+        <Resource_102 FileName="../icons/other/break_reached.png" Type="RCDATA" ResourceName="BREAK_REACHED"/>
+        <Resource_103 FileName="../icons/other/break_set.png" Type="RCDATA" ResourceName="BREAK_SET"/>
       </Resources>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="3">
       <Item1 Name="Release" Default="True"/>
       <Item2 Name="Debug">
@@ -247,7 +246,7 @@
         <PackageName Value="LCL"/>
       </Item8>
     </RequiredPackages>
-    <Units Count="58">
+    <Units Count="59">
       <Unit0>
         <Filename Value="coedit.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -550,6 +549,10 @@
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
       </Unit57>
+      <Unit58>
+        <Filename Value="..\src\ce_editorconfigfile.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit58>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

src/ce_editoroptions.pas

@@ -71,6 +71,7 @@ type
     fTransparentGutter: boolean;
     fDscannerDelay: integer;
     fDscannerEnabled: boolean;
+    fScrollPreview: boolean;
     //
     procedure setPhobosDocRoot(value: TCEPathname);
     procedure setFont(value: TFont);
@@ -128,6 +129,7 @@ type
     property rightEdgeColor: TColor read fRightEdgeColor write fRightEdgeColor default clSilver;
     property selection: TSynSelectedColor read fSelAttribs write setSelCol;
     property shortcuts: TCollection read fShortCuts write setShortcuts;
+    property scrollPreview: boolean read fScrollPreview write fScrollPreview;
     property smartDdocNewline: boolean read fSmartDdocNewline write fSmartDdocNewline;
     property tabulationWidth: Integer read fTabWidth write fTabWidth default 4;
     property transparentGutter: boolean read fTransparentGutter write fTransparentGutter default false;
@@ -335,6 +337,7 @@ begin
     fAutoCallCompletion:= srcopt.fAutoCallCompletion;
     fCloseCompletionChars:=srcopt.fCloseCompletionChars;
     fCloseCompletionCharsWithSpace:=srcopt.fCloseCompletionCharsWithSpace;
+    fScrollPreview:=srcopt.fScrollPreview;
 
     fSmartDdocNewline:=srcopt.fSmartDdocNewline;
     if fSmartDdocNewline then
@@ -719,6 +722,7 @@ begin
   anEditor.completionMenuAutoClose:=fCompletionMenuAutoClose;
   anEditor.transparentGutter:=fTransparentGutter;
   anEditor.setDscannerOptions(fDscannerEnabled, fDscannerDelay);
+  anEditor.scrollPreview:=fScrollPreview;
 
   cs := [];
   for c in fCloseCompletionCharsWithSpace do

src/ce_synmemo.pas

@@ -155,9 +155,25 @@ type
 
   //TODO-cGDB: add a system allowing to define watch points
 
+  // Partial read-only editor displayed as scroll hint
+  TCEScrollMemo = class(TPanel)
+  private
+    fMemo: TSynEdit;
+    fD2Hl: TSynD2Syn;
+    fTxtHl: TSynTxtSyn;
+    fSource: TCESynMemo;
+    procedure updateFromSource;
+  protected
+    procedure SetVisible(Value: Boolean); override;
+  public
+    constructor construct(editor: TCESynMemo);
+    procedure goToLine(value: integer);
+  end;
+
   TCESynMemo = class(TSynEdit, ICEDebugObserver)
   private
     //fIndentGuideMarkup: TSynEditMarkupFoldColors;
+    fScrollMemo: TCEScrollMemo;
     fFilename: string;
     fDastWorxExename: string;
     fModified: boolean;
@@ -219,6 +235,7 @@ type
     fCanDscan: boolean;
     fKnowsDscanner: boolean;
     fDscannerEnabled: boolean;
+    fScrollPreview: boolean;
     procedure showHintEvent(Sender: TObject; HintInfo: PHintInfo);
     procedure setGutterTransparent(value: boolean);
     procedure decCallTipsLvl;
@@ -362,6 +379,7 @@ type
     property closeCompletionCharsWithSpace: TSysCharSet read fCloseCompletionCharsWithSpace write fCloseCompletionCharsWithSpace;
     property closeCompletionChars: TSysCharSet read fCloseCompletionChars write fCloseCompletionChars;
     property completionMenuAutoClose: boolean read fCompletionMenuAutoClose write fCompletionMenuAutoClose;
+    property scrollPreview: boolean read fScrollPreview write fScrollPreview;
   end;
 
   TSortDialog = class(TForm)
@@ -748,6 +766,73 @@ begin
 end;
 {$ENDREGION --------------------------------------------------------------------}
 
+{$REGION TCEScrollMemo ---------------------------------------------------------}
+constructor TCEScrollMemo.construct(editor: TCESynMemo);
+begin
+  inherited create(editor);
+  visible := false;
+
+  parent := editor;
+  width := 475;
+  height := 275;
+  CaptureMouseButtons:=[];
+
+  fMemo:= TSynEdit.Create(self);
+  fMemo.Parent := self;
+  fMemo.Align:= alCLient;
+  fMemo.ReadOnly:=true;
+  fMemo.ScrollBars:=ssNone;
+  fMemo.MouseActions.Clear;
+  fMemo.Keystrokes.Clear;
+  fMemo.CaptureMouseButtons:=[];
+
+  fD2Hl:= TSynD2Syn.create(self);
+  fTxtHl:= TSynTxtSyn.Create(self);
+
+  fSource:= editor;
+  updateFromSource();
+end;
+
+procedure TCEScrollMemo.updateFromSource;
+begin
+  fMemo.Font.Assign(fSource.Font);
+  fMemo.Lines := fSource.Lines;
+  if fSource.Highlighter.isNotNil then
+  begin
+    fMemo.Color:= fSource.Color;
+    fMemo.LineHighlightColor.Assign(fSource.LineHighlightColor);
+    fMemo.SelectedColor.Assign(fSource.SelectedColor);
+    if fSource.Highlighter is TSynD2Syn then
+    begin
+      fD2Hl.Assign(fSource.Highlighter);
+      fMemo.Highlighter := fD2Hl;
+    end
+    else
+    begin
+      fTxtHl.Assign(fSource.Highlighter);
+      fMemo.Highlighter := fTxtHl;
+    end;
+  end;
+end;
+
+procedure TCEScrollMemo.SetVisible(Value: Boolean);
+var
+  o: boolean;
+begin
+  o := IsVisible();
+  inherited;
+  if (o <> value) and value then
+    updateFromSource;
+end;
+
+procedure TCEScrollMemo.goToLine(value: integer);
+begin
+  fMemo.CaretY := value;
+  fMemo.SelectLine(true);
+  fMemo.CaretX := 1;
+end;
+{$ENDREGION}
+
 {$REGION TCESynMemo ------------------------------------------------------------}
 
 {$REGION Standard Obj and Comp -------------------------------------------------}
@@ -755,6 +840,8 @@ constructor TCESynMemo.Create(aOwner: TComponent);
 begin
   inherited;
 
+  fScrollMemo := TCEScrollMemo.construct(self);
+
   OnShowHint:= @showHintEvent;
   OnStatusChange:= @handleStatusChanged;
   fDefaultFontSize := 10;
@@ -962,6 +1049,7 @@ begin
   fFocusForInput := false;
   hideDDocs;
   hideCallTips;
+  fScrollMemo.Visible:=false;
   if fCompletion.IsActive then
     fCompletion.Deactivate;
 end;
@@ -976,9 +1064,11 @@ begin
       loadCache;
     fCacheLoaded := true;
   end
-  else begin
+  else
+  begin
     hideDDocs;
     hideCallTips;
+    fScrollMemo.Visible:=false;
     if fCompletion.IsActive then
       fCompletion.Deactivate;
   end;
@@ -3038,6 +3128,22 @@ begin
   fMousePos := PixelsToRowColumn(fOldMousePos);
   if ssLeft in Shift then
     highlightCurrentIdentifier;
+
+  if fScrollPreview then
+  begin
+    if (x > width - 40) and (x < width - 1) then
+    begin;
+      fScrollMemo.Visible:=true;
+      fScrollMemo.goToLine((lines.Count div height) * (Y));
+      fScrollMemo.left := width - 40 - fScrollMemo.Width;
+      fScrollMemo.Top:= Y - 5;
+    end
+    else
+    begin
+      fScrollMemo.Visible:=false;
+    end;
+  end;
+
 end;
 
 procedure TCESynMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer);
@@ -3056,8 +3162,20 @@ begin
 end;
 
 procedure TCESynMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:Integer);
+var
+  pt: TPoint;
 begin
   inherited;
+  if fScrollPreview and fScrollMemo.Visible and (button = mbLeft) then
+  begin
+    pt := Mouse.CursorPos;
+    pt.x:= pt.x - 40;
+    CaretY := fScrollMemo.fMemo.CaretY;
+    EnsureCursorPosVisible;
+    fScrollMemo.Visible:=false;
+    mouse.CursorPos := pt;
+    fPositions.store;
+  end;
   case Button of
     mbMiddle: if (Shift = [ssCtrl]) then
       Font.Size := fDefaultFontSize;