dexed/src/u_synmemo.pas

4268 lines
118 KiB
Plaintext

unit u_synmemo;
{$I u_defines.inc}
interface
uses
Classes, SysUtils, controls,lcltype, Forms, graphics, ExtCtrls, crc, process,
SynEdit, SynPluginSyncroEdit, SynCompletion, SynEditKeyCmds, LazSynEditText,
SynHighlighterLFM, SynEditHighlighter, SynEditMouseCmds, SynEditFoldedView,
SynEditMarks, SynEditTypes, SynHighlighterJScript, SynBeautifier, dialogs,
md5, Spin, LCLIntf, LazFileUtils, LMessages, SynHighlighterCpp, math,
SynGutterBase, LCLVersion, SynEditMiscProcs,
Clipbrd, fpjson, jsonparser, LazUTF8, Buttons, StdCtrls,
u_common, u_writableComponent, u_d2syn, u_txtsyn, u_dialogs, u_sxsyn,
u_sharedres, u_dlang, u_stringrange, u_dbgitf, u_observer, u_diff,
u_processes, u_synmultiguttermarks;
type
TDexedMemo = class;
TIdentifierMatchOption = (
caseSensitive = longInt(ssoMatchCase),
wholeWord = longInt(ssoWholeWord)
);
TBraceAutoCloseStyle = (
autoCloseNever,
autoCloseLexically,
autoCloseOnNewLineLexically
);
TAutoClosedPair = (
autoCloseSingleQuote,
autoCloseDoubleQuote,
autoCloseBackTick,
autoCloseSquareBracket
);
TAutoClosePairs = set of TAutoClosedPair;
TBraceCloseOption = (
braceClosePositive,
braceCloseLessEven,
braceCloseInvalid
);
const
autoClosePair2Char: array[TAutoClosedPair] of char = (#39, '"', '`', ']');
type
TIdentifierMatchOptions = set of TIdentifierMatchOption;
// Simple THintWindow derived that keep its font size in sync with the editor.
TEditorHintWindow = class(THintWindow)
public
class var FontSize: Integer;
function CalcHintRect(MaxWidth: Integer; const AHint: string;
AData: Pointer): TRect; override;
end;
// Specialized to allow displaying call tips
TEditorCallTipWindow = class(TEditorHintWindow)
strict private
fIndexOfExpectedArg: integer;
fActivating: boolean;
public
// like ActivateHint(string) but
// prevent overzealous opimizations that prevent flickering
// but that become a problem when the hint string is dynamic.
procedure ActivateDynamicHint(const AHint: String);
function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
procedure Paint; override;
property indexOfExpectedArg: integer write fIndexOfExpectedArg;
end;
// Stores the state of a particular source code folding.
TFoldCache = class(TCollectionItem)
private
fCollapsed: boolean;
fLineIndex: Integer;
fNestedIndex: Integer;
published
property isCollapsed: boolean read fCollapsed write fCollapsed;
property lineIndex: Integer read fLineIndex write fLineIndex;
property nestedIndex: Integer read fNestedIndex write fNestedIndex;
end;
// Stores the state of a document between two sessions.
TSynMemoCache = class(TWritableLfmTextComponent)
private
fMemo: TDexedMemo;
fFolds: TCollection;
fCaretPosition: Integer;
fSelectionEnd: Integer;
fFontSize: Integer;
fFontHeight: Integer;
fSourceFilename: string;
procedure setFolds(someFolds: TCollection);
published
property caretPosition: Integer read fCaretPosition write fCaretPosition;
property sourceFilename: string read fSourceFilename write fSourceFilename;
property folds: TCollection read fFolds write setFolds;
property selectionEnd: Integer read fSelectionEnd write fSelectionEnd;
property fontSize: Integer read fFontSize write fFontSize;
property fontHeight: Integer read fFontHeight write fFontHeight;
public
constructor create(aComponent: TComponent); override;
destructor destroy; override;
procedure beforeSave; override;
procedure afterLoad; override;
procedure save;
procedure load;
end;
// Caret positions buffer allowing to jump fast to the most recent locations.
// Replaces the bookmarks.
TSynMemoPositions = class
private
fPos: Integer;
fMax: Integer;
fList: TFPList;
fMemo: TCustomSynEdit;
public
constructor create(memo: TCustomSynEdit);
destructor destroy; override;
procedure store;
procedure back;
procedure next;
end;
PDscannerResult = ^TDscannerResult;
TDscannerResult = record
warning: string;
line, column: integer;
end;
TDscannerResults = class
private
fList: TFPList;
function getItem(index: integer): PDscannerResult;
function getCount: integer;
public
constructor create;
destructor destroy; override;
procedure clear;
procedure push(const warning: string; line, column: integer);
property count: integer read getCount;
property item[index: integer]: PDscannerResult read getItem; default;
end;
TSortDialog = class;
TGutterIcon = (
giBreakSet = 0, // breakpoint set here
giBulletGreen = 1,
giBulletBlack = 2,
giBreakReached= 3, // break point reached
giStep = 4, // step / signal / pause
giWatch = 5, // watch point reached
giWarn = 6 // Dscanner result with text hint
);
const debugTimeGutterIcons = [giBreakReached, giStep, giWatch];
type
//TODO-cGDB: add a system allowing to define watch points
// Partial read-only editor displayed as scroll hint
TScrollMemo = class(TPanel)
private
fMemo: TSynEdit;
fD2Hl: TSynD2Syn;
fTxtHl: TSynTxtSyn;
fCppHl: TSynCppSyn;
fSource: TDexedMemo;
procedure updateFromSource;
protected
procedure SetVisible(Value: Boolean); override;
public
constructor construct(editor: TDexedMemo);
procedure goToLine(value: integer);
end;
{ TDexedMemo }
TDexedMemo = class(TSynEdit, IDebugObserver)
private
fLifeTimeManager: TObject;
fIdentDialShown: boolean;
fScrollMemo: TScrollMemo;
fFilename: string;
fModified: boolean;
fFileDate: double;
fCacheLoaded: boolean;
fIsDSource: boolean;
fFocusForInput: boolean;
fHighlightedIdent: string;
fTempFileName: string;
fMultiDocSubject: TObject;
fDefaultFontSize: Integer;
fPositions: TSynMemoPositions;
fMousePhysical: TPoint;
fMouseLogical: TPoint;
fCallTipWin: TEditorCallTipWindow;
fDDocWin: TEditorHintWindow;
fDDocDelay: Integer;
fAutoDotDelay: Integer;
fDscannerDelay: Integer;
fDDocTimer: TIdleTimer;
fAutoDotTimer: TIdleTimer;
fDscannerTimer: TIdleTimer;
fCanShowHint: boolean;
fCanAutoDot: boolean;
fOldMousePos: TPoint;
fSyncEdit: TSynPluginSyncroEdit;
fCompletion: TSynCompletion;
fD2Highlighter: TSynD2Syn;
fTxtHighlighter: TSynTxtSyn;
fCppHighlighter: TSynCppSyn;
fSxHighlighter: TSynSxSyn;
fImages: TImageList;
fMatchSelectionOpts: TSynSearchOptions;
fMatchIdentOpts: TSynSearchOptions;
fMatchOpts: TIdentifierMatchOptions;
fOverrideColMode: boolean;
fAutoCloseCurlyBrace: TBraceAutoCloseStyle;
fSmartDdocNewline: boolean;
fLexToks: TLexTokenList;
fDisableFileDateCheck: boolean;
fDetectIndentMode: boolean;
fPhobosDocRoot: string;
fAlwaysAdvancedFeatures: boolean;
fIsProjectDescription: boolean;
fAutoClosedPairs: TAutoClosePairs;
fSortDialog: TSortDialog;
fModuleTokFound: boolean;
fHasModuleDeclaration: boolean;
fLastCompletion: string;
fDebugger: IDebugger;
fInsertPlusDdoc: boolean;
fAutoCallCompletion: boolean;
fCloseCompletionCharsWithSpace: TSysCharSet;
fCloseCompletionChars: TSysCharSet;
fCompletionMenuAutoClose: boolean;
fTransparentGutter: boolean;
fDscanner: TDexedProcess;
fDscannerResults: TDscannerResults;
fCanDscan: boolean;
fKnowsDscanner: boolean;
fDscannerEnabled: boolean;
fScrollPreview: boolean;
fDiffDialogWillClose: boolean;
fMultiGutterMarks: TSynMultiGutterMarks;
fTextCompletion: boolean;
fTextCompletionMinLength: integer;
fLastUp: word;
procedure showHintEvent(Sender: TObject; HintInfo: PHintInfo);
procedure setGutterTransparent(value: boolean);
procedure decCallTipsLvl;
procedure setMatchOpts(value: TIdentifierMatchOptions);
function getMouseBytePosition: Integer;
procedure changeNotify(Sender: TObject);
procedure highlightCurrentIdentifier(fromEditor: boolean = true);
procedure saveCache;
procedure loadCache;
class procedure cleanCache; static;
procedure setDefaultFontSize(value: Integer);
procedure DDocTimerEvent(sender: TObject);
procedure AutoDotTimerEvent(sender: TObject);
procedure dscannerTimerEvent(sender: TObject);
procedure dscannerTerminate(sender: TObject);
procedure removeDscannerWarnings;
function getDscannerWarning(line: integer): string;
function lineHasDscannerWarning(line: integer): boolean;
procedure InitHintWins;
function getIfTemp: boolean;
procedure setDDocDelay(value: Integer);
procedure setAutoDotDelay(value: Integer);
procedure completionExecute(sender: TObject);
procedure completionDeleteKey(sender: TObject);
procedure getCompletionList;
procedure completionFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
function completionItemPaint(const AKey: string; ACanvas: TCanvas;X, Y: integer;
Selected: boolean; Index: integer): boolean;
procedure completionCodeCompletion(var value: string; SourceValue: string;
var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char; Shift: TShiftState);
procedure showCallTipsString(const tips: string; indexOfExpected: integer);
function lexCanCloseBrace: TBraceCloseOption;
function canInsertLeadingDdocSymbol: char;
function autoIndentationLevel(line: Integer): Integer;
procedure handleStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
procedure goToChangedArea(next: boolean);
procedure goToProtectionGroup(next: boolean);
procedure goToWarning(next: boolean);
procedure autoClosePair(value: TAutoClosedPair);
procedure setSelectionOrWordCase(upper: boolean);
procedure sortSelectedLines(descending, caseSensitive: boolean);
procedure tokFoundForCaption(const token: PLexToken; out stop: boolean);
procedure addGutterIcon(line: integer; value: TGutterIcon);
procedure removeGutterIcon(line: integer; value: TGutterIcon);
procedure patchClipboardIndentation;
procedure gotoWordEdge(right: boolean);
procedure lexWholeText(opts: TLexOptions = []);
//
procedure gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
procedure removeDebugTimeMarks;
function isGutterIconSet(line: integer; value: TGutterIcon): boolean;
function findBreakPoint(line: integer): boolean;
procedure debugStart(debugger: IDebugger);
procedure debugStop;
procedure debugContinue;
function debugQueryBpCount: integer;
procedure debugQueryBreakPoint(const line: integer; out fname: string; out kind: TBreakPointKind);
procedure debugBreak(const fname: string; line: integer; reason: TDebugBreakReason);
function breakPointsCount: integer;
procedure tryToPatchMixedIndentation;
procedure setHighligthedIdent(value: string);
protected
procedure DoEnter; override;
procedure DoExit; override;
procedure DoOnProcessCommand(var Command: TSynEditorCommand; var AChar: TUTF8Char;
Data: pointer); override;
procedure MouseLeave; override;
procedure SetVisible(Value: Boolean); override;
procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
procedure SetHighlighter(const Value: TSynCustomHighlighter); override;
procedure UTF8KeyPress(var Key: TUTF8Char); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
public
constructor Create(aOwner: TComponent); override;
destructor destroy; override;
procedure setFocus; override;
procedure showPage;
//
function pageCaption(checkModule: boolean): string;
procedure checkFileDate;
procedure loadFromFile(const fname: string);
procedure saveToFile(const fname: string);
procedure save;
procedure saveTempFile;
//
function indentationMode(out numTabs, numSpaces: integer): TIndentationMode;
procedure forceIndentation(m: TIndentationMode; w: integer);
procedure addBreakPoint(line: integer);
procedure removeBreakPoint(line: integer);
procedure curlyBraceCloseAndIndent(close: boolean = true);
procedure insertLeadingDDocSymbol(c: char);
procedure commentSelection;
procedure commentIdentifier;
procedure renameIdentifier;
procedure invertVersionAllNone;
procedure showCallTips(findOpenParen: boolean = true);
procedure hideCallTips;
procedure showDDocs;
procedure hideDDocs;
procedure ShowPhobosDoc;
procedure previousChangedArea;
procedure nextChangedArea;
procedure previousProtectionGroup;
procedure nextProtectionGroup;
procedure previousWarning;
procedure nextWarning;
procedure sortLines;
procedure addCurLineBreakPoint;
procedure removeCurLineBreakPoint;
procedure toggleCurLineBreakpoint;
procedure insertDdocTemplate;
procedure gotoLinePrompt;
procedure showWarningForLine(line: integer);
procedure showCurLineWarning;
function implementMain: THasMain;
procedure replaceUndoableContent(const value: string);
procedure setDscannerOptions(dsEnabled: boolean; dsDelay: integer);
procedure centerCursor();
procedure redoAll();
procedure undoAll();
procedure scrollCentered(down: boolean);
procedure setHighligtherFrom(other: TDexedMemo);
//
property IdentifierMatchOptions: TIdentifierMatchOptions read fMatchOpts write setMatchOpts;
property HighlightedIdent: string read fHighlightedIdent write setHighligthedIdent;
property fileName: string read fFilename;
property modified: boolean read fModified;
property tempFilename: string read fTempFileName;
//
property completionMenu: TSynCompletion read fCompletion;
property syncroEdit: TSynPluginSyncroEdit read fSyncEdit;
property isDSource: boolean read fIsDSource;
property isTemporary: boolean read getIfTemp;
//
property transparentGutter: boolean read fTransparentGutter write setGutterTransparent;
property isProjectDescription: boolean read fIsProjectDescription write fIsProjectDescription;
property alwaysAdvancedFeatures: boolean read fAlwaysAdvancedFeatures write fAlwaysAdvancedFeatures;
property phobosDocRoot: string read fPhobosDocRoot write fPhobosDocRoot;
property detectIndentMode: boolean read fDetectIndentMode write fDetectIndentMode;
property disableFileDateCheck: boolean read fDisableFileDateCheck write fDisableFileDateCheck;
property MouseBytePosition: Integer read getMouseBytePosition;
property D2Highlighter: TSynD2Syn read fD2Highlighter;
property TxtHighlighter: TSynTxtSyn read fTxtHighlighter;
property CppHighlighter: TSynCppSyn read fCppHighlighter;
property SxHighlighter: TSynSxSyn read fSxHighlighter;
property defaultFontSize: Integer read fDefaultFontSize write setDefaultFontSize;
property ddocDelay: Integer read fDDocDelay write setDDocDelay;
property autoDotDelay: Integer read fAutoDotDelay write setAutoDotDelay;
property autoCloseCurlyBrace: TBraceAutoCloseStyle read fAutoCloseCurlyBrace write fAutoCloseCurlyBrace;
property autoClosedPairs: TAutoClosePairs read fAutoClosedPairs write fAutoClosedPairs;
property smartDdocNewline: boolean read fSmartDdocNewline write fSmartDdocNewline;
property insertPlusDdoc: boolean read fInsertPlusDdoc write fInsertPlusDdoc;
property autoCallCompletion: boolean read fAutoCallCompletion write fAutoCallCompletion;
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;
property textCompletion: boolean read fTextCompletion write fTextCompletion default true;
property textCompletionMinLength: integer read fTextCompletionMinLength write fTextCompletionMinLength default 3;
end;
TSortDialog = class(TForm)
private
class var fDescending: boolean;
class var fCaseSensitive: boolean;
fEditor: TDexedMemo;
fCanUndo: boolean;
procedure btnApplyClick(sender: TObject);
procedure btnUndoClick(sender: TObject);
procedure chkCaseSensClick(sender: TObject);
procedure chkDescClick(sender: TObject);
public
constructor construct(editor: TDexedMemo);
end;
TMixedIndentationDialog = class(TForm)
private
class var fSpacesPerTab: integer;
procedure spinSpacesPerTabChange(sender: TObject);
public
constructor construct(numSpaces, numTabs: integer);
end;
procedure SetDefaultDexedKeystrokes(ed: TSynEdit);
function CustomStringToCommand(const Ident: string; var Int: Longint): Boolean;
function CustomCommandToSstring(Int: Longint; var Ident: string): Boolean;
const
ecCompletionMenu = ecUserFirst + 1;
ecJumpToDeclaration = ecUserFirst + 2;
ecPreviousLocation = ecUserFirst + 3;
ecNextLocation = ecUserFirst + 4;
ecRecordMacro = ecUserFirst + 5;
ecPlayMacro = ecUserFirst + 6;
ecShowDdoc = ecUserFirst + 7;
ecShowCallTips = ecUserFirst + 8;
ecCurlyBraceClose = ecUserFirst + 9;
ecCommentSelection = ecUserFirst + 10;
ecSwapVersionAllNone = ecUserFirst + 11;
ecRenameIdentifier = ecUserFirst + 12;
ecCommentIdentifier = ecUserFirst + 13;
ecShowPhobosDoc = ecUserFirst + 14;
ecPreviousChangedArea = ecUserFirst + 15;
ecNextChangedArea = ecUserFirst + 16;
ecUpperCaseWordOrSel = ecUserFirst + 17;
ecLowerCaseWordOrSel = ecUserFirst + 18;
ecSortLines = ecUserFirst + 19;
ecPrevProtGrp = ecUserFirst + 20;
ecNextProtGrp = ecUserFirst + 21;
ecAddBreakpoint = ecUserFirst + 22;
ecRemoveBreakpoint = ecUserFirst + 23;
ecToggleBreakpoint = ecUserFirst + 24;
ecInsertDdocTemplate = ecUserFirst + 25;
ecNextWarning = ecUserFirst + 26;
ecPrevWarning = ecUserFirst + 27;
ecGotoLine = ecUserFirst + 28;
ecShowCurlineWarning = ecUserFirst + 29;
ecLeftWordEdge = ecUserFirst + 30;
ecRightWordEdge = ecUserFirst + 31;
ecSelLeftWordEdge = ecUserFirst + 32;
ecSelRightWordEdge = ecUserFirst + 33;
ecRedoAll = ecUserFirst + 34;
ecUndoAll = ecUserFirst + 35;
ecScrollCenteredUp = ecUserFirst + 36;
ecScrollCenteredDown = ecUserFirst + 37;
var
D2Syn: TSynD2Syn; // used as model to set the options when no editor exists.
TxtSyn: TSynTxtSyn; // used as model to set the options when no editor exists.
LfmSyn: TSynLfmSyn; // used to highlight the native projects.
JsSyn: TSynJScriptSyn;// used to highlight the DUB JSON projects.
implementation
uses
u_interfaces, u_dcd, SynEditHighlighterFoldBase, u_lcldragdrop, u_dexed_d;
const
DcdCompletionKindStrings: array[TDCDCompletionKind] of string = (
' (class) ',
' (interface) ',
' (struct) ',
' (union) ',
' (variable) ',
' (member) ',
' (reserved word) ',
' (function) ',
' (enum) ',
' (enum member) ',
' (package) ',
' (module) ',
' (array) ',
' (associative array)',
' (alias) ',
' (template) ',
' (mixin) ',
' (local word) '
);
{$REGION TEditorCallTipWindow --------------------------------------------------}
function TEditorHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
Font.Size:= FontSize;
result := inherited CalcHintRect(MaxWidth, AHint, AData);
end;
function TEditorCallTipWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
Font.Size:= FontSize;
result := inherited CalcHintRect(MaxWidth, AHint, AData);
end;
procedure TEditorCallTipWindow.ActivateDynamicHint(const AHint: String);
begin
if fActivating then
exit;
fActivating := True;
try
Caption := AHint;
Invalidate;
ActivateSub;
finally
fActivating := False;
end
end;
procedure TEditorCallTipWindow.Paint;
var
s: string;
a: string;
b: string;
i: integer = 0;
j: integer = 0;
x: integer;
y: integer = 1;
r: TStringRange = (ptr:nil; pos:0; len: 0);
t: TStringRange;
u: TStringRange = (ptr:nil; pos:0; len: 0);
m: integer = 0;
label
FIX_AUTO;
procedure writePart(const part: string; var x: integer; var lineHeigth: integer);
begin
canvas.TextOut(x, y, part);
x += canvas.TextWidth(part);
lineHeigth := max(canvas.TextHeight(part), lineHeigth);
end;
begin
s := caption;
if s.isEmpty then
exit;
u.init(s);
while true do
begin
i := 0;
y += m;
b := u.nextLine();
if b.isEmpty then
break;
FIX_AUTO:
r.init(b);
canvas.Brush.Color:= color;
x := ScaleX(3,96);
// type of result
a := r.takeUntil(' ').takeMore(1).yield();
r.popFront;
if a <> '%FIX% ' then // the computed HintRect does not permit additional text
writePart(a, x, m);
// func ident
a := r.takeUntil('(').yield();
writePart(a, x, m);
// template params
t := r.save.popPair(')')^;
if not t.empty() and (t.popFront^.front = '(') then
begin
a := r.takePair(')').takeMore(1).yield();
r.popFront();
writePart(a, x, m);
end
// `auto ident()` is formatted as `ident()` because `auto` in D is not a Type,
// so fix the formatting and go back.
else if r.empty() then
begin
if j > 128 then
exit;
b := '%FIX% ' + b;
j += 1;
goto FIX_AUTO;
end;
j := 0;
// func params
while not r.empty do
begin
a := r.takeUntil([',', #0]).yield;
if not r.empty then
begin
if r.front = ',' then
a += ', '
else
a += ')';
r.popFrontN(2);
end;
if fIndexOfExpectedArg = i then
canvas.Brush.Color:= clHighlight
else
canvas.Brush.Color:= color;
writePart(a, x, m);
i += 1;
end;
end;
end;
{$ENDREGION}
{$REGION TSortDialog -----------------------------------------------------------}
constructor TSortDialog.construct(editor: TDexedMemo);
var
pnl: TPanel;
begin
inherited Create(nil);
BorderStyle:= bsToolWindow;
fEditor := editor;
width := 150;
Height:= 95;
FormStyle:= fsStayOnTop;
BorderStyle:= bsToolWindow;
Position:= poScreenCenter;
ShowHint:=true;
with TCheckBox.Create(self) do
begin
parent := self;
BorderSpacing.Around:=2;
OnClick:=@chkCaseSensClick;
Caption:='case sensitive';
checked := fCaseSensitive;
align := alTop;
end;
with TCheckBox.Create(self) do
begin
parent := self;
BorderSpacing.Around:=2;
OnClick:=@chkDescClick;
Caption:='descending';
Checked:= fDescending;
align := alTop;
end;
pnl := TPanel.Create(self);
pnl.Parent := self;
pnl.Align:=alBottom;
pnl.Caption:='';
pnl.Height:= 32;
pnl.BevelOuter:=bvLowered;
with TSpeedButton.Create(self) do
begin
parent := pnl;
BorderSpacing.Around:=2;
OnClick:=@btnUndoClick;
align := alRight;
width := 28;
Hint := 'undo changes';
AssignPng(Glyph, 'ARROW_UNDO');
end;
with TSpeedButton.Create(self) do
begin
parent := pnl;
BorderSpacing.Around:=2;
OnClick:=@btnApplyClick;
align := alRight;
width := 28;
Hint := 'apply sorting';
AssignPng(Glyph, 'ACCEPT');
end;
end;
procedure TSortDialog.btnApplyClick(sender: TObject);
begin
fEditor.sortSelectedLines(fDescending, fCaseSensitive);
fCanUndo:= true;
end;
procedure TSortDialog.btnUndoClick(sender: TObject);
begin
if fCanUndo then
fEditor.undo;
fCanUndo:= false;
end;
procedure TSortDialog.chkCaseSensClick(sender: TObject);
begin
fCaseSensitive := TCheckBox(sender).checked;
end;
procedure TSortDialog.chkDescClick(sender: TObject);
begin
fDescending := TCheckBox(sender).checked;
end;
{$ENDREGION}
{$REGION TMixedIndentationDialog -----------------------------------------------}
constructor TMixedIndentationDialog.construct(numSpaces, numTabs: integer);
var
pn: TPanel;
begin
inherited create(nil);
BorderStyle:= bsToolWindow;
caption := 'Indentation converter';
Position:= TPosition.poMainFormCenter;
fSpacesPerTab := 4;
with TButton.Create(self) do
begin
Align:= alBottom;
parent := self;
caption := 'Do nothing';
AutoSize:= true;
ModalResult:= 1;
BorderSpacing.Around:=4;
end;
pn := TPanel.Create(self);
pn.Align:= alTop;
pn.parent := self;
pn.Caption:='';
pn.AutoSize:=true;
pn.BevelInner:= bvNone;
pn.BevelOuter:= bvNone;
pn.BorderSpacing.Around:=4;
pn.ParentColor:=true;
with TSpinEdit.Create(self) do
begin
value := fSpacesPerTab;
Align:= alLeft;
parent := pn;
MinValue:= 1;
MaxValue:= 8;
AutoSize:= true;
OnChange:= @spinSpacesPerTabChange;
hint := 'defines how many spaces per TAB will be used';
ShowHint:=true;
end;
with TLabel.Create(self) do
begin
parent := pn;
AutoSize:=true;
Caption:= 'Spaces per TAB';
Align:= alClient;
Layout:= TTextLayout.tlCenter;
BorderSpacing.Left:= 4;
end;
with TButton.Create(self) do
begin
Align:= alTop;
parent := self;
caption := 'Always use tabs';
AutoSize:= true;
ModalResult:= 10;
BorderSpacing.Around:=4;
end;
with TButton.Create(self) do
begin
Align:= alTop;
parent := self;
caption := 'Always use spaces';
AutoSize:= true;
ModalResult:= 11;
BorderSpacing.Around:=4;
end;
with TLabel.Create(self) do
begin
Align := alTop;
parent := self;
AutoSize :=true;
BorderSpacing.Around:=8;
caption := format('this document is%s- indented %d times by TAB%s- indented %d times by (n)spaces',
[#13#10, numTabs, #13#10, numSpaces]);
end;
width := ScaleX(280, 96);
height := ScaleY(200, 96);
end;
procedure TMixedIndentationDialog.spinSpacesPerTabChange(sender: TObject);
begin
fSpacesPerTab:= TSpinEdit(sender).Value;
end;
{$ENDREGION}
{$REGION TSynMemoCache ---------------------------------------------------------}
constructor TSynMemoCache.create(aComponent: TComponent);
begin
inherited create(nil);
if (aComponent is TDexedMemo) then
fMemo := TDexedMemo(aComponent);
fFolds := TCollection.Create(TFoldCache);
end;
destructor TSynMemoCache.destroy;
begin
fFolds.Free;
inherited;
end;
procedure TSynMemoCache.setFolds(someFolds: TCollection);
begin
fFolds.Assign(someFolds);
end;
procedure TSynMemoCache.beforeSave;
var
i, start, prev: Integer;
itm : TFoldCache;
begin
if fMemo.isNotAssigned then
exit;
fCaretPosition := fMemo.SelStart;
fSourceFilename := fMemo.fileName;
fSelectionEnd := fMemo.SelEnd;
fFontSize := fMemo.Font.Size;
fFontHeight := fMemo.Font.Height;
TEditorHintWindow.FontSize := fMemo.Font.Size;
prev := fMemo.Lines.Count-1;
for i := fMemo.Lines.Count-1 downto 0 do
begin
// - CollapsedLineForFoldAtLine() does not handle the sub-folding.
// - TextView visibility is increased so this is not the standard way of getting the infos.
start := TSynEditFoldedView(fMemo.TextViewsManager.SynTextViewByClass[TSynEditFoldedView]).CollapsedLineForFoldAtLine(i);
if start.equals(-1) then
continue;
if start = prev then
continue;
prev := start;
itm := TFoldCache(fFolds.Add);
itm.isCollapsed := true;
itm.fLineIndex := start;
end;
end;
procedure TSynMemoCache.afterLoad;
var
i: integer;
itm : TFoldCache;
begin
if fMemo.isNotAssigned then
exit;
if fFontSize <> 0 then
fMemo.Font.Size := fFontSize;
if fFontHeight <> 0 then
fMemo.Font.Height := fFontHeight;
// Currently collisions are not handled.
if fMemo.fileName <> fSourceFilename then
exit;
for i := 0 to fFolds.Count-1 do
begin
itm := TFoldCache(fFolds.Items[i]);
if not itm.isCollapsed then
continue;
TSynEditFoldedView(fMemo.TextViewsManager.SynTextViewByClass[TSynEditFoldedView]).FoldAtLine(itm.lineIndex-1);
end;
fMemo.SelStart := fCaretPosition;
fMemo.SelEnd := fSelectionEnd;
end;
{$IFDEF DEBUG}{$R-}{$ENDIF}
procedure TSynMemoCache.save;
var
fname: string;
tempn: string;
chksm: Cardinal;
begin
tempn := fMemo.fileName;
if (tempn = fMemo.tempFilename) or (not tempn.fileExists) then
exit;
fname := getDocPath + 'editorcache' + DirectorySeparator;
ForceDirectories(fname);
chksm := crc32(0, nil, 0);
chksm := crc32(chksm, @tempn[1], tempn.length);
fname := fname + format('%.8X.txt', [chksm]);
saveToFile(fname);
end;
procedure TSynMemoCache.load;
var
fname: string;
tempn: string;
chksm: Cardinal;
begin
tempn := fMemo.fileName;
if not tempn.fileExists then
exit;
fname := getDocPath + 'editorcache' + DirectorySeparator;
chksm := crc32(0, nil, 0);
chksm := crc32(chksm, @tempn[1], tempn.length);
fname := fname + format('%.8X.txt', [chksm]);
if not fname.fileExists then
exit;
loadFromFile(fname);
end;
{$IFDEF DEBUG}{$R+}{$ENDIF}
{$ENDREGION}
{$REGION TSynMemoPositions -----------------------------------------------------}
constructor TSynMemoPositions.create(memo: TCustomSynEdit);
begin
fList := TFPList.Create;
fMax := 40;
fMemo := memo;
fPos := -1;
end;
destructor TSynMemoPositions.destroy;
begin
fList.Free;
inherited;
end;
procedure TSynMemoPositions.back;
begin
Inc(fPos);
if fPos < fList.Count then
begin
{$HINTS OFF}
fMemo.CaretY := PtrInt(fList.Items[fPos]);
{$HINTS ON}
TDexedMemo(fMemo).centerCursor();
end
else Dec(fPos);
end;
procedure TSynMemoPositions.next;
begin
Dec(fPos);
if fPos > -1 then
begin
{$HINTS OFF}
fMemo.CaretY := PtrInt(fList.Items[fPos]);
{$HINTS ON}
TDexedMemo(fMemo).centerCursor();
end
else Inc(fPos);
end;
procedure TSynMemoPositions.store;
var
delta: PtrInt;
const
thresh = 6;
begin
fPos := 0;
{$PUSH}
{$HINTS OFF}{$WARNINGS OFF}
if fList.Count > 0 then
begin
delta := fMemo.CaretY - PtrInt(fList.Items[fPos]);
if (delta > -thresh) and (delta < thresh) then
exit;
end;
fList.Insert(0, Pointer(PtrInt(fMemo.CaretY)));
{$POP}
while fList.Count > fMax do
fList.Delete(fList.Count-1);
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION TScrollMemo -----------------------------------------------------------}
constructor TScrollMemo.construct(editor: TDexedMemo);
begin
inherited create(editor);
visible := false;
BevelOuter:= bvNone;
BevelInner:= bvNone;
parent := Application.MainForm;
width := scaleX(475, 96);
height := scaleY(275, 96);
fMemo:= TSynEdit.Create(self);
fMemo.Parent := self;
fMemo.Align:= alCLient;
fMemo.ReadOnly:=true;
fMemo.ScrollBars:=ssNone;
fMemo.MouseActions.Clear;
fMemo.Keystrokes.Clear;
fMemo.CaptureMouseButtons:=[];
fMemo.Options:=fMemo.Options+[eoNoCaret];
fD2Hl:= TSynD2Syn.create(self);
fTxtHl:= TSynTxtSyn.create(self);
fCppHl:= TSynCppSyn.create(self);
fSource:= editor;
updateFromSource();
end;
procedure TScrollMemo.updateFromSource;
begin
fMemo.Font.Assign(fSource.Font);
fMemo.Lines := fSource.Lines;
width := fSource.Width div 2;
if fSource.Highlighter.isAssigned then
begin
fMemo.Color:= fSource.Color;
fMemo.LineHighlightColor.Assign(fSource.LineHighlightColor);
fMemo.SelectedColor.Assign(fSource.SelectedColor);
if fMemo.Highlighter.isNotAssigned then
begin
fD2Hl.Assign(fSource.Highlighter);
fTxtHl.Assign(fSource.Highlighter);
fCppHl.Assign(fSource.Highlighter);
end;
if fSource.Highlighter is TSynD2Syn then
fMemo.Highlighter := fD2Hl
else if fSource.Highlighter is TSynCppSyn then
fMemo.Highlighter := fCppHl
else if fSource.Highlighter is TSynD2Syn then
fMemo.Highlighter := fTxtHl;
end;
end;
procedure TScrollMemo.SetVisible(Value: Boolean);
var
o: boolean;
begin
o := Visible;
inherited;
if (o <> value) and value then
updateFromSource;
end;
procedure TScrollMemo.goToLine(value: integer);
begin
if not fMemo.PaintLock.equals(0) then
exit;
if value > fMemo.Lines.Count then
value := fMemo.Lines.Count
else if value < 1 then
value := 1;
fMemo.CaretY := value;
fMemo.CaretX := 1;
fMemo.SelectLine(true);
end;
{$ENDREGION}
{$REGION TDexedMemo ------------------------------------------------------------}
{$REGION Standard Obj and Comp -------------------------------------------------}
constructor TDexedMemo.Create(aOwner: TComponent);
var
z: TIconScaledSize;
i: ILifetimeManager;
begin
inherited;
fScrollMemo := TScrollMemo.construct(self);
i := getLifeTimeManager();
if i.isAssigned then
fLifeTimeManager := i.asObject;
OnShowHint:= @showHintEvent;
OnStatusChange:= @handleStatusChanged;
fDefaultFontSize := 10;
Font.Size:=10;
SetDefaultDexedKeystrokes(Self); // not called in inherited if owner = nil !
fLexToks:= TLexTokenList.Create;
fSmartDdocNewline := true;
OnDragDrop:= @ddHandler.DragDrop;
OnDragOver:= @ddHandler.DragOver;
ShowHint := false;
InitHintWins;
fDDocDelay := 200;
fDDocTimer := TIdleTimer.Create(self);
fDDocTimer.AutoEnabled:=true;
fDDocTimer.Interval := fDDocDelay;
fDDocTimer.OnTimer := @DDocTimerEvent;
fAutoDotDelay := 100;
fAutoDotTimer := TIdleTimer.Create(self);
fAutoDotTimer.AutoEnabled:=true;
fAutoDotTimer.Interval := fAutoDotDelay;
fAutoDotTimer.OnTimer := @AutoDotTimerEvent;
fDscannerDelay := 500;
fDscannerTimer := TIdleTimer.Create(self);
fDscannerTimer.AutoEnabled:=true;
fDscannerTimer.Interval := fDscannerDelay;
fDscannerTimer.OnTimer := @dscannerTimerEvent;
fDscanner := TDexedProcess.create(self);
fDscanner.Executable:= exeFullName('dscanner' + exeExt);
fDscanner.Options:=[poUsePipes];
fDscanner.ShowWindow:=swoHIDE;
fDscanner.OnTerminate:=@dscannerTerminate;
fDscanner.Parameters.AddStrings(['-S', 'stdin']);
fDscannerResults:= TDscannerResults.create;
fKnowsDscanner := fDscanner.Executable.fileExists;
Gutter.LineNumberPart.ShowOnlyLineNumbersMultiplesOf := 5;
Gutter.LineNumberPart.MarkupInfo.Foreground := clWindowText;
Gutter.LineNumberPart.MarkupInfo.Background := clBtnFace;
Gutter.SeparatorPart.LineOffset := 0;
Gutter.SeparatorPart.LineWidth := 1;
Gutter.OnGutterClick:= @gutterClick;
BracketMatchColor.Foreground:=clRed;
fSyncEdit := TSynPluginSyncroEdit.Create(self);
fSyncEdit.Editor := self;
fSyncEdit.CaseSensitive := true;
fCompletion := TSyncompletion.create(nil);
fCompletion.ShowSizeDrag := true;
fCompletion.Editor := Self;
fCompletion.OnExecute:= @completionExecute;
fCompletion.OnCodeCompletion:=@completionCodeCompletion;
fCompletion.OnPaintItem:= @completionItemPaint;
fCompletion.OnKeyDelete:= @completionDeleteKey;
fCompletion.OnKeyDown:= @completionFormKeyDown;
fCompletion.CaseSensitive:=true;
TStringList(fCompletion.ItemList).CaseSensitive:=true;
fCompletion.LongLineHintType:=sclpNone;
fCompletion.TheForm.ShowInTaskBar:=stNever;
fCompletion.ShortCut:=0;
fCompletion.LinesInWindow:=15;
fCompletion.Width:= 250;
MouseLinkColor.Style:= [fsUnderline];
with MouseActions.Add do begin
Command := emcMouseLink;
shift := [ssCtrl];
ShiftMask := [ssCtrl];
end;
fD2Highlighter := TSynD2Syn.create(self);
fTxtHighlighter := TSynTxtSyn.Create(self);
fCppHighlighter := TSynCppSyn.Create(self);
fSxHighlighter := TSynSxSyn.Create(self);
Highlighter := fD2Highlighter;
fTempFileName := GetTempDir(false) + 'temp_' + uniqueObjStr(self) + '.d';
fFilename := newdocPageCaption;
fModified := false;
TextViewsManager.SynTextView[0].AddNotifyHandler(senrUndoRedoAdded, @changeNotify);
Gutter.MarksPart.Visible:=false;
fMultiGutterMarks := TSynMultiGutterMarks.Create(Gutter.Parts);
fMultiGutterMarks.columnCount := 2;
fMultiGutterMarks.columnWidth := ScaleX(20,96);
fMultiGutterMarks.AutoSize := true;
fMultiGutterMarks.Index := 1;
fImages := TImageList.Create(self);
fMultiGutterMarks.images := fImages;
z := GetIconScaledSize;
case z of
iss16:
begin
fImages.Width:= 16;
fImages.Height:= 16;
fImages.AddResourceName(HINSTANCE, 'BREAK_SET');
fImages.AddResourceName(HINSTANCE, 'BULLET_GREEN');
fImages.AddResourceName(HINSTANCE, 'BULLET_BLACK');
fImages.AddResourceName(HINSTANCE, 'BREAK_REACHED');
fImages.AddResourceName(HINSTANCE, 'STEP');
fImages.AddResourceName(HINSTANCE, 'CAMERA_GO');
fImages.AddResourceName(HINSTANCE, 'WARNING');
AssignPng(fSyncEdit.GutterGlyph, 'LINK_EDIT');
end;
iss24:
begin
fImages.Width:= 24;
fImages.Height:= 24;
fImages.AddResourceName(HINSTANCE, 'BREAK_SET24');
fImages.AddResourceName(HINSTANCE, 'BULLET_GREEN24');
fImages.AddResourceName(HINSTANCE, 'BULLET_BLACK24');
fImages.AddResourceName(HINSTANCE, 'BREAK_REACHED24');
fImages.AddResourceName(HINSTANCE, 'STEP24');
fImages.AddResourceName(HINSTANCE, 'CAMERA_GO24');
fImages.AddResourceName(HINSTANCE, 'WARNING24');
AssignPng(fSyncEdit.GutterGlyph, 'LINK_EDIT24');
end;
iss32:
begin
fImages.Width:= 32;
fImages.Height:= 32;
fImages.AddResourceName(HINSTANCE, 'BREAK_SET32');
fImages.AddResourceName(HINSTANCE, 'BULLET_GREEN32');
fImages.AddResourceName(HINSTANCE, 'BULLET_BLACK32');
fImages.AddResourceName(HINSTANCE, 'BREAK_REACHED32');
fImages.AddResourceName(HINSTANCE, 'STEP32');
fImages.AddResourceName(HINSTANCE, 'CAMERA_GO32');
fImages.AddResourceName(HINSTANCE, 'WARNING32');
AssignPng(fSyncEdit.GutterGlyph, 'LINK_EDIT32');
end;
end;
fPositions := TSynMemoPositions.create(self);
fMultiDocSubject := TMultiDocSubject.create;
HighlightAllColor.Foreground := clNone;
HighlightAllColor.Background := clSilver;
HighlightAllColor.BackAlpha := 70;
IdentifierMatchOptions:= [caseSensitive];
LineHighlightColor.Background := color - $080808;
LineHighlightColor.Foreground := clNone;
fAutoCloseCurlyBrace:= autoCloseOnNewLineLexically;
fAutoClosedPairs:= [autoCloseSquareBracket];
fDebugger := EntitiesConnector.getSingleService('IDebugger') as IDebugger;
subjDocNew(TMultiDocSubject(fMultiDocSubject), self);
EntitiesConnector.addObserver(self);
end;
procedure TDexedMemo.WMKillFocus(var Message: TLMKillFocus);
begin
if eoAutoHideCursor in options2 then
inherited MouseMove([], 0, 0);
end;
destructor TDexedMemo.destroy;
begin
saveCache;
EntitiesConnector.removeObserver(self);
subjDocClosing(TMultiDocSubject(fMultiDocSubject), self);
fMultiDocSubject.Free;
fPositions.Free;
fCompletion.Free;
fLexToks.Clear;
fLexToks.Free;
fSortDialog.Free;
fDscannerResults.Free;
if fTempFileName.fileExists then
sysutils.DeleteFile(fTempFileName);
//minimizeGcHeap(true);
inherited;
end;
procedure TDexedMemo.setGutterTransparent(value: boolean);
var
i: integer;
c: TColor;
begin
fTransparentGutter:=value;
if fTransparentGutter then
c := color
else
c := clBtnFace;
for i := 0 to Gutter.Parts.Count - 1 do
gutter.Parts.Part[i].MarkupInfo.Background := c;
gutter.Color:=c;
end;
procedure TDexedMemo.setDefaultFontSize(value: Integer);
var
old: Integer;
begin
old := Font.Size;
if value < 5 then
value := 5;
fDefaultFontSize:= value;
if Font.Size = old then
Font.Size := fDefaultFontSize;
end;
procedure TDexedMemo.setFocus;
begin
inherited;
highlightCurrentIdentifier;
subjDocFocused(TMultiDocSubject(fMultiDocSubject), self);
end;
procedure TDexedMemo.showPage;
begin
getMultiDocHandler.openDocument(fileName);
end;
procedure TDexedMemo.DoEnter;
begin
inherited;
checkFileDate;
if not fFocusForInput then
subjDocFocused(TMultiDocSubject(fMultiDocSubject), self);
fFocusForInput := true;
fScrollMemo.Visible:=false;
tryToPatchMixedIndentation;
end;
procedure TDexedMemo.DoExit;
begin
inherited;
fFocusForInput := false;
hideDDocs;
hideCallTips;
fScrollMemo.Visible:=false;
if fCompletion.IsActive then
fCompletion.Deactivate;
end;
procedure TDexedMemo.SetVisible(Value: Boolean);
begin
inherited;
if Value then
begin
setFocus;
if not fCacheLoaded then
loadCache;
fCacheLoaded := true;
end
else
begin
hideDDocs;
hideCallTips;
fScrollMemo.Visible:=false;
if fCompletion.IsActive then
fCompletion.Deactivate;
end;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Custom editor commands and shortcuts ----------------------------------}
procedure SetDefaultDexedKeystrokes(ed: TSynEdit);
begin
with ed do
begin
Keystrokes.Clear;
AddKey(ecUp, VK_UP, [], 0, []);
AddKey(ecSelUp, VK_UP, [ssShift], 0, []);
AddKey(ecScrollUp, VK_UP, [ssCtrl], 0, []);
AddKey(ecDown, VK_DOWN, [], 0, []);
AddKey(ecSelDown, VK_DOWN, [ssShift], 0, []);
AddKey(ecScrollDown, VK_DOWN, [ssCtrl], 0, []);
AddKey(ecLeft, VK_LEFT, [], 0, []);
AddKey(ecSelLeft, VK_LEFT, [ssShift], 0, []);
AddKey(ecWordLeft, VK_LEFT, [ssCtrl], 0, []);
AddKey(ecWordEndLeft, VK_LEFT, [ssCtrl,ssAlt], 0, []);
AddKey(ecWordEndRight, VK_RIGHT, [ssCtrl,ssAlt], 0, []);
AddKey(ecSelWordLeft, VK_LEFT, [ssShift,ssCtrl], 0, []);
AddKey(ecRight, VK_RIGHT, [], 0, []);
AddKey(ecSelRight, VK_RIGHT, [ssShift], 0, []);
AddKey(ecWordRight, VK_RIGHT, [ssCtrl], 0, []);
AddKey(ecSelWordRight, VK_RIGHT, [ssShift,ssCtrl], 0, []);
AddKey(ecPageDown, VK_NEXT, [], 0, []);
AddKey(ecSelPageDown, VK_NEXT, [ssShift], 0, []);
AddKey(ecPageBottom, VK_NEXT, [ssCtrl], 0, []);
AddKey(ecSelPageBottom, VK_NEXT, [ssShift,ssCtrl], 0, []);
AddKey(ecPageUp, VK_PRIOR, [], 0, []);
AddKey(ecSelPageUp, VK_PRIOR, [ssShift], 0, []);
AddKey(ecPageTop, VK_PRIOR, [ssCtrl], 0, []);
AddKey(ecSelPageTop, VK_PRIOR, [ssShift,ssCtrl], 0, []);
AddKey(ecLineStart, VK_HOME, [], 0, []);
AddKey(ecSelLineStart, VK_HOME, [ssShift], 0, []);
AddKey(ecEditorTop, VK_HOME, [ssCtrl], 0, []);
AddKey(ecSelEditorTop, VK_HOME, [ssShift,ssCtrl], 0, []);
AddKey(ecLineEnd, VK_END, [], 0, []);
AddKey(ecSelLineEnd, VK_END, [ssShift], 0, []);
AddKey(ecEditorBottom, VK_END, [ssCtrl], 0, []);
AddKey(ecSelEditorBottom, VK_END, [ssShift,ssCtrl], 0, []);
AddKey(ecToggleMode, VK_INSERT, [], 0, []);
AddKey(ecDeleteChar, VK_DELETE, [], 0, []);
AddKey(ecDeleteLastChar, VK_BACK, [], 0, []);
AddKey(ecDeleteLastWord, VK_BACK, [ssCtrl], 0, []);
AddKey(ecLineBreak, VK_RETURN, [], 0, []);
AddKey(ecSelectAll, ord('A'), [ssCtrl], 0, []);
AddKey(ecCopy, ord('C'), [ssCtrl], 0, []);
AddKey(ecBlockIndent, ord('I'), [ssCtrl,ssShift], 0, []);
AddKey(ecInsertLine, ord('N'), [ssCtrl], 0, []);
AddKey(ecDeleteWord, ord('T'), [ssCtrl], 0, []);
AddKey(ecBlockUnindent, ord('U'), [ssCtrl,ssShift], 0, []);
AddKey(ecPaste, ord('V'), [ssCtrl], 0, []);
AddKey(ecCut, ord('X'), [ssCtrl], 0, []);
AddKey(ecDeleteLine, ord('Y'), [ssCtrl], 0, []);
AddKey(ecDeleteEOL, ord('Y'), [ssCtrl,ssShift], 0, []);
AddKey(ecUndo, ord('Z'), [ssCtrl], 0, []);
AddKey(ecRedo, ord('Z'), [ssCtrl,ssShift], 0, []);
AddKey(ecFoldLevel1, ord('1'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel2, ord('2'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel3, ord('3'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel4, ord('4'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel5, ord('5'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel6, ord('6'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel7, ord('7'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel8, ord('8'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel9, ord('9'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldLevel0, ord('0'), [ssAlt,ssShift], 0, []);
AddKey(ecFoldCurrent, ord('-'), [ssAlt,ssShift], 0, []);
AddKey(ecUnFoldCurrent, ord('+'), [ssAlt,ssShift], 0, []);
AddKey(EcToggleMarkupWord, ord('M'), [ssAlt], 0, []);
AddKey(ecNormalSelect, ord('N'), [ssCtrl,ssShift], 0, []);
AddKey(ecColumnSelect, ord('C'), [ssCtrl,ssShift], 0, []);
AddKey(ecLineSelect, ord('L'), [ssCtrl,ssShift], 0, []);
AddKey(ecTab, VK_TAB, [], 0, []);
AddKey(ecShiftTab, VK_TAB, [ssShift], 0, []);
AddKey(ecMatchBracket, ord('B'), [ssCtrl,ssShift], 0, []);
AddKey(ecColSelUp, VK_UP, [ssAlt, ssShift], 0, []);
AddKey(ecColSelDown, VK_DOWN, [ssAlt, ssShift], 0, []);
AddKey(ecColSelLeft, VK_LEFT, [ssAlt, ssShift], 0, []);
AddKey(ecColSelRight, VK_RIGHT, [ssAlt, ssShift], 0, []);
AddKey(ecColSelPageDown, VK_NEXT, [ssAlt, ssShift], 0, []);
AddKey(ecColSelPageBottom, VK_NEXT, [ssAlt, ssShift,ssCtrl], 0, []);
AddKey(ecColSelPageUp, VK_PRIOR, [ssAlt, ssShift], 0, []);
AddKey(ecColSelPageTop, VK_PRIOR, [ssAlt, ssShift,ssCtrl], 0, []);
AddKey(ecColSelLineStart, VK_HOME, [ssAlt, ssShift], 0, []);
AddKey(ecColSelLineEnd, VK_END, [ssAlt, ssShift], 0, []);
AddKey(ecColSelEditorTop, VK_HOME, [ssAlt, ssShift,ssCtrl], 0, []);
AddKey(ecColSelEditorBottom, VK_END, [ssAlt, ssShift,ssCtrl], 0, []);
AddKey(ecSynPSyncroEdStart, ord('E'), [ssCtrl], 0, []);
AddKey(ecSynPSyncroEdEscape, ord('E'), [ssCtrl, ssShift], 0, []);
AddKey(ecCompletionMenu, ord(' '), [ssCtrl], 0, []);
AddKey(ecJumpToDeclaration, VK_UP, [ssCtrl,ssShift], 0, []);
AddKey(ecPreviousLocation, 0, [], 0, []);
AddKey(ecNextLocation, 0, [], 0, []);
AddKey(ecRecordMacro, ord('R'), [ssCtrl,ssShift], 0, []);
AddKey(ecPlayMacro, ord('P'), [ssCtrl,ssShift], 0, []);
AddKey(ecShowDdoc, 0, [], 0, []);
AddKey(ecShowCallTips, 0, [], 0, []);
AddKey(ecCurlyBraceClose, 0, [], 0, []);
AddKey(ecCommentSelection, ord('/'), [ssCtrl], 0, []);
AddKey(ecSwapVersionAllNone, 0, [], 0, []);
AddKey(ecRenameIdentifier, VK_F2, [], 0, []);
AddKey(ecCommentIdentifier, 0, [], 0, []);
AddKey(ecShowPhobosDoc, VK_F1, [], 0, []);
AddKey(ecPreviousChangedArea, VK_UP, [ssAlt], 0, []);
AddKey(ecNextChangedArea, VK_DOWN, [ssAlt], 0, []);
AddKey(ecLowerCaseWordOrSel, 0, [], 0, []);
AddKey(ecUpperCaseWordOrSel, 0, [], 0, []);
AddKey(ecSortLines, 0, [], 0, []);
AddKey(ecPrevProtGrp, 0, [], 0, []);
AddKey(ecNextProtGrp, 0, [], 0, []);
AddKey(ecAddBreakpoint, 0, [], 0, []);
AddKey(ecRemoveBreakpoint, 0, [], 0, []);
AddKey(ecToggleBreakpoint, 0, [], 0, []);
AddKey(ecInsertDdocTemplate, 0, [], 0, []);
AddKey(ecPrevWarning, 0, [], 0, []);
AddKey(ecNextWarning, 0, [], 0, []);
AddKey(ecGotoLine, 0, [], 0, []);
AddKey(ecShowCurlineWarning, 0, [], 0, []);
AddKey(ecLeftWordEdge, 0, [], 0, []);
AddKey(ecRightWordEdge, 0, [], 0, []);
AddKey(ecSelLeftWordEdge, 0, [], 0, []);
AddKey(ecSelRightWordEdge, 0, [], 0, []);
AddKey(ecSmartWordLeft, 0, [], 0, []);
AddKey(ecSmartWordRight, 0, [], 0, []);
AddKey(ecRedoAll, 0, [], 0, []);
AddKey(ecUndoAll, 0, [], 0, []);
AddKey(ecScrollCenteredDown, VK_DOWN, [ssCtrl, ssAlt], 0, []);
AddKey(ecScrollCenteredUp, VK_UP, [ssCtrl, ssAlt], 0, []);
end;
end;
function CustomStringToCommand(const Ident: string; var Int: Longint): Boolean;
begin
case Ident of
'ecCompletionMenu': begin Int := ecCompletionMenu; exit(true); end;
'ecJumpToDeclaration': begin Int := ecJumpToDeclaration; exit(true); end;
'ecPreviousLocation': begin Int := ecPreviousLocation; exit(true); end;
'ecNextLocation': begin Int := ecNextLocation; exit(true); end;
'ecRecordMacro': begin Int := ecRecordMacro; exit(true); end;
'ecPlayMacro': begin Int := ecPlayMacro; exit(true); end;
'ecShowDdoc': begin Int := ecShowDdoc; exit(true); end;
'ecShowCallTips': begin Int := ecShowCallTips; exit(true); end;
'ecCurlyBraceClose': begin Int := ecCurlyBraceClose; exit(true); end;
'ecCommentSelection': begin Int := ecCommentSelection; exit(true); end;
'ecSwapVersionAllNone': begin Int := ecSwapVersionAllNone; exit(true); end;
'ecRenameIdentifier': begin Int := ecRenameIdentifier; exit(true); end;
'ecCommentIdentifier': begin Int := ecCommentIdentifier; exit(true); end;
'ecShowPhobosDoc': begin Int := ecShowPhobosDoc; exit(true); end;
'ecNextChangedArea': begin Int := ecNextChangedArea; exit(true); end;
'ecPreviousChangedArea':begin Int := ecPreviousChangedArea; exit(true); end;
'ecUpperCaseWordOrSel': begin Int := ecUpperCaseWordOrSel; exit(true); end;
'ecLowerCaseWordOrSel': begin Int := ecLowerCaseWordOrSel; exit(true); end;
'ecSortLines': begin Int := ecSortLines; exit(true); end;
'ecNextProtGrp': begin Int := ecNextProtGrp; exit(true); end;
'ecPrevProtGrp': begin Int := ecPrevProtGrp; exit(true); end;
'ecAddBreakpoint': begin Int := ecAddBreakpoint; exit(true); end;
'ecRemoveBreakpoint': begin Int := ecRemoveBreakpoint; exit(true); end;
'ecToggleBreakpoint': begin Int := ecToggleBreakpoint; exit(true); end;
'ecInsertDdocTemplate': begin Int := ecInsertDdocTemplate; exit(true); end;
'ecPrevWarning': begin Int := ecPrevWarning; exit(true); end;
'ecNextWarning': begin Int := ecNextWarning; exit(true); end;
'ecGotoLine': begin Int := ecGotoLine; exit(true); end;
'ecShowCurlineWarning': begin Int := ecShowCurlineWarning; exit(true); end;
'ecLeftWordEdge': begin Int := ecLeftWordEdge; exit(true); end;
'ecRightWordEdge': begin Int := ecRightWordEdge; exit(true); end;
'ecSelLeftWordEdge': begin Int := ecSelLeftWordEdge; exit(true); end;
'ecSelRightWordEdge': begin Int := ecSelRightWordEdge; exit(true); end;
'ecRedoAll': begin Int := ecRedoAll; exit(true); end;
'ecUndoAll': begin Int := ecUndoAll; exit(true); end;
'ecScrollCenteredUp': begin Int := ecScrollCenteredUp; exit(true); end;
'ecScrollCenteredDown': begin Int := ecScrollCenteredDown; exit(true); end;
else exit(false);
end;
end;
function CustomCommandToSstring(Int: Longint; var Ident: string): Boolean;
begin
case Int of
ecCompletionMenu: begin Ident := 'ecCompletionMenu'; exit(true); end;
ecJumpToDeclaration: begin Ident := 'ecJumpToDeclaration'; exit(true); end;
ecPreviousLocation: begin Ident := 'ecPreviousLocation'; exit(true); end;
ecNextLocation: begin Ident := 'ecNextLocation'; exit(true); end;
ecRecordMacro: begin Ident := 'ecRecordMacro'; exit(true); end;
ecPlayMacro: begin Ident := 'ecPlayMacro'; exit(true); end;
ecShowDdoc: begin Ident := 'ecShowDdoc'; exit(true); end;
ecShowCallTips: begin Ident := 'ecShowCallTips'; exit(true); end;
ecCurlyBraceClose: begin Ident := 'ecCurlyBraceClose'; exit(true); end;
ecCommentSelection: begin Ident := 'ecCommentSelection'; exit(true); end;
ecSwapVersionAllNone: begin Ident := 'ecSwapVersionAllNone'; exit(true); end;
ecRenameIdentifier: begin Ident := 'ecRenameIdentifier'; exit(true); end;
ecCommentIdentifier: begin Ident := 'ecCommentIdentifier'; exit(true); end;
ecShowPhobosDoc: begin Ident := 'ecShowPhobosDoc'; exit(true); end;
ecNextChangedArea: begin Ident := 'ecNextChangedArea'; exit(true); end;
ecPreviousChangedArea:begin Ident := 'ecPreviousChangedArea'; exit(true); end;
ecUpperCaseWordOrSel: begin Ident := 'ecUpperCaseWordOrSel'; exit(true); end;
ecLowerCaseWordOrSel: begin Ident := 'ecLowerCaseWordOrSel'; exit(true); end;
ecSortLines: begin Ident := 'ecSortLines'; exit(true); end;
ecNextProtGrp: begin Ident := 'ecNextProtGrp'; exit(true); end;
ecPrevProtGrp: begin Ident := 'ecPrevProtGrp'; exit(true); end;
ecAddBreakpoint: begin Ident := 'ecAddBreakpoint'; exit(true); end;
ecRemoveBreakpoint: begin Ident := 'ecRemoveBreakpoint'; exit(true); end;
ecToggleBreakpoint: begin Ident := 'ecToggleBreakpoint'; exit(true); end;
ecInsertDdocTemplate: begin Ident := 'ecInsertDdocTemplate'; exit(true); end;
ecPrevWarning: begin Ident := 'ecPrevWarning'; exit(true); end;
ecNextWarning: begin Ident := 'ecNextWarning'; exit(true); end;
ecGotoLine: begin Ident := 'ecGotoLine'; exit(true); end;
ecShowCurlineWarning: begin Ident := 'ecShowCurlineWarning'; exit(true); end;
ecLeftWordEdge: begin Ident := 'ecLeftWordEdge'; exit(true); end;
ecRightWordEdge: begin Ident := 'ecRightWordEdge'; exit(true); end;
ecSelLeftWordEdge: begin Ident := 'ecSelLeftWordEdge'; exit(true); end;
ecSelRightWordEdge: begin Ident := 'ecSelRightWordEdge'; exit(true); end;
ecRedoAll: begin Ident := 'ecRedoAll'; exit(true); end;
ecUndoAll: begin Ident := 'ecUndoAll'; exit(true); end;
ecScrollCenteredUp: begin Ident := 'ecScrollCenteredUp'; exit(true); end;
ecScrollCenteredDown: begin Ident := 'ecScrollCenteredDown'; exit(true); end;
else exit(false);
end;
end;
procedure TDexedMemo.lexWholeText(opts: TLexOptions = []);
begin
fLexToks.Clear;
lex(lines.Text, fLexToks, nil, opts);
end;
procedure TDexedMemo.DoOnProcessCommand(var Command: TSynEditorCommand;
var AChar: TUTF8Char; Data: pointer);
begin
FBlockSelection.AutoExtend := False;
FBlockSelection.StickyAutoExtend := False;
case Command of
5: Command := ecLeftWordEdge;
6: Command := ecRightWordEdge;
105:
begin
Command := ecSelLeftWordEdge;
FBlockSelection.ActiveSelectionMode := smNormal;
FBlockSelection.AutoExtend := true;
FBlockSelection.StickyAutoExtend := True;
end;
106:
begin
Command := ecSelRightWordEdge;
FBlockSelection.ActiveSelectionMode := smNormal;
FBlockSelection.AutoExtend := true;
FBlockSelection.StickyAutoExtend := True;
end;
end;
inherited;
case Command of
ecCut: if not SelAvail then
begin
SelectLine(true);
ExecuteCommand(ecCut, #0, nil);
Clipboard.AsText := TrimLeft(Clipboard.AsText);
fCanDscan:= true;
end;
ecCopy: if not SelAvail then
begin
SelectLine(false);
ExecuteCommand(ecCopy, #0, nil);
SelEnd:=SelStart;
end;
ecPaste:
begin
patchClipboardIndentation;
fCanDscan:= true;
end;
ecCompletionMenu:
begin
fCanAutoDot:=false;
fCompletion.Execute(GetWordAtRowCol(LogicalCaretXY),
ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
ecPreviousLocation:
fPositions.back;
ecNextLocation:
fPositions.next;
ecShowDdoc:
begin
hideCallTips;
hideDDocs;
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
showDDocs;
end;
ecShowCallTips:
begin
hideCallTips;
hideDDocs;
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
showCallTips(true);
end;
ecCurlyBraceClose:
begin
lexWholeText([TLexOption.lxoNoWhites, TLexOption.lxoNoComments]);
curlyBraceCloseAndIndent;
end;
ecUndo:
fCanDscan:= true;
ecRedo:
fCanDscan:= true;
ecCommentSelection:
commentSelection;
ecSwapVersionAllNone:
invertVersionAllNone;
ecRenameIdentifier:
renameIdentifier;
ecCommentIdentifier:
commentIdentifier;
ecShowPhobosDoc:
ShowPhobosDoc;
ecNextChangedArea:
goToChangedArea(true);
ecPreviousChangedArea:
goToChangedArea(false);
ecUpperCaseWordOrSel:
setSelectionOrWordCase(true);
ecLowerCaseWordOrSel:
setSelectionOrWordCase(false);
ecSortLines:
sortLines;
ecPrevProtGrp:
previousProtectionGroup;
ecNextProtGrp:
nextProtectionGroup;
ecAddBreakpoint:
addCurLineBreakPoint;
ecRemoveBreakpoint:
removeCurLineBreakPoint;
ecToggleBreakpoint:
toggleCurLineBreakpoint;
ecInsertDdocTemplate:
insertDdocTemplate;
ecPrevWarning:
goToWarning(false);
ecNextWarning:
goToWarning(true);
ecGotoLine:
gotoLinePrompt;
ecShowCurlineWarning:
showCurLineWarning;
ecLeftWordEdge, ecSelLeftWordEdge:
gotoWordEdge(false);
ecRightWordEdge, ecSelRightWordEdge:
gotoWordEdge(true);
ecRedoAll:
redoAll();
ecUndoAll:
undoAll();
ecScrollCenteredUp:
scrollCentered(false);
ecScrollCenteredDown:
scrollCentered(true);
end;
if fOverrideColMode and not SelAvail then
begin
fOverrideColMode := false;
Options := Options - [eoScrollPastEol];
end;
end;
function TDexedMemo.indentationMode(out numTabs, numSpaces: integer): TIndentationMode;
function checkLine(index: integer): TIndentationMode;
var
u: string;
b: array[0..15] of char = ' ';
begin
result := imNone;
u := Lines[index];
if (u.length > 0) and (u[1] = #9) then
result := imTabs
else if (u.length >= TabWidth) and u.StartsWith(b[0..TabWidth-1]) then
result := imSpaces;
end;
var
i: integer;
t: integer = 0;
s: integer = 0;
begin
for i:= 0 to lines.count-1 do
begin
result := checkLine(i);
t += byte(result = imTabs);
s += byte(result = imSpaces);
end;
if not t.equals(0) and not s.equals(0) then
result := imMixed
else if t.equals(0) then
result := imSpaces
else if s.equals(0) then
result := imTabs
else
result := imNone;
numTabs:= t;
numSpaces:= s;
end;
procedure TDexedMemo.forceIndentation(m: TIndentationMode; w: integer);
var
i: integer;
begin
assert(w > 0);
lines.BeginUpdate;
for i:= 0 to lines.Count-1 do
case m of
imTabs:
begin
lines[i] := leadingSpacesToTabs(lines[i], TabWidth);
fModified:=true;
end;
imSpaces:
begin
lines[i] := leadingTabsToSpaces(lines[i], TabWidth);
fModified:=true;
end;
end;
lines.EndUpdate;
end;
procedure TDexedMemo.insertLeadingDDocSymbol(c: char);
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
BeginUndoBlock;
if ((CaretX-1) and 1).equals(0) then
ExecuteCommand(ecChar, ' ', nil);
ExecuteCommand(ecChar, c, nil);
EndUndoBlock;
end;
function TDexedMemo.autoIndentationLevel(line: Integer): Integer;
var
leftTokIndex: integer = -1;
f: PLexToken = nil;
i: integer = 0;
s: string;
c: char;
b: integer = 0;
tabCount: integer = 0;
spcCount: integer = 0;
begin
result := 0;
if not fIsDSource and not alwaysAdvancedFeatures or
not (eoAutoIndent in Options) then
exit;
leftTokIndex := getIndexOfTokenLeftTo(fLexToks, CaretXY);
if leftTokIndex.equals(-1) or (leftTokIndex >= fLexToks.Count) then
exit;
// goto previous opened brace
for i:= leftTokIndex downto 0 do
begin
f := fLexToks[i];
b += Byte((f^.kind = ltkSymbol) and (f^.Data[1] = '}'));
b -= Byte((f^.kind = ltkSymbol) and (f^.Data[1] = '{'));
if b.equals(-1) then
break;
end;
// retrieve the indent of the opened brace
if assigned(f) and (f^.position.x > 0) then
begin
s := lines[f^.position.y-1];
for c in s do
case c of
#9: tabCount += 1;
#32:spcCount += 1;
else break;
end;
end;
result += tabCount + spcCount div TabWidth;
result += Byte((result > 0) or (b <> 0));
end;
procedure TDexedMemo.curlyBraceCloseAndIndent(close: boolean = true);
var
numTabs, i: integer;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
BeginUndoBlock;
numTabs := autoIndentationLevel(CaretY);
CommandProcessor(ecLineBreak, '', nil);
if close then
begin
if not isBlank(lineText) then // put rest of line on a new one after the `}`
CommandProcessor(ecInsertLine, '', nil);
CommandProcessor(ecLineBreak, '', nil);
CommandProcessor(ecDeleteBOL, '', nil);
for i:= 1 to numTabs-1 do CommandProcessor(ecTab, '', nil);
CommandProcessor(ecChar, '}', nil);
CommandProcessor(ecUp, '', nil);
CommandProcessor(ecLineEnd, '', nil);
end;
CommandProcessor(ecDeleteBOL, '', nil);
for i:= 1 to numTabs do CommandProcessor(ecTab, '', nil);
EndUndoBlock;
end;
procedure TDexedMemo.commentSelection;
procedure commentHere;
begin
ExecuteCommand(ecChar, '/', nil);
ExecuteCommand(ecChar, '/', nil);
end;
procedure unCommentHere;
begin
ExecuteCommand(ecLineTextStart, '', nil);
ExecuteCommand(ecDeleteChar, '', nil);
ExecuteCommand(ecDeleteChar, '', nil);
end;
var
i, j, dx, lx, numUndo: integer;
line: string;
mustUndo: boolean = false;
pt, cp: TPoint;
begin
if not SelAvail then
begin
i := CaretX;
line := TrimLeft(LineText);
mustUndo := (line.length > 1) and (line[1..2] = '//');
BeginUndoBlock;
ExecuteCommand(ecLineTextStart, '', nil);
if not mustUndo then
begin
commentHere;
CaretX:= i+2;
end
else
begin
unCommentHere;
CaretX:= i-2;
end;
EndUndoBlock;
end else
begin
mustUndo := false;
pt.X:= high(pt.X);
cp := CaretXY;
numUndo := 0;
for i := BlockBegin.Y-1 to BlockEnd.Y-1 do
begin
line := TrimLeft(Lines[i]);
dx := Lines[i].length - line.length;
lx := 0;
for j := 1 to dx do
if Lines[i][j] = #9 then
lx += TabWidth
else
lx += 1;
if (lx + 1 < pt.X) and not line.isEmpty then
pt.X:= lx + 1;
if (line.length > 1) and (line[1..2] = '//') then
numUndo += 1;
end;
if numUndo.equals(0) then
mustUndo := false
else if numUndo = BlockEnd.Y + 1 - BlockBegin.Y then
mustUndo := true;
BeginUndoBlock;
for i := BlockBegin.Y to BlockEnd.Y do
begin
pt.Y:= i;
ExecuteCommand(ecGotoXY, '', @pt);
while CaretX < pt.X do
ExecuteCommand(ecChar, ' ', nil);
if not mustUndo then
begin
commentHere;
end
else
unCommentHere;
end;
if not mustUndo then
cp.X += 2
else
cp.X -= 2;
CaretXY := cp;
EndUndoBlock;
end;
end;
procedure TDexedMemo.commentIdentifier;
var
str: string;
x, x0, x1: integer;
comBeg: boolean = false;
comEnd: boolean = false;
comment:boolean = true;
attrib: TSynHighlighterAttributes;
begin
if not GetHighlighterAttriAtRowColEx(CaretXY, str, x0, x, attrib) then
exit;
if str.isEmpty then
exit;
str := LineText;
x := LogicalCaretXY.X;
ExecuteCommand(ecWordEndRight, #0, nil);
x1 := LogicalCaretXY.X;
while true do
begin
if (str[x1] in ['*', '+']) and (x1 < str.length) and (str[x1+1] = '/') then
begin
comEnd:=true;
break;
end;
if not isBlank(str[x1]) then
break;
ExecuteCommand(ecRight, #0, nil);
x1 += 1;
if x1 = str.length then
break;
end;
LogicalCaretXY := point(x, LogicalCaretXY.Y);
ExecuteCommand(ecWordLeft, #0, nil);
x0 := LogicalCaretXY.X - 1;
if (x0 > 1) then
while true do
begin
if (x0 > 1) and (str[x0] in ['*', '+']) and (str[x0-1] = '/') then
begin
x0 -= 1;
comBeg:=true;
break;
end;
if not isBlank(str[x0]) then
break;
ExecuteCommand(ecLeft, #0, nil);
x0 -= 1;
if x0 = 1 then
break;
end;
comment := not comBeg and not comEnd;
LogicalCaretXY := point(x, LogicalCaretXY.Y);
if comment then
begin
BeginUndoBlock;
ExecuteCommand(ecWordLeft, '', nil);
ExecuteCommand(ecChar, '/', nil);
ExecuteCommand(ecChar, '*', nil);
ExecuteCommand(ecWordEndRight, '', nil);
ExecuteCommand(ecChar, '*', nil);
ExecuteCommand(ecChar, '/', nil);
EndUndoBlock;
end else
begin
BeginUndoBlock;
LogicalCaretXY := point(x1, LogicalCaretXY.Y);
ExecuteCommand(ecDeleteChar, '', nil);
ExecuteCommand(ecDeleteChar, '', nil);
LogicalCaretXY := point(x0, LogicalCaretXY.Y);
ExecuteCommand(ecDeleteChar, '', nil);
ExecuteCommand(ecDeleteChar, '', nil);
EndUndoBlock;
end;
end;
procedure TDexedMemo.invertVersionAllNone;
var
i: integer;
c: char;
tok, tok1, tok2: PLexToken;
cp, st, nd: TPoint;
sel: boolean;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
lexWholeText([lxoNoComments]);
cp := CaretXY;
if SelAvail then
begin
sel := true;
st := BlockBegin;
nd := BlockEnd;
end else
begin
sel := false;
st := Point(0,0);
nd := Point(0,0);
end;
for i := fLexToks.Count-1 downto 2 do
begin
tok := PLexToken(fLexToks[i]);
if sel and ((tok^.position.Y < st.Y)
or (tok^.position.Y > nd.Y)) then
continue;
if ((tok^.Data <> 'all') and (tok^.Data <> 'none'))
or (tok^.kind <> ltkIdentifier) or (i < 2) then
continue;
tok1 := PLexToken(fLexToks[i-2]);
tok2 := PLexToken(fLexToks[i-1]);
if ((tok1^.kind = ltkKeyword) and (tok1^.data = 'version')
and (tok2^.kind = ltkSymbol) and (tok2^.data = '(')) then
begin
BeginUndoBlock;
LogicalCaretXY := tok^.position;
CaretX:=CaretX+1;
case tok^.Data of
'all':
begin
for c in 'all' do ExecuteCommand(ecDeleteChar, '', nil);
for c in 'none' do ExecuteCommand(ecChar, c, nil);
end;
'none':
begin
for c in 'none' do ExecuteCommand(ecDeleteChar, '', nil);
for c in 'all' do ExecuteCommand(ecChar, c, nil);
end;
end;
EndUndoBlock;
end;
end;
CaretXY := cp;
end;
procedure TDexedMemo.renameIdentifier;
var
locs: TIntOpenArray = nil;
old, idt, line: string;
i, j, loc: integer;
p: TPoint;
c: char;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if not DcdWrapper.available then
exit;
p := CaretXY;
line := lineText;
if (line.length = 1) or (LogicalCaretXY.X > line.length) then
exit;
if (CaretX = 1) or not (line[LogicalCaretXY.X] in IdentChars) or
not (line[LogicalCaretXY.X-1] in IdentChars) then
exit;
old := GetWordAtRowCol(LogicalCaretXY);
DcdWrapper.getLocalSymbolUsageFromCursor(locs);
if length(locs).equals(0) then
begin
dlgOkInfo('Unknown, ambiguous or non-local symbol for "'+ old +'"');
exit;
end;
idt := 'new identifier for "' + old + '"';
idt := InputBox('Local identifier renaming', idt, old);
if idt.isEmpty or idt.isBlank then
exit;
for i:= high(locs) downto 0 do
begin
loc := locs[i];
if loc.equals(-1) then
continue;
BeginUndoBlock;
SelStart := loc + 1;
for j in [0..old.length-1] do
ExecuteCommand(ecDeleteChar, '', nil);
for c in idt do
ExecuteCommand(ecChar, c, nil);
EndUndoBlock;
CaretXY := p;
end;
end;
procedure TDexedMemo.centerCursor();
var
Y, LinesInWin, CurTopLine, NewTopLine: Integer;
begin
LinesInWin := LinesInWindow;
CurTopLine := TopView;
Y := ToPos(TextView.TextToViewIndex(ToIdx(CaretY)));
NewTopLine := Max(1, Y - (LinesInWin div 2));
if NewTopLine < 1 then NewTopLine := 1;
TopView := NewTopLine;
end;
procedure TDexedMemo.scrollCentered(down: boolean);
begin
centerCursor();
if not down then
begin
ExecuteCommand(ecScrollDown, #0, nil);
CaretY := CaretY - 1;
end else
begin
ExecuteCommand(ecScrollUp, #0, nil);
CaretY := CaretY + 1;
end;
end;
procedure TDexedMemo.setHighligtherFrom(other: TDexedMemo);
begin
if other.Highlighter = other.TxtHighlighter then
Highlighter := TxtHighlighter
else if other.Highlighter = other.D2Highlighter then
Highlighter := D2Highlighter
else if other.Highlighter = other.SxHighlighter then
Highlighter := SxHighlighter
else if other.Highlighter = other.CppHighlighter then
Highlighter := CppHighlighter
// LFM, JSON, etc. are shared instances
else
Highlighter := other.Highlighter;
end;
procedure TDexedMemo.ShowPhobosDoc;
var
str: string;
pth: string;
rac: string;
idt: string = '';
pos: integer;
len: integer;
sum: integer;
edt: TSynEdit;
rng: TStringRange = (ptr:nil; pos:0; len: 0);
i: integer;
linelen: integer;
procedure errorMessage(const msg: string);
begin
// parameter for doc racine is a folder
if rac[rac.length] in ['/','\'] then
rac += 'index.html'
else if rac.dirExists then
rac += DirectorySeparator + 'index.html'
else
rac += '/' + 'index.html';
if dlgYesNo(format('%s.%sOpen the documentation index anyway ?',
[msg, LineEnding])) = mrYes then
OpenURL(rac);
end;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if fPhobosDocRoot.dirExists then
rac := 'file://' + fPhobosDocRoot
else
rac := fPhobosDocRoot;
if rac.isEmpty then
rac := 'https://dlang.org/phobos/index.html';
DcdWrapper.getDeclFromCursor(str, pos);
if not str.fileExists then
begin
errorMessage('The source where the symbol is declared is not existing');
exit;
end;
// verify that the decl is in phobos
pth := str;
while true do
begin
if pth.extractFilePath = pth then
begin
errorMessage('The source where the symbol is declared does not seem' +
' to be part of Phobos or the D runtime');
exit;
end;
pth := pth.extractFilePath;
setLength(pth,pth.length-1);
if (pth.extractFilename = 'std') or (pth.extractFilename = 'core')
or (pth.extractFilename = 'etc') then
break;
end;
// get the declaration name
if pos <> -1 then
begin
edt := TSynEdit.Create(nil);
edt.Lines.LoadFromFile(str);
sum := 0;
len := getLineEndingLength(str);
for i := 0 to edt.Lines.Count-1 do
begin
linelen := edt.Lines[i].length;
if sum + linelen + len > pos then
begin
edt.CaretY := i + 1;
edt.CaretX := pos - sum + len;
edt.SelectWord;
idt := '.html#.' + edt.SelText;
break;
end;
sum += linelen;
sum += len;
end;
edt.Free;
end;
// guess the htm file + anchor
rng.init(str);
while true do
begin
if rng.empty then
begin
errorMessage('Failed to determine the matching HTML file');
exit;
end;
rng.popUntil(DirectorySeparator);
if not rng.empty then
rng.popFront;
if rng.startsWith('std' + DirectorySeparator) or rng.startsWith('core' + DirectorySeparator)
or rng.startsWith('etc' + DirectorySeparator) then
break;
end;
pth := rac;
while not rng.empty do
begin
pth += rng.takeUntil([DirectorySeparator, '.']).yield;
if rng.startsWith('.d') then
break;
pth += '_';
rng.popFront;
end;
pth += idt;
{$IFDEF WINDOWS}
if fPhobosDocRoot.dirExists then
for i:= 1 to pth.length do
if pth[i] = '\' then
pth[i] := '/';
{$ENDIF}
OpenURL(pth);
end;
procedure TDexedMemo.nextChangedArea;
begin
goToChangedArea(true);
end;
procedure TDexedMemo.previousChangedArea;
begin
goToChangedArea(false);
end;
procedure TDexedMemo.previousWarning;
begin
goToWarning(false);
end;
procedure TDexedMemo.nextWarning;
begin
goToWarning(true);
end;
procedure TDexedMemo.gotoLinePrompt;
var
d: string;
v: string;
i: integer;
begin
d := caretY.ToString;
v := InputBox('Goto line', 'line number', d);
if v.isNotEmpty and not v.Equals(d) then
begin
i := v.toIntNoExcept;
if i <> -1 then
begin
if i < 1 then
i := 1
else if i > lines.Count then
i := lines.Count;
CaretY:= i;
centerCursor();
end;
end;
end;
procedure TDexedMemo.showWarningForLine(line: integer);
var
s: string;
p: TPoint;
c: TPoint = (x: 0; y: 0);
begin
s := getDscannerWarning(line);
if s.isNotEmpty then
begin
p.x := 0;
p.y := line;
p := RowColumnToPixels(p);
c := ClientToScreen(c);
p.Offset(c);
s := 'Warning(s):' + LineEnding + s;
fDDocWin.FontSize := Font.Size;
fDDocWin.HintRect := fDDocWin.CalcHintRect(0, s, nil);
fDDocWin.OffsetHintRect(p, Font.Size);
fDDocWin.ActivateHint(fDDocWin.HintRect, s);
end;
end;
procedure TDexedMemo.showCurLineWarning;
begin
showWarningForLine(CaretY);
end;
procedure TDexedMemo.goToChangedArea(next: boolean);
var
i: integer;
s: TSynLineState;
d: integer;
b: integer = 0;
p: TPoint;
begin
i := CaretY - 1;
s := GetLineState(i);
case next of
true: begin d := 1; b := lines.count-1; end;
false:d := -1;
end;
if i = b then
exit;
// exit the current area if it's modified
while s <> slsNone do
begin
s := GetLineState(i);
if i = b then
exit;
i += d;
end;
// find next modified area
while s = slsNone do
begin
s := GetLineState(i);
if i = b then
break;
i += d;
end;
// goto area beg/end
if (s <> slsNone) and (i <> CaretY + 1) then
begin
p.X:= 1;
p.Y:= i + 1 - d;
ExecuteCommand(ecGotoXY, #0, @p);
centerCursor;
end;
end;
procedure TDexedMemo.goToProtectionGroup(next: boolean);
var
i: integer;
tk0, tk1: PLexToken;
tk: PLexToken = nil;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
lexWholeText([lxoNoComments, lxoNoWhites]);
for i:=0 to fLexToks.Count-2 do
begin
tk0 := fLexToks[i];
tk1 := fLexToks[i+1];
if not next then
begin
if tk0^.position.Y >= caretY then
break;
end
else if tk0^.position.Y <= caretY then
continue;
if tk0^.kind = ltkKeyword then
case tk0^.Data of
'public','private','protected','package','export':
if (tk1^.kind = ltkSymbol) and (tk1^.Data[1] in ['{',':']) then
begin
tk := tk0;
if next then
break;
end;
end;
end;
if assigned(tk) then
begin
ExecuteCommand(ecGotoXY, #0, @tk^.position);
centerCursor;
end;
end;
procedure TDexedMemo.goToWarning(next: boolean);
var
i: integer;
j: integer = -1;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if not next then
begin
for i:= 0 to fDscannerResults.count-1 do
begin
j := i - 1;
if fDscannerResults.item[i]^.line >= caretY then
break;
end;
if j <> -1 then
begin
CaretY:= fDscannerResults.item[j]^.line;
centerCursor;
end;
end
else
begin
for i:= fDscannerResults.count-1 downto 0 do
begin
j := i + 1;
if fDscannerResults.item[i]^.line <= caretY then
break;
end;
if (j <> -1) and (j < fDscannerResults.count) then
begin
CaretY:= fDscannerResults.item[j]^.line;
centerCursor;
end;
end;
end;
procedure TDexedMemo.previousProtectionGroup;
begin
goToProtectionGroup(false);
end;
procedure TDexedMemo.nextProtectionGroup;
begin
goToProtectionGroup(true);
end;
function TDexedMemo.implementMain: THasMain;
begin
case hasMainFun(PChar(self.Text)) of
false:result := mainNo;
true: result := mainYes;
end;
minimizeGcHeap();
end;
procedure TDexedMemo.autoClosePair(value: TAutoClosedPair);
var
i, p: integer;
tk0, tk1: PLexToken;
str: string;
const
dontCloseIfContiguousTo = [ltkIdentifier, ltkNumber, ltkString, ltkChar, ltkComment];
begin
if fLexToks.Count < 3 then
exit;
// -1: selstart is 1-based while tokens offset is 0-based (-1)
// -2: source is lexed before the insertion while this proc is called after the insertion
p := selStart - 2;
if value in [autoCloseBackTick, autoCloseDoubleQuote, autoCloseSingleQuote] then
begin
for i := 0 to fLexToks.Count-1 do
begin
tk0 := fLexToks[i];
// opening char is stuck to something, assume this thing is
// what has to be between the pair, so don't close.
if (tk0^.offset = p) and (tk0^.kind in dontCloseIfContiguousTo) then
exit;
if i < fLexToks.Count-1 then
begin
tk1 := fLexToks[i+1];
// inside a strings lit., char lit., comments, don't put the mess.
if (tk0^.offset < p) and (p < tk1^.offset) and
(tk0^.kind in [ltkString, ltkChar, ltkComment]) then
exit;
// ?? wut ??
// since the source is scanned before inserting the opening char,
// in single line comments, p can be > to next tok offset
// if (tk0^.offset < p) and (p > tk1^.offset) and
// (tk0^.kind = ltkComment) and (tk0^.Data[1] = '/') then
// exit;
end
// at the EOF an illegal tok is likely something that has to be closed so
// dont auto insert the pair.
else if (tk0^.offset < p) and (tk0^.kind = ltkIllegal) then
exit;
end;
end
else if value = autoCloseSquareBracket then
begin
for i:=0 to fLexToks.Count-2 do
begin
tk0 := fLexToks[i];
if (tk0^.offset < p) and (p < tk0^.offset + tk0^.data.length) then
exit;
tk1 := fLexToks[i+1];
// opening char is stuck to something, assume this thing is
// what has to be between the pair, so don't close.
if (tk0^.offset = p) and (tk0^.kind in dontCloseIfContiguousTo) then
exit;
if (tk0^.offset < p) and (p < tk1^.offset) and
(tk0^.kind = ltkComment) then
exit;
end;
tk0 := fLexToks[fLexToks.Count-1];
str := lineText;
i := LogicalCaretXY.X;
if (i <= str.length) and (lineText[i] = ']') then
exit;
end;
BeginUndoBlock;
ExecuteCommand(ecChar, autoClosePair2Char[value], nil);
ExecuteCommand(ecLeft, #0, nil);
EndUndoBlock;
end;
procedure TDexedMemo.setSelectionOrWordCase(upper: boolean);
var
i: integer;
txt: string;
begin
if SelAvail then
begin
BeginUndoBlock;
case upper of
false: txt := UTF8LowerString(SelText);
true: txt := UTF8UpperString(SelText);
end;
ExecuteCommand(ecBlockDelete, #0, nil);
for i:= 1 to txt.length do
case txt[i] of
#13: continue;
#10: ExecuteCommand(ecLineBreak, #0, nil);
else ExecuteCommand(ecChar, txt[i], nil);
end;
EndUndoBlock;
end else
begin
txt := GetWordAtRowCol(LogicalCaretXY);
if txt.isBlank then
exit;
BeginUndoBlock;
ExecuteCommand(ecWordLeft, #0, nil);
case upper of
false: txt := UTF8LowerString(txt);
true: txt := UTF8UpperString(txt);
end;
ExecuteCommand(ecDeleteWord, #0, nil);
for i:= 1 to txt.length do
ExecuteCommand(ecChar, txt[i], nil);
EndUndoBlock;
end;
end;
procedure TDexedMemo.sortSelectedLines(descending, caseSensitive: boolean);
var
i,j: integer;
lne: string;
lst: TStringList;
pt0: TPoint;
begin
if BlockEnd.Y - BlockBegin.Y < 1 then
exit;
lst := TStringList.Create;
try
BeginUndoBlock;
for i:= BlockBegin.Y-1 to BlockEnd.Y-1 do
lst.Add(lines[i]);
pt0 := BlockBegin;
pt0.X:=1;
ExecuteCommand(ecGotoXY, #0, @pt0);
lst.CaseSensitive:=caseSensitive;
if not caseSensitive then
lst.Sorted:=true;
case descending of
false: for i:= 0 to lst.Count-1 do
begin
ExecuteCommand(ecDeleteLine, #0, nil);
ExecuteCommand(ecInsertLine, #0, nil);
lne := lst[i];
for j := 1 to lne.length do
ExecuteCommand(ecChar, lne[j], nil);
ExecuteCommand(ecDown, #0, nil);
end;
true: for i:= lst.Count-1 downto 0 do
begin
ExecuteCommand(ecDeleteLine, #0, nil);
ExecuteCommand(ecInsertLine, #0, nil);
lne := lst[i];
for j := 1 to lne.length do
ExecuteCommand(ecChar, lne[j], nil);
ExecuteCommand(ecDown, #0, nil);
end;
end;
EndUndoBlock;
finally
lst.Free;
end;
end;
procedure TDexedMemo.sortLines;
begin
if fSortDialog.isNotAssigned then
fSortDialog := TSortDialog.construct(self);
fSortDialog.Show;
end;
procedure TDexedMemo.addCurLineBreakPoint;
begin
if not findBreakPoint(CaretY) then
addBreakPoint(CaretY);
end;
procedure TDexedMemo.removeCurLineBreakPoint;
begin
if findBreakPoint(CaretY) then
removeBreakPoint(CaretY);
end;
procedure TDexedMemo.toggleCurLineBreakpoint;
begin
if not findBreakPoint(CaretY) then
addBreakPoint(CaretY)
else
removeBreakPoint(CaretY);
end;
procedure TDexedMemo.insertDdocTemplate;
var
d: TStringList;
i: integer;
j: integer;
k: integer;
s: string;
p: TPoint;
begin
d := TStringList.Create;
try
d.Text := ddocTemplate(PChar(lines.Text), caretY, fInsertPlusDdoc);
if d.Text.isNotEmpty then
begin
BeginUndoBlock;
ExecuteCommand(ecLineStart, #0, nil);
k := CaretX;
p.y:= CaretY -1 ;
p.x:= 1 ;
ExecuteCommand(ecGotoXY, #0, @p);
for i := 0 to d.Count-1 do
begin
s := d[i];
ExecuteCommand(ecLineBreak, #0, nil);
while caretX < k do
ExecuteCommand(ecTab, #0, nil);
for j := 1 to s.length do
ExecuteCommand(ecChar, s[j], nil);
end;
EndUndoBlock;
end;
finally
d.Free;
end;
end;
procedure TDexedMemo.redoAll();
begin
BeginUpdate(false);
while CanRedo do
Redo;
EndUpdate();
end;
procedure TDexedMemo.undoAll();
begin
BeginUpdate(false);
while CanUndo do
Undo;
EndUpdate();
end;
procedure TDexedMemo.gotoWordEdge(right: boolean);
var
s: string;
c: char;
p: TPoint;
const
w: TSysCharSet = [' ', #9];
i: TSysCharSet = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
begin
s := LineText;
p := PhysicalToLogicalPos(CaretXY);
if (p.x <= 1) and not right then
begin
ExecuteCommand(ecLeft, #0, nil);
exit;
end;
if (p.x > s.length-1) and right then
begin
ExecuteCommand(ecRight, #0, nil);
exit;
end;
if right then
c := s[p.x]
else
c := s[min(p.x-1, s.length)];
if not right then
begin
if c in w then
ExecuteCommand(ecWordEndLeft, #0, nil)
else if c in i then
ExecuteCommand(ecWordLeft, #0, nil)
else
ExecuteCommand(ecLeft, #0, nil);
end
else
begin
if c in w then
ExecuteCommand(ecWordRight, #0, nil)
else if c in i then
ExecuteCommand(ecWordEndRight, #0, nil)
else
ExecuteCommand(ecRight, #0, nil);
end;
end;
{$ENDREGION}
{$REGION DDoc & CallTip --------------------------------------------------------}
procedure TDexedMemo.InitHintWins;
begin
if fCallTipWin.isNotAssigned then
begin
fCallTipWin := TEditorCallTipWindow.Create(self);
fCallTipWin.Color := clInfoBk + $01010100;
fCallTipWin.Font.Color:= clInfoText;
fCallTipWin.AutoHide:=false;
end;
if fDDocWin.isNotAssigned then
begin
fDDocWin := TEditorHintWindow.Create(self);
fDDocWin.Color := clInfoBk + $01010100;
fDDocWin.Font.Color:= clInfoText;
end;
end;
procedure TDexedMemo.showCallTips(findOpenParen: boolean = true);
var
s: string;
i: integer = 0;
o: TPoint;
p: TPoint;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
o := CaretXY;
if findOpenParen then
begin
lexWholeText([lxoNoWhites, lxoNoComments]);
i := getCurrentParameterIndex(fLexToks, CaretXY);
p := getCallExpLeftParenLoc(fLexToks, CaretXY);
// otherwise strange behavior of <kbd>SPACE</kbd>.
BeginUpdate();
CaretXY := p;
end;
DcdWrapper.getCallTip(s);
if findOpenParen then
begin
CaretXY := o;
EndUpdate();
end;
if s.isNotEmpty then
showCallTipsString(s, i);
end;
procedure TDexedMemo.showCallTipsString(const tips: string; indexOfExpected: integer);
var
pnt: TPoint;
begin
if (not fIsDSource and not alwaysAdvancedFeatures) or tips.isEmpty then
exit;
pnt := ClientToScreen(point(CaretXPix, CaretYPix));
fCallTipWin.indexOfExpectedArg:=indexOfExpected;
fCallTipWin.FontSize := Font.Size;
fCallTipWin.HintRect := fCallTipWin.CalcHintRect(0, tips, nil);
fCallTipWin.OffsetHintRect(pnt, Font.Size * 2);
fCallTipWin.ActivateDynamicHint(tips);
end;
procedure TDexedMemo.hideCallTips;
begin
if not fCallTipWin.Visible then
exit;
fCallTipWin.Hide;
end;
procedure TDexedMemo.decCallTipsLvl;
begin
if not fCallTipWin.Visible then
exit;
hideCallTips;
end;
procedure TDexedMemo.showDDocs;
var
exp: string;
ev1: string;
ev2: string;
str: string;
begin
fCanShowHint := false;
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if fDebugger.isAssigned and fDebugger.running then
begin
lexWholeText([TLexOption.lxoNoComments]);
exp := getExpressionAt(fLexToks, fMouseLogical);
ev1 := fDebugger.evaluate(exp);
if ev1.isEmpty then
ev1 := '???';
ev2 := fDebugger.evaluate('*' + exp);
if ev2.isEmpty then
ev2 := '???';
str := format('exp: %s'#10'---'#10'%s'#10'---'#10'%s', [exp, ev1, ev2]);
end
else DcdWrapper.getDdocFromCursor(str);
if str.isNotEmpty then
begin
fDDocWin.FontSize := Font.Size;
fDDocWin.HintRect := fDDocWin.CalcHintRect(0, str, nil);
fDDocWin.OffsetHintRect(mouse.CursorPos, Font.Size);
fDDocWin.ActivateHint(fDDocWin.HintRect, str);
end;
end;
procedure TDexedMemo.hideDDocs;
begin
fCanShowHint := false;
fDDocWin.Hide;
end;
procedure TDexedMemo.setDDocDelay(value: Integer);
begin
fDDocDelay:=value;
fDDocTimer.Interval:=fDDocDelay;
end;
procedure TDexedMemo.DDocTimerEvent(sender: TObject);
begin
if (not Visible) or (not isDSource) or (not fCanShowHint) then
exit;
showDDocs;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Completion ------------------------------------------------------------}
procedure TDexedMemo.completionExecute(sender: TObject);
begin
if fIsDSource then
begin
hideDDocs;
hideCallTips;
end;
fCompletion.TheForm.Font.Size := Font.Size;
fCompletion.TheForm.BackgroundColor:= self.Color;
fCompletion.TheForm.TextColor:= fD2Highlighter.identifiers.Foreground;
getCompletionList;
end;
procedure TDexedMemo.completionDeleteKey(sender: TObject);
begin
if CaretX > 0 then
begin
getCompletionList();
if fCompletion.TheForm.ItemList.Count.equals(0) then
begin
fCompletion.TheForm.Close;
exit;
end;
end;
if fCompletionMenuAutoClose and (fCompletion.CurrentString.length < 2) then
fCompletion.TheForm.Close;
end;
procedure TDexedMemo.getCompletionList;
var
i: integer;
o: TObject;
w: string;
r: TStringRange = (ptr:nil; pos:0; len: 0);
h: TStringHashSet;
const
c: TSysCharSet = ['A'..'Z', 'a'..'z', '_'];
a: TSysCharSet = ['A'..'Z', 'a'..'z', '_', '0' .. '9'];
begin
fCompletion.Position := 0;
fCompletion.ItemList.Clear;
if fIsDSource and DCDWrapper.available then
begin
DcdWrapper.getComplAtCursor(TStringList(fCompletion.ItemList));
if fLastCompletion.isNotEmpty then
begin
i := fCompletion.ItemList.IndexOf(fLastCompletion);
if i <> -1 then
begin
o := fCompletion.ItemList.Objects[i];
fCompletion.ItemList.Delete(i);
fCompletion.ItemList.InsertObject(0, fLastCompletion, o);
end
else fLastCompletion:= '';
end;
end;
if fTextCompletion then
begin
h := TStringHashSet.create();
for i := 0 to lines.Count-1 do
begin
if i.equals(CaretY - 1) then
continue;
r := TStringRange.create(lines[i]);
while not r.empty do
begin
w := r.popUntil(c)^.takeWhile(a).yield;
if (w.length >= fTextCompletionMinLength) and not h.contains(w) then
begin
h.insert(w);
fCompletion.ItemList.AddObject(w, TObject(PtrUint(dckText)));
end;
end;
end;
h.Free;
TStringList(fCompletion.ItemList).Sort();
end;
end;
procedure TDexedMemo.completionCodeCompletion(var value: string;
SourceValue: string; var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char;
Shift: TShiftState);
begin
if KeyChar = '' then
exit;
if (KeyChar = '.') and (SourceValue <> value) then
begin
value := SourceValue + '.';
exit;
end;
if KeyChar[1] = ' ' then
value := sourceValue + KeyChar[1]
else
begin
fLastCompletion := value;
if (KeyChar[1] in fCloseCompletionCharsWithSpace) then
begin
if value.StartsWith(SourceValue) then
value += ' ' + KeyChar[1]
else
value := sourceValue + KeyChar[1];
end
else if (KeyChar[1] in fCloseCompletionChars) then
begin
if value.StartsWith(SourceValue) then
value += KeyChar[1]
else
value := sourceValue + KeyChar[1];
end;
end;
end;
procedure TDexedMemo.completionFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if char(key) = #9 then
key := 13;
end;
function TDexedMemo.completionItemPaint(const AKey: string; ACanvas: TCanvas;X, Y: integer;
Selected: boolean; Index: integer): boolean;
var
dck: TDCDCompletionKind;
knd: string;
len: Integer;
begin
result := true;
// empty items can be produced if completion list is too long
if aKey.isEmpty then
exit;
{$PUSH} {$Warnings OFF} {$Hints OFF}
dck := TDCDCompletionKind(PtrUInt(fCompletion.ItemList.Objects[index]));
knd := DcdCompletionKindStrings[dck];
{$POP}
ACanvas.Font.Style := [fsBold];
len := ACanvas.TextExtent(aKey).cx;
ACanvas.TextOut(2 + X , Y, aKey);
case dck of
dckALias, dckClass, dckStruct, dckUnion, dckEnum, dckInterface:
ACanvas.Font.Color:= clMaroon;
dckMember, dckEnum_member, dckVariable, dckArray, dckAA:
ACanvas.Font.Color:= clGray;
dckReserved:
ACanvas.Font.Color:= clNavy;
dckFunction:
ACanvas.Font.Color:= clGreen;
dckPackage, dckModule:
ACanvas.Font.Color:= clBlue;
dckTemplate, dckMixin:
ACanvas.Font.Color:= clTeal;
dckText:
ACanvas.Font.Color:= clLtGray;
end;
ACanvas.Font.Style := [fsItalic];
ACanvas.TextOut(2 + X + len + 2, Y, knd);
end;
procedure TDexedMemo.AutoDotTimerEvent(sender: TObject);
begin
if not fCanAutoDot or fAutoDotDelay.equals(0) then
exit;
fCanAutoDot := false;
fCompletion.Execute('', ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
procedure TDexedMemo.setAutoDotDelay(value: Integer);
begin
fAutoDotDelay:=value;
fAutoDotTimer.Interval:=fAutoDotDelay;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Dscanner --------------------------------------------------------------}
constructor TDscannerResults.create;
begin
fList := TFPList.Create;
end;
destructor TDscannerResults.destroy;
begin
clear;
fList.Free;
inherited;
end;
procedure TDscannerResults.clear;
var
i: integer;
begin
for i:= 0 to fList.Count-1 do
dispose(PDscannerResult(fList[i]));
fList.Clear;
end;
procedure TDscannerResults.push(const warning: string; line, column: integer);
var
r: PDscannerResult;
begin
r := new(PDscannerResult);
r^.column:=column;
r^.warning:=warning;
r^.line:=line;
fList.Add(r);
end;
function TDscannerResults.getCount: integer;
begin
result := fList.Count;
end;
function TDscannerResults.getItem(index: integer): PDscannerResult;
begin
result := PDscannerResult(fList[index]);
end;
procedure TDexedMemo.setDscannerOptions(dsEnabled: boolean; dsDelay: integer);
begin
fDscannerTimer.Interval:=dsDelay;
fDscannerEnabled := dsEnabled;
if not dsEnabled then
removeDscannerWarnings
else
dscannerTimerEvent(nil);
end;
procedure TDexedMemo.dscannerTimerEvent(sender: TObject);
var
s: string;
begin
if not fDscannerEnabled or not fKnowsDscanner or not isDSource
or not fCanDscan then
exit;
if fDscanner.Running then
begin
fDscanner.Terminate(0);
sleep(1);
end;
removeDscannerWarnings;
fCanDscan := false;
fDScanner.execute;
s := Lines.strictText;
if s.length > 0 then
fDscanner.Input.Write(s[1], s.length);
fDscanner.CloseInput;
end;
procedure TDexedMemo.dscannerTerminate(sender: TObject);
procedure processLine(const lne: string);
var
r: TStringRange = (ptr:nil; pos:0; len: 0);
line: integer;
column: integer;
begin
if lne.isBlank then
exit;
r.init(lne);
line := r.popUntil('(')^.popFront^.takeWhile(['0'..'9']).yield.toIntNoExcept();
column := r.popFront^.takeWhile(['0'..'9']).yield.toIntNoExcept();
r.popUntil(':');
r.popFront;
fDscannerResults.push(r.takeUntil(#0).yield, line, column);
addGutterIcon(line, giWarn);
end;
var
i: integer;
s: string;
m: TStringList;
begin
m := TStringList.Create;
try
fDscanner.getFullLines(m);
for i := 0 to m.Count-1 do
begin
s := m[i];
processLine(s);
end;
finally
m.free;
end;
end;
procedure TDexedMemo.removeDscannerWarnings;
var
i: integer;
n: TSynEditMark;
begin
IncPaintLock;
fDscannerResults.clear;
for i:= Marks.Count-1 downto 0 do
begin
n := marks.Items[i];
if n.ImageIndex = longint(giWarn) then
begin
marks.Delete(i);
FreeAndNil(n);
end;
end;
DecPaintLock;
repaint;
end;
function TDexedMemo.getDscannerWarning(line: integer): string;
const
spec = '@column %d: %s' + LineEnding;
var
i: integer;
w: PDscannerResult;
begin
result := '';
for i := 0 to fDscannerResults.count-1 do
begin
w := fDscannerResults[i];
if w^.line = line then
result += format(spec, [w^.column, w^.warning]);
end;
end;
function TDexedMemo.lineHasDscannerWarning(line: integer): boolean;
var
i: integer;
begin
result := false;
for i := 0 to fDscannerResults.count-1 do
if fDscannerResults[i]^.line = line then
exit(true);
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION memo things -----------------------------------------------------------}
procedure TDexedMemo.handleStatusChanged(Sender: TObject; Changes: TSynStatusChanges);
begin
if scOptions in Changes then
begin
if fSmartDdocNewline and not (eoAutoIndent in Options) then
Options := Options + [eoAutoIndent];
if Beautifier.isAssigned and (Beautifier is TSynBeautifier) then
begin
if not (eoTabsToSpaces in Options) and not (eoSpacesToTabs in Options) then
TSynBeautifier(Beautifier).IndentType := sbitConvertToTabOnly
else if eoSpacesToTabs in options then
TSynBeautifier(Beautifier).IndentType := sbitConvertToTabOnly
else
TSynBeautifier(Beautifier).IndentType := sbitSpace;
end;
end;
end;
function TDexedMemo.pageCaption(checkModule: boolean): string;
begin
result := '';
fHasModuleDeclaration := false;
if checkModule and isDSource then
begin
fLexToks.Clear;
lex(Lines.Text, fLexToks, @tokFoundForCaption, [lxoNoComments]);
if fHasModuleDeclaration then
result := getModuleName(fLexToks);
end;
if result.length.equals(0) then
begin
if fFilename.length > 0 then
result := fFilename.extractFileName
else
result := newdocPageCaption;
end;
end;
procedure TDexedMemo.tokFoundForCaption(const token: PLexToken; out stop: boolean);
begin
if token^.kind = ltkKeyword then
begin
if token^.data = 'module' then
fModuleTokFound := true
else
// "module" is always the first KW
stop := true;
end
else if fModuleTokFound and (token^.kind = ltkSymbol) and (token^.data = ';') then
begin
stop := true;
fModuleTokFound := false;
fHasModuleDeclaration := true;
end;
end;
function TDexedMemo.canInsertLeadingDdocSymbol: char;
var
i: integer;
p: TPoint;
tk1: PLexToken = nil;
tk2: PLexToken = nil;
begin
// note: never use SelStart here. SelStart is updated too early
// and matches to the future position, e.g the one after auto-indentation.
result := #0;
p := CaretXY;
for i := 0 to fLexToks.Count-1 do
begin
tk1 := fLexToks[i];
if (i <> fLexToks.Count-1) then
begin
tk2 := fLexToks[i+1];
if (tk1^.position < p) and (tk1^.kind in [ltkComment, ltkIllegal])
and (p <= tk2^.position) and (tk1^.Data[1] in ['*','+']) then
begin
exit(tk1^.Data[1]);
end
else if (tk1^.position > p) then
exit;
end
else if (tk1^.position < p) and (tk1^.kind in [ltkComment, ltkIllegal])
and (tk1^.Data[1] in ['*','+']) then
exit(tk1^.Data[1]);
end;
end;
function TDexedMemo.lexCanCloseBrace: TBraceCloseOption;
var
i: integer;
p: integer;
c: integer = 0;
tok: PLexToken = nil;
ton: PLexToken = nil;
bet: boolean;
begin
p := SelStart;
for i := 0 to fLexToks.Count-1 do
begin
tok := fLexToks[i];
if (i <> fLexToks.Count-1) then
begin
ton := fLexToks[i+1];
bet := (tok^.offset + 1 <= p) and (p < ton^.offset + 2);
end else
bet := false;
if bet and (tok^.kind = ltkComment) then
exit(braceCloseInvalid);
c += byte((tok^.kind = TLexTokenKind.ltkSymbol) and (((tok^.Data = '{')) or (tok^.Data = 'q{')));
c -= byte((tok^.kind = TLexTokenKind.ltkSymbol) and (tok^.Data = '}'));
if bet and c.equals(0) then
exit(braceCloseLessEven);
end;
if (tok <> nil) and (tok^.kind = ltkIllegal) then
result := braceCloseInvalid
else if c > 0 then
result := braceClosePositive
else
result := braceCloseLessEven;
end;
procedure TDexedMemo.SetHighlighter(const Value: TSynCustomHighlighter);
begin
inherited;
fIsDSource := Highlighter = fD2Highlighter;
end;
procedure TDexedMemo.setHighligthedIdent(value: string);
begin
if fHighlightedIdent = value then
exit;
fHighlightedIdent := value;
highlightCurrentIdentifier(false);
end;
procedure TDexedMemo.highlightCurrentIdentifier(fromEditor: boolean = true);
var
s: string;
i: integer;
begin
if fromEditor then
fHighlightedIdent := GetWordAtRowCol(LogicalCaretXY);
if (fHighlightedIdent.length > 2) and (not SelAvail) then
SetHighlightSearch(fHighlightedIdent, fMatchIdentOpts)
else if SelAvail and (BlockBegin.Y = BlockEnd.Y) then
begin
s := SelText;
for i := 1 to s.length do
begin
if not (s[i] in [' ', #9, #10, #13]) then
begin
SetHighlightSearch(s, fMatchSelectionOpts);
break;
end;
if i = s.length then
SetHighlightSearch('', []);
end;
end
else SetHighlightSearch('', []);
end;
procedure TDexedMemo.setMatchOpts(value: TIdentifierMatchOptions);
begin
fMatchOpts:= value;
fMatchIdentOpts := TSynSearchOptions(fMatchOpts);
fMatchSelectionOpts:= TSynSearchOptions(fMatchOpts - [wholeWord]);
end;
procedure TDexedMemo.changeNotify(Sender: TObject);
begin
highlightCurrentIdentifier;
fModified := true;
fPositions.store;
subjDocChanged(TMultiDocSubject(fMultiDocSubject), self);
end;
procedure TDexedMemo.loadFromFile(const fname: string);
var
e: string;
c: boolean;
s: boolean;
begin
e := fname.extractFileExt;
fIsDsource := hasDlangSyntax(e);
c := hasCppSyntax(e);
s := hasSxSyntax(e);
if not fIsDsource then
begin
if c then
Highlighter := CppHighlighter
else if s then
Highlighter := SxHighlighter
else
Highlighter := TxtSyn;
end;
fFilename := fname;
if not FilenameIsAbsolute(fFilename) then
fFilename := ExpandFileName(fFilename);
Lines.LoadFromFile(fname);
FileAge(fFilename, fFileDate);
fModified := false;
if Showing then
begin
setFocus;
loadCache;
fCacheLoaded := true;
end;
tryToPatchMixedIndentation();
subjDocChanged(TMultiDocSubject(fMultiDocSubject), self);
fCanDscan := true;
end;
procedure TDexedMemo.saveToFile(const fname: string);
var
ext: string;
begin
if fname.fileExists and not FileIsWritable(fname) then
begin
getMessageDisplay.message('The file is read-only, save your changes in a copy',
self, amcEdit, amkWarn);
exit;
end;
Lines.SaveToFile(fname);
fFilename := fname;
ext := fname.extractFileExt;
fIsDsource := hasDlangSyntax(ext);
if fIsDsource then
Highlighter := fD2Highlighter
else if not isProjectDescription then
begin
if hasCppSyntax(ext) then
Highlighter := CppHighlighter
else if hasSxSyntax(ext) then
Highlighter := SxHighlighter
else
Highlighter := TxtHighlighter;
end;
FileAge(fFilename, fFileDate);
fModified := false;
if fFilename <> fTempFileName then
begin
if fTempFileName.fileExists then
sysutils.DeleteFile(fTempFileName);
subjDocChanged(TMultiDocSubject(fMultiDocSubject), self);
end;
end;
procedure TDexedMemo.save;
begin
if fFilename.fileExists and not FileIsWritable(fFilename) then
begin
getMessageDisplay.message('The file is read-only, save your changes in a copy',
self, amcEdit, amkWarn);
exit;
end;
Lines.SaveToFile(fFilename);
FileAge(fFilename, fFileDate);
fModified := false;
if fFilename <> fTempFileName then
subjDocChanged(TMultiDocSubject(fMultiDocSubject), self);
end;
procedure TDexedMemo.saveTempFile;
begin
saveToFile(fTempFileName);
fModified := false;
end;
function TDexedMemo.getIfTemp: boolean;
begin
exit(fFilename = fTempFileName);
end;
procedure TDexedMemo.saveCache;
var
cache: TSynMemoCache;
begin
cache := TSynMemoCache.create(self);
try
cache.save;
finally
cache.free;
end;
end;
procedure TDexedMemo.loadCache;
var
cache: TSynMemoCache;
begin
cache := TSynMemoCache.create(self);
try
cache.load;
finally
cache.free;
end;
end;
class procedure TDexedMemo.cleanCache;
var
lst: TStringList;
today, t: TDateTime;
fname: string;
y, m, d: word;
begin
lst := TStringList.Create;
try
listFiles(lst, getDocPath + 'editorcache' + DirectorySeparator);
today := date();
for fname in lst do if FileAge(fname, t) then
begin
DecodeDate(t, y, m, d);
IncAMonth(y, m, d, 3);
if EncodeDate(y, m, d) <= today then
sysutils.DeleteFile(fname);
end;
finally
lst.free;
end;
end;
procedure TDexedMemo.replaceUndoableContent(const value: string);
var
b: TPoint;
e: TPoint;
p: TPoint;
begin
p := CaretXY;
b := point(1,1);
e := Point(length(Lines[lines.Count-1])+1,lines.Count);
TextBetweenPoints[b,e] := value;
CaretXY := p;
centerCursor;
fModified := true;
end;
procedure TDexedMemo.checkFileDate;
var
mr : TModalResult;
newDate : double;
newMd5 : TMDDigest;
curMd5 : TMDDigest;
p : TPoint;
function reload(): string;
begin
with TStringList.Create() do
try
LoadFromFile(fFilename);
result := strictText();
finally
Free;
end;
end;
begin
if fDiffDialogWillClose or fDisableFileDateCheck then
exit;
if fFilename.isNotEmpty and not fFilename.fileExists and
(fFilename <> newdocPageCaption) then
begin
// cant use a dialog: dialog closed -> doc focused -> warn again, etc
getMessageDisplay.message(fFilename + ' does not exist anymore', self, amcEdit, amkWarn);
end;
if (fFilename = fTempFileName) or fDisableFileDateCheck
or not FileAge(fFilename, newDate) or (fFileDate = newDate) then
exit;
if (fFileDate <> 0.0) then
begin
newMd5 := MD5String(reload());
curMd5 := MD5String(lines.strictText);
if not MDMatch(curMd5, newMd5) then
begin
lines.SaveToFile(tempFilename);
fDiffDialogWillClose := true;
with TDiffViewer.construct(self, fTempFileName, fFilename) do
try
mr := ShowModal;
case mr of
mrOK:
begin
replaceUndoableContent(reload());
fModified := false;
fFileDate := newDate;
fCanDscan := true;
end;
mrAll:
begin
fCanDscan := true;
p := self.CaretXY;
fModified := false;
self.text := reload();
fFileDate := newDate;
CaretXY := p;
end;
mrIgnore:
begin
fFileDate := newDate;
end;
mrCancel:
begin
end;
end;
finally
free;
fDiffDialogWillClose := false;
end;
end;
end
else fFileDate := newDate;
end;
function TDexedMemo.getMouseBytePosition: Integer;
var
i, len, llen: Integer;
begin
result := 0;
if fMousePhysical.y-1 > Lines.Count-1 then
exit;
llen := Lines[fMousePhysical.y-1].length;
if fMousePhysical.X > llen then
exit;
len := getSysLineEndLen;
for i:= 0 to fMousePhysical.y-2 do
result += Lines[i].length + len;
result += fMousePhysical.x;
end;
procedure TDexedMemo.patchClipboardIndentation;
var
lst: TStringList;
i: integer;
begin
//TODO: Check for changes made to option eoSpacesToTabs
if not (eoTabsToSpaces in Options) then
exit;
lst := TStringList.Create;
lst.Text := clipboard.asText;
try
for i := 0 to lst.count-1 do
lst[i] := leadingTabsToSpaces(lst[i], TabWidth);
clipboard.asText := lst.strictText;
finally
lst.free;
end;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION user input ------------------------------------------------------------}
procedure TDexedMemo.KeyDown(var Key: Word; Shift: TShiftState);
var
line: string;
ddc: char;
ccb: TBraceCloseOption;
begin
case Key of
VK_BACK:
begin
fCanDscan:=true;
if fCallTipWin.Visible and (CaretX > 1)
and (LineText[LogicalCaretXY.X-1] = '(') then
decCallTipsLvl;
end;
VK_RETURN:
if isDSource then
begin
fCanDscan:=true;
line := LineText;
if [ssCtrl] <> Shift then
begin
if (fSmartDdocNewline) then
begin
lexWholeText();
ddc := canInsertLeadingDdocSymbol;
if ddc in ['*', '+'] then
begin
inherited;
insertLeadingDDocSymbol(ddc);
fCanShowHint:=false;
fDDocWin.Hide;
exit;
end;
end;
if ((LogicalCaretXY.X - 1 >= line.length) or
isBlank(line[LogicalCaretXY.X .. line.length])) then
begin
lexWholeText([TLexOption.lxoNoWhites, TLexOption.lxoNoComments]);
ccb := lexCanCloseBrace;
if ccb <> braceCloseInvalid then
begin
Key := 0;
curlyBraceCloseAndIndent((ccb = braceClosePositive) and not (fAutoCloseCurlyBrace = autoCloseNever));
end;
end;
end
else shift := [];
end;
end;
inherited;
highlightCurrentIdentifier;
if fCompletion.IsActive then
fCompletion.CurrentString:= GetWordAtRowCol(LogicalCaretXY);
case Key of
VK_BROWSER_BACK: fPositions.back;
VK_BROWSER_FORWARD: fPositions.next;
VK_ESCAPE:
begin
hideCallTips;
hideDDocs;
end;
end;
if not (Shift = [ssCtrl]) then
exit;
case Key of
VK_ADD: if Font.Size < 50 then
Font.Size := Font.Size + 1;
VK_SUBTRACT: if Font.Size > 3 then
Font.Size := Font.Size - 1;
VK_DECIMAL: Font.Size := fDefaultFontSize;
end;
fCanShowHint:=false;
fDDocWin.Hide;
end;
procedure TDexedMemo.KeyUp(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_PRIOR, VK_NEXT, VK_UP: fPositions.store;
VK_OEM_PERIOD, VK_DECIMAL: fCanAutoDot := (fLastUp <> VK_OEM_PERIOD) and (fLastUp <> VK_DECIMAL);
end;
inherited;
if fAutoCallCompletion and (fIsDSource or textCompletion or alwaysAdvancedFeatures) and
(not fCompletion.IsActive) and (Key < $80) and (char(Key) in ['a'..'z', 'A'..'Z', '_']) then
begin
if Shift = [] then
fCompletion.Execute(GetWordAtRowCol(LogicalCaretXY),
ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
if (Key = VK_BACK) and fCallTipWin.Visible then
showCallTips(true);
fLastUp := Key;
end;
procedure TDexedMemo.UTF8KeyPress(var Key: TUTF8Char);
var
c: AnsiChar;
begin
c := Key[1];
// scan source before insertion if pair auto closing is allowed otherwise the
// tokens following the cursor are wrong after the "inherited" call.
case c of
#39: if autoCloseSingleQuote in fAutoClosedPairs then
lexWholeText();
'"': if autoCloseDoubleQuote in fAutoClosedPairs then
lexWholeText();
'`': if autoCloseBackTick in fAutoClosedPairs then
lexWholeText();
'[': if autoCloseSquareBracket in fAutoClosedPairs then
lexWholeText();
end;
inherited;
if fCallTipWin.Visible then
begin
//fCallTipStrings.clear;
//lexWholeText([lxoNoComments, lxoNoWhites]);
//i := getCurrentParameterIndex(fLexToks, CaretXY);
//showCallTipsString(fCallTipStrings.Text, i);
showCallTips(true);
end;
fCanDscan := true;
case c of
#39: if autoCloseSingleQuote in fAutoClosedPairs then
autoClosePair(autoCloseSingleQuote);
',':
begin
if not fCallTipWin.Visible then
showCallTips(true);
end;
'"': if autoCloseDoubleQuote in fAutoClosedPairs then
autoClosePair(autoCloseDoubleQuote);
'`': if autoCloseBackTick in fAutoClosedPairs then
autoClosePair(autoCloseBackTick);
'[': if autoCloseSquareBracket in fAutoClosedPairs then
autoClosePair(autoCloseSquareBracket);
'(': showCallTips(false);
')': if fCallTipWin.Visible then
decCallTipsLvl;
'{': if (fAutoCloseCurlyBrace = autoCloseLexically) and
(GetKeyShiftState <> [ssShift]) then
begin
lexWholeText([TLexOption.lxoNoWhites, TLexOption.lxoNoComments]);
case lexCanCloseBrace of
braceClosePositive: curlyBraceCloseAndIndent;
braceCloseLessEven: curlyBraceCloseAndIndent(false);
end;
end;
end;
if fCompletion.IsActive then
fCompletion.CurrentString:=GetWordAtRowCol(LogicalCaretXY);
end;
procedure TDexedMemo.MouseLeave;
begin
inherited;
hideDDocs;
hideCallTips;
fScrollMemo.Visible:=false;
end;
procedure TDexedMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
var
dx, dy: Integer;
begin
hideDDocs;
hideCallTips;
inherited;
dx := X - fOldMousePos.x;
dy := Y - fOldMousePos.y;
fCanShowHint:=false;
if (shift = []) and
(((dx < 0) and (dx > -5) or (dx > 0) and (dx < 5)) or
((dy < 0) and (dy > -5) or (dy > 0) and (dy < 5))) then
fCanShowHint:=true;
fOldMousePos := Point(X, Y);
fMousePhysical := PixelsToRowColumn(fOldMousePos);
fMouseLogical := PixelsToLogicalPos(fOldMousePos);
if ssLeft in Shift then
highlightCurrentIdentifier;
if fScrollPreview then
begin
if (x > width - 40) and (x < width - 20) then
begin;
fScrollMemo.Visible:=true;
fScrollMemo.goToLine(trunc((lines.Count / Height) * Y));
fScrollMemo.left := mouse.CursorPos.x - fScrollMemo.Width - 10;
fScrollMemo.Top:= Y - 5;
end
else
begin
fScrollMemo.Visible:=false;
end;
end;
end;
procedure TDexedMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer);
begin
inherited;
highlightCurrentIdentifier;
fCanShowHint := false;
hideCallTips;
hideDDocs;
if (emAltSetsColumnMode in MouseOptions) and not (eoScrollPastEol in Options)
and (ssLeft in shift) and (ssAlt in Shift) then
begin
fOverrideColMode := true;
Options := Options + [eoScrollPastEol];
end;
end;
procedure TDexedMemo.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;
centerCursor;
fScrollMemo.Visible:=false;
mouse.CursorPos := pt;
fPositions.store;
end;
case Button of
mbMiddle: if (Shift = [ssCtrl]) then
Font.Size := fDefaultFontSize;
mbExtra1: fPositions.back;
mbExtra2: fPositions.next;
mbLeft: fPositions.store;
end;
if fOverrideColMode and not SelAvail then
begin
fOverrideColMode := false;
Options := Options - [eoScrollPastEol];
end;
end;
function TDexedMemo.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
begin
result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
fCanShowHint:=false;
fDDocTimer.Enabled:=false;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION debugging/breakpoints -------------------------------------------------}
function TDexedMemo.breakPointsCount: integer;
var
i: integer;
begin
result := 0;
for i := 0 to marks.count-1 do
result += byte(marks[i].ImageIndex = integer(giBreakSet));
end;
procedure TDexedMemo.tryToPatchMixedIndentation;
var
s: integer;
t: integer;
begin
if fLifeTimeManager.isAssigned and not fIdentDialShown and (lines.Count <> 0) and
((fLifeTimeManager as ILifetimeManager).getLifetimeStatus = lfsLoaded)
then
begin
fIdentDialShown := true;
case indentationMode(t, s) of
imTabs:
if detectIndentMode then
Options:= Options - [eoTabsToSpaces];
imSpaces:
if detectIndentMode then
Options:= Options + [eoTabsToSpaces];
imMixed:
if (isDSource or alwaysAdvancedFeatures) and
(dlgYesNo('Mixed indentation style detected in, "' + fFilename +
'", do you wish to convert to a single mode ?') = mrYes) then
with TMixedIndentationDialog.construct(s, t) do
try
case ShowModal of
10:
begin
forceIndentation(imTabs, TMixedIndentationDialog.fSpacesPerTab);
Options:= Options - [eoTabsToSpaces];
Options:= Options + [eoSpacesToTabs];
end;
11:
begin
forceIndentation(imSpaces, TMixedIndentationDialog.fSpacesPerTab);
Options:= Options + [eoTabsToSpaces];
Options:= Options - [eoSpacesToTabs];
end;
end;
finally
free;
end;
end;
if not (eoTabsToSpaces in Options) then
begin
BlockIndent := 0;
BlockTabIndent := 1;
end
else
begin
BlockIndent := TabWidth;
BlockTabIndent := 0;
end;
end;
end;
procedure TDexedMemo.addBreakPoint(line: integer);
begin
if findBreakPoint(line) then
exit;
addGutterIcon(line, giBreakSet);
if fDebugger.isAssigned then
fDebugger.addBreakPoint(fFilename, line, bpkBreak);
end;
procedure TDexedMemo.removeBreakPoint(line: integer);
var
break2step: boolean;
begin
if not findBreakPoint(line) then
exit;
break2step := isGutterIconSet(line, giBreakReached);
removeGutterIcon(line, giBreakSet);
if fDscannerEnabled and lineHasDscannerWarning(line) then
addGutterIcon(line, giWarn);
if fDebugger.isAssigned then
begin
fDebugger.removeBreakPoint(fFilename, line);
if break2step and fDebugger.running then
addGutterIcon(line, giStep);
end;
end;
procedure TDexedMemo.showHintEvent(Sender: TObject; HintInfo: PHintInfo);
var
p: TPoint;
begin
p := ScreenToClient(mouse.CursorPos);
if p.x > fMultiGutterMarks.Width then
exit;
p := self.PixelsToRowColumn(p);
showWarningForLine(p.y);
end;
procedure TDexedMemo.removeDebugTimeMarks;
var
i: integer;
n: TSynEditMark;
begin
IncPaintLock;
for i:= marks.Count-1 downto 0 do
begin
n := Marks.Items[i];
n.Visible := not (TGutterIcon(n.ImageIndex) in debugTimeGutterIcons);
end;
DecPaintLock;
end;
function TDexedMemo.isGutterIconSet(line: integer; value: TGutterIcon): boolean;
var
m: TSynEditMarkLine = nil;
i: integer;
begin
result := false;
if line <= lines.count then
m := marks.Line[line];
if m.isAssigned then
for i := 0 to m.count - 1 do
if m[i].Visible and (m[i].ImageIndex = integer(value)) then
exit(true);
end;
function gutterIconKindToColumn(value: TGutterIcon): integer;
begin
result := 0;
case value of
giBreakSet : result := 1;
giBulletGreen : result := 2;
giBulletBlack : result := 2;
giBreakReached : result := 2;
giStep : result := 2;
giWatch : result := 2;
giWarn : result := 0;
end;
end;
function TDexedMemo.findBreakPoint(line: integer): boolean;
begin
result := isGutterIconSet(line, giBreakSet);
end;
procedure TDexedMemo.gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
begin
if findBreakPoint(line) then
removeBreakPoint(line)
else
addBreakPoint(line);
CaretY := Line;
end;
procedure TDexedMemo.addGutterIcon(line: integer; value: TGutterIcon);
var
m: TSynEditMarkLine;
n: TSynEditMark;
i: integer;
s: boolean = false;
begin
m := Marks.Line[line];
if m.isAssigned then
for i := 0 to m.Count-1 do
begin
n := m.Items[i];
s := n.ImageIndex = longint(value);
if s then
n.Visible := true;
end;
if not s then
begin
n:= TSynEditMark.Create(self);
n.Line := line;
n.ImageList := fImages;
n.ImageIndex := longint(value);
n.Visible := true;
n.Column:= gutterIconKindToColumn(value);
Marks.Add(n);
end;
end;
procedure TDexedMemo.removeGutterIcon(line: integer; value: TGutterIcon);
var
m: TSynEditMarkLine;
n: TSynEditMark;
i: integer;
begin
m := Marks.Line[line];
if m.isAssigned then
for i := m.Count-1 downto 0 do
begin
n := m.Items[i];
if n.ImageIndex = longint(value) then
begin
m.Delete(i);
FreeAndNil(n);
end;
end;
Repaint;
end;
procedure TDexedMemo.debugStart(debugger: IDebugger);
var
i: integer;
m: TSynEditMark;
begin
fMultiGutterMarks.columnCount := 3;
fDebugger := debugger;
fDebugger.removeBreakPoints(fileName);
for i := 0 to marks.count - 1 do
begin
m := marks[i];
if m.ImageIndex = integer(giBreakSet) then
fDebugger.addBreakPoint(filename, m.line, bpkBreak);
end;
end;
procedure TDexedMemo.debugStop;
begin
fMultiGutterMarks.columnCount := 2;
removeDebugTimeMarks;
end;
procedure TDexedMemo.debugContinue;
begin
removeDebugTimeMarks;
end;
function TDexedMemo.debugQueryBpCount: integer;
begin
exit(breakPointsCount());
end;
procedure TDexedMemo.debugQueryBreakPoint(const line: integer; out fname: string; out kind: TBreakPointKind);
begin
if findBreakPoint(line) then
begin
fname:= fFilename;
kind := bpkBreak;
end
else kind := bpkNone;
end;
procedure TDexedMemo.debugBreak(const fname: string; line: integer;
reason: TDebugBreakReason);
begin
if fname <> fFilename then
exit;
showPage;
// newly opened source has not 3 cols yet
fMultiGutterMarks.columnCount := 3;
caretY := line;
centerCursor;
removeDebugTimeMarks;
removeDscannerWarnings;
case reason of
dbBreakPoint: addGutterIcon(line, giBreakReached);
dbStep, dbSignal: addGutterIcon(line, giStep);
dbWatch: addGutterIcon(line, giWatch);
end;
end;
{$ENDREGION --------------------------------------------------------------------}
{$ENDREGION --------------------------------------------------------------------}
initialization
D2Syn := TSynD2Syn.create(nil);
LfmSyn := TSynLFMSyn.Create(nil);
TxtSyn := TSynTxtSyn.create(nil);
JsSyn := TSynJScriptSyn.Create(nil);
//
LfmSyn.KeyAttri.Foreground := clNavy;
LfmSyn.KeyAttri.Style := [fsBold];
LfmSyn.NumberAttri.Foreground := clMaroon;
LfmSyn.StringAttri.Foreground := clBlue;
LfmSyn.SymbolAttribute.Foreground:= clPurple;
LfmSyn.SymbolAttribute.Style := [fsBold];
//
JsSyn.KeyAttri.Foreground := clNavy;
JsSyn.KeyAttri.Style := [fsBold];
JsSyn.NumberAttri.Foreground := clMaroon;
JsSyn.StringAttri.Foreground := clBlue;
JsSyn.SymbolAttribute.Foreground:= clPurple;
JsSyn.SymbolAttribute.Style := [fsBold];
//
TEditorHintWindow.FontSize := 10;
//
RegisterKeyCmdIdentProcs(@CustomStringToCommand, @CustomCommandToSstring);
finalization
D2Syn.Free;
LfmSyn.Free;
TxtSyn.Free;
JsSyn.Free;
//
TDexedMemo.cleanCache;
end.