dexed/src/ce_synmemo.pas

3982 lines
109 KiB
Plaintext

unit ce_synmemo;
{$I ce_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,
//SynEditMarkupFoldColoring,
Clipbrd, fpjson, jsonparser, LazUTF8, LazUTF8Classes, Buttons, StdCtrls,
ce_common, ce_writableComponent, ce_d2syn, ce_txtsyn, ce_dialogs, ce_dastworx,
ce_sharedres, ce_dlang, ce_stringrange, ce_dbgitf, ce_observer, ce_diff,
ce_processes;
type
TCESynMemo = class;
TIdentifierMatchOption = (
caseSensitive = longInt(ssoMatchCase),
wholeWord = longInt(ssoWholeWord)
);
TBraceAutoCloseStyle = (
autoCloseNever,
autoCloseAtEof,
autoCloseAlways,
autoCloseLexically,
autoCloseOnNewLineEof,
autoCloseOnNewLineAlways,
autoCloseOnNewLineLexically
);
TAutoClosedPair = (
autoCloseSingleQuote,
autoCloseDoubleQuote,
autoCloseBackTick,
autoCloseSquareBracket
);
TAutoClosePairs = set of TAutoClosedPair;
const
autoClosePair2Char: array[TAutoClosedPair] of char = (#39, '"', '`', ']');
type
TIdentifierMatchOptions = set of TIdentifierMatchOption;
// Simple THintWindow descendant allowing the font size to be in sync with the editor.
TCEEditorHintWindow = 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, actual param in bold
TCEEditorCallTipWindow = class(TCEEditorHintWindow)
strict private
fIndexOfExpectedArg: integer;
public
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.
TCEFoldCache = 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 cessions.
TCESynMemoCache = class(TWritableLfmTextComponent)
private
fMemo: TCESynMemo;
fFolds: TCollection;
fCaretPosition: Integer;
fSelectionEnd: Integer;
fFontSize: 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;
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.
TCESynMemoPositions = 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
TCEScrollMemo = class(TPanel)
private
fMemo: TSynEdit;
fD2Hl: TSynD2Syn;
fTxtHl: TSynTxtSyn;
fCppHl: TSynCppSyn;
fSource: TCESynMemo;
procedure updateFromSource;
protected
procedure SetVisible(Value: Boolean); override;
public
constructor construct(editor: TCESynMemo);
procedure goToLine(value: integer);
end;
{ TCESynMemo }
TCESynMemo = class(TSynEdit, ICEDebugObserver)
private
//fIndentGuideMarkup: TSynEditMarkupFoldColors;
fLifeTimeManager: TObject;
fIdentDialShown: boolean;
fScrollMemo: TCEScrollMemo;
fFilename: string;
fDastWorxExename: string;
fModified: boolean;
fFileDate: double;
fCacheLoaded: boolean;
fIsDSource: boolean;
fFocusForInput: boolean;
fIdentifier: string;
fTempFileName: string;
fMultiDocSubject: TObject;
fDefaultFontSize: Integer;
fPositions: TCESynMemoPositions;
fMousePos: TPoint;
fCallTipWin: TCEEditorCallTipWindow;
fDDocWin: TCEEditorHintWindow;
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;
fImages: TImageList;
fMatchSelectionOpts: TSynSearchOptions;
fMatchIdentOpts: TSynSearchOptions;
fMatchOpts: TIdentifierMatchOptions;
fCallTipStrings: TStringList;
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: ICEDebugger;
fInsertPlusDdoc: boolean;
fAutoCallCompletion: boolean;
fCloseCompletionCharsWithSpace: TSysCharSet;
fCloseCompletionChars: TSysCharSet;
fCompletionMenuAutoClose: boolean;
fTransparentGutter: boolean;
fDscanner: TCEProcess;
fDscannerResults: TDscannerResults;
fCanDscan: boolean;
fKnowsDscanner: boolean;
fDscannerEnabled: boolean;
fScrollPreview: boolean;
fDiffDialogWillClose: boolean;
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;
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: boolean;
function canInsertLeadingDdocSymbol: char;
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 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: ICEDebugger);
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: TCEDebugBreakReason);
function breakPointsCount: integer;
procedure tryToPatchMixedIndentation;
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;
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);
//
property IdentifierMatchOptions: TIdentifierMatchOptions read fMatchOpts write setMatchOpts;
property Identifier: string read fIdentifier;
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 TextView;
//
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 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;
end;
TSortDialog = class(TForm)
private
class var fDescending: boolean;
class var fCaseSensitive: boolean;
fEditor: TCESynMemo;
fCanUndo: boolean;
procedure btnApplyClick(sender: TObject);
procedure btnUndoClick(sender: TObject);
procedure chkCaseSensClick(sender: TObject);
procedure chkDescClick(sender: TObject);
public
constructor construct(editor: TCESynMemo);
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;
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
ce_interfaces, ce_dcd, SynEditHighlighterFoldBase, ce_lcldragdrop;
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) '
);
function TCEEditorHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
Font.Size:= FontSize;
result := inherited CalcHintRect(MaxWidth, AHint, AData);
end;
function TCEEditorCallTipWindow.CalcHintRect(MaxWidth: Integer; const AHint: String; AData: Pointer): TRect;
begin
//Font.Style := Font.Style + [fsBold];
result := inherited CalcHintRect(MaxWidth, AHint, AData);
//Font.Style := Font.Style - [fsBold];
end;
procedure TCEEditorCallTipWindow.Paint;
//var
//s: string;
//a: string;
//i: integer = 0;
//x: integer = 0;
//o: integer = 0;
//r: TStringRange = (ptr:nil; pos:0; len: 0);
//f: TFontStyles;
begin
//s := caption;
//caption := '';
inherited Paint;
//if s.isEmpty then
// exit;
//f := canvas.Font.Style;
//r.init(s);
//// func decl (TODO skip template params)
//a := r.takeUntil('(').yield + '(';
//o := x;
//x += canvas.TextWidth(a);
//canvas.TextOut(o, 0, a);
//r.popFront;
//// func args
//while not r.empty do
//begin
// a := r.takeUntil(',').yield;
// if not r.empty then
// begin
// r.popFrontN(2);
// a += ', ';
// end;
// o := x;
// if fIndexOfExpectedArg = i then
// canvas.Font.Style := canvas.Font.Style + [fsBold]
// else
// canvas.Font.Style := canvas.Font.Style - [fsBold];
// x += canvas.TextWidth(a);
// canvas.TextOut(o, 0, a);
// canvas.Font.Style := f;
// i += 1;
//end;
end;
{$REGION TSortDialog -----------------------------------------------------------}
constructor TSortDialog.construct(editor: TCESynMemo);
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
self.fSpacesPerTab:= TSpinEdit(sender).Value;
end;
{$ENDREGION}
{$REGION TCESynMemoCache -------------------------------------------------------}
constructor TCESynMemoCache.create(aComponent: TComponent);
begin
inherited create(nil);
if (aComponent is TCESynMemo) then
fMemo := TCESynMemo(aComponent);
fFolds := TCollection.Create(TCEFoldCache);
end;
destructor TCESynMemoCache.destroy;
begin
fFolds.Free;
inherited;
end;
procedure TCESynMemoCache.setFolds(someFolds: TCollection);
begin
fFolds.Assign(someFolds);
end;
procedure TCESynMemoCache.beforeSave;
var
i, start, prev: Integer;
itm : TCEFoldCache;
begin
if fMemo.isNil then
exit;
fCaretPosition := fMemo.SelStart;
fSourceFilename := fMemo.fileName;
fSelectionEnd := fMemo.SelEnd;
fFontSize := fMemo.Font.Size;
TCEEditorHintWindow.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 := fMemo.TextView.CollapsedLineForFoldAtLine(i);
if start = -1 then
continue;
if start = prev then
continue;
prev := start;
itm := TCEFoldCache(fFolds.Add);
itm.isCollapsed := true;
itm.fLineIndex := start;
end;
end;
procedure TCESynMemoCache.afterLoad;
var
i: integer;
itm : TCEFoldCache;
begin
if fMemo.isNil then
exit;
if fFontSize > 0 then
fMemo.Font.Size := fFontSize;
// Currently collisions are not handled.
if fMemo.fileName <> fSourceFilename then
exit;
for i := 0 to fFolds.Count-1 do
begin
itm := TCEFoldCache(fFolds.Items[i]);
if not itm.isCollapsed then
continue;
fMemo.TextView.FoldAtLine(itm.lineIndex-1);
end;
fMemo.SelStart := fCaretPosition;
fMemo.SelEnd := fSelectionEnd;
end;
{$IFDEF DEBUG}{$R-}{$ENDIF}
procedure TCESynMemoCache.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 TCESynMemoCache.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 TCESynMemoPositions ---------------------------------------------------}
constructor TCESynMemoPositions.create(memo: TCustomSynEdit);
begin
fList := TFPList.Create;
fMax := 40;
fMemo := memo;
fPos := -1;
end;
destructor TCESynMemoPositions.destroy;
begin
fList.Free;
inherited;
end;
procedure TCESynMemoPositions.back;
begin
Inc(fPos);
{$HINTS OFF}
if fPos < fList.Count then
fMemo.CaretY := NativeInt(fList.Items[fPos])
{$HINTS ON}
else Dec(fPos);
end;
procedure TCESynMemoPositions.next;
begin
Dec(fPos);
{$HINTS OFF}
if fPos > -1 then
fMemo.CaretY := NativeInt(fList.Items[fPos])
{$HINTS ON}
else Inc(fPos);
end;
procedure TCESynMemoPositions.store;
var
delta: NativeInt;
const
thresh = 6;
begin
fPos := 0;
{$PUSH}
{$HINTS OFF}{$WARNINGS OFF}
if fList.Count > 0 then
begin
delta := fMemo.CaretY - NativeInt(fList.Items[fPos]);
if (delta > -thresh) and (delta < thresh) then exit;
end;
fList.Insert(0, Pointer(NativeInt(fMemo.CaretY)));
{$POP}
while fList.Count > fMax do
fList.Delete(fList.Count-1);
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION TCEScrollMemo ---------------------------------------------------------}
constructor TCEScrollMemo.construct(editor: TCESynMemo);
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 TCEScrollMemo.updateFromSource;
begin
fMemo.Font.Assign(fSource.Font);
fMemo.Lines := fSource.Lines;
width := fSource.Width div 2;
if fSource.Highlighter.isNotNil then
begin
fMemo.Color:= fSource.Color;
fMemo.LineHighlightColor.Assign(fSource.LineHighlightColor);
fMemo.SelectedColor.Assign(fSource.SelectedColor);
if fMemo.Highlighter.isNil 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 TCEScrollMemo.SetVisible(Value: Boolean);
var
o: boolean;
begin
o := Visible;
inherited;
if (o <> value) and value then
updateFromSource;
end;
procedure TCEScrollMemo.goToLine(value: integer);
begin
if fMemo.PaintLock <> 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 TCESynMemo ------------------------------------------------------------}
{$REGION Standard Obj and Comp -------------------------------------------------}
constructor TCESynMemo.Create(aOwner: TComponent);
var
z: TIconScaledSize;
i: ICELifetimeManager;
begin
inherited;
fScrollMemo := TCEScrollMemo.construct(self);
i := getLifeTimeManager();
if (i <> nil) 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 := TCEProcess.create(self);
fDscanner.Executable:= exeFullName('dscanner' + exeExt);
fDscanner.Options:=[poUsePipes];
fDscanner.ShowWindow:=swoHIDE;
fDscanner.OnTerminate:=@dscannerTerminate;
fDscanner.Parameters.add('-S');
fDscanner.Parameters.add('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.TheForm.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;
fCallTipStrings:= TStringList.Create;
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);
Highlighter := fD2Highlighter;
fTempFileName := GetTempDir(false) + 'temp_' + uniqueObjStr(self) + '.d';
fFilename := '<new document>';
fModified := false;
TextBuffer.AddNotifyHandler(senrUndoRedoAdded, @changeNotify);
Gutter.MarksPart.AutoSize:=false;
Gutter.MarksPart.Width := ScaleX(20,96);
fImages := TImageList.Create(self);
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 := TCESynMemoPositions.create(self);
fMultiDocSubject := TCEMultiDocSubject.create;
HighlightAllColor.Foreground := clNone;
HighlightAllColor.Background := clSilver;
HighlightAllColor.BackAlpha := 70;
IdentifierMatchOptions:= [caseSensitive];
LineHighlightColor.Background := color - $080808;
LineHighlightColor.Foreground := clNone;
//fIndentGuideMarkup:= TSynEditMarkupFoldColors.Create(self);
//MarkupManager.AddMarkUp(fIndentGuideMarkup);
fAutoCloseCurlyBrace:= autoCloseOnNewLineLexically;
fAutoClosedPairs:= [autoCloseSquareBracket];
fDastWorxExename:= exeFullName('dastworx' + exeExt);
fDebugger := EntitiesConnector.getSingleService('ICEDebugger') as ICEDebugger;
subjDocNew(TCEMultiDocSubject(fMultiDocSubject), self);
EntitiesConnector.addObserver(self);
end;
procedure TCESynMemo.WMKillFocus(var Message: TLMKillFocus);
begin
if eoAutoHideCursor in options2 then
inherited MouseMove([], 0, 0);
end;
destructor TCESynMemo.destroy;
begin
saveCache;
//fIndentGuideMarkup.Free;
EntitiesConnector.removeObserver(self);
subjDocClosing(TCEMultiDocSubject(fMultiDocSubject), self);
fMultiDocSubject.Free;
fPositions.Free;
fCompletion.Free;
fCallTipStrings.Free;
fLexToks.Clear;
fLexToks.Free;
fSortDialog.Free;
fDscannerResults.Free;
if fTempFileName.fileExists then
sysutils.DeleteFile(fTempFileName);
inherited;
end;
procedure TCESynMemo.setGutterTransparent(value: boolean);
begin
fTransparentGutter:=value;
if fTransparentGutter then
begin
Gutter.LineNumberPart.MarkupInfo.Background:= Color;
Gutter.SeparatorPart.MarkupInfo.Background:= Color;
Gutter.MarksPart.MarkupInfo.Background:= Color;
Gutter.ChangesPart.MarkupInfo.Background:= Color;
Gutter.CodeFoldPart.MarkupInfo.Background:= Color;
Gutter.Color:=Color;
end
else
begin
Gutter.LineNumberPart.MarkupInfo.Background:= clBtnFace;
Gutter.SeparatorPart.MarkupInfo.Background:= clBtnFace;
Gutter.MarksPart.MarkupInfo.Background:= clBtnFace;
Gutter.ChangesPart.MarkupInfo.Background:= clBtnFace;
Gutter.CodeFoldPart.MarkupInfo.Background:= clBtnFace;
Gutter.Color:=clBtnFace;
end;
end;
procedure TCESynMemo.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 TCESynMemo.setFocus;
begin
inherited;
highlightCurrentIdentifier;
subjDocFocused(TCEMultiDocSubject(fMultiDocSubject), self);
end;
procedure TCESynMemo.showPage;
begin
getMultiDocHandler.openDocument(fileName);
end;
procedure TCESynMemo.DoEnter;
begin
inherited;
checkFileDate;
if not fFocusForInput then
subjDocFocused(TCEMultiDocSubject(fMultiDocSubject), self);
fFocusForInput := true;
fScrollMemo.Visible:=false;
tryToPatchMixedIndentation;
end;
procedure TCESynMemo.DoExit;
begin
inherited;
fFocusForInput := false;
hideDDocs;
hideCallTips;
fScrollMemo.Visible:=false;
if fCompletion.IsActive then
fCompletion.Deactivate;
end;
procedure TCESynMemo.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, []);
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;
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;
else exit(false);
end;
end;
procedure TCESynMemo.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);
end;
ecCopy: if not SelAvail then
begin
SelectLine(false);
ExecuteCommand(ecCopy, #0, nil);
SelEnd:=SelStart;
end;
ecPaste: patchClipboardIndentation;
ecCompletionMenu:
begin
fCanAutoDot:=false;
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
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:
curlyBraceCloseAndIndent;
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);
end;
if fOverrideColMode and not SelAvail then
begin
fOverrideColMode := false;
Options := Options - [eoScrollPastEol];
end;
end;
function TCESynMemo.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 (t <> 0) and (s <> 0) then
result := imMixed
else if t = 0 then
result := imSpaces
else if s = 0 then
result := imTabs
else
result := imNone;
numTabs:= t;
numSpaces:= s;
end;
procedure TCESynMemo.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 TCESynMemo.insertLeadingDDocSymbol(c: char);
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
BeginUndoBlock;
if ((CaretX-1) and 1) = 0 then
ExecuteCommand(ecChar, ' ', nil);
ExecuteCommand(ecChar, c, nil);
EndUndoBlock;
end;
procedure TCESynMemo.curlyBraceCloseAndIndent;
var
i: integer;
beg: string = '';
numTabs: integer = 0;
numSpac: integer = 0;
numSkip: integer = 0;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
i := CaretY - 1;
while true do
begin
if i < 0 then
break;
beg := Lines[i];
if (Pos('}', beg) <> 0) then
begin
numSkip += 1;
end
else if (Pos('{', beg) <> 0) then
begin
numSkip -= 1;
end;
if numSkip < 0 then
break
else
i -= 1;
end;
for i:= 1 to beg.length do
begin
case beg[i] of
#9: numTabs += 1;
' ': numSpac += 1;
else break;
end;
end;
numTabs += numSpac div TabWidth;
BeginUndoBlock;
CommandProcessor(ecInsertLine, '', nil);
CommandProcessor(ecDown, '', nil);
CommandProcessor(ecInsertLine, '', nil);
CommandProcessor(ecDown, '', nil);
while CaretX <> 1 do CommandProcessor(ecLeft, '' , nil);
for i:= 0 to numTabs-1 do CommandProcessor(ecTab, '', nil);
CommandProcessor(ecChar, '}', nil);
CommandProcessor(ecUp, '', nil);
while CaretX <> 1 do CommandProcessor(ecLeft, '' , nil);
for i:= 0 to numTabs do CommandProcessor(ecTab, '', nil);
EndUndoBlock;
end;
procedure TCESynMemo.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 = 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 TCESynMemo.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 TCESynMemo.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;
fLexToks.Clear;
lex(lines.Text, fLexToks, nil, [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 TCESynMemo.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 (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) = 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 = -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 TCESynMemo.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 TCESynMemo.nextChangedArea;
begin
goToChangedArea(true);
end;
procedure TCESynMemo.previousChangedArea;
begin
goToChangedArea(false);
end;
procedure TCESynMemo.previousWarning;
begin
goToWarning(false);
end;
procedure TCESynMemo.nextWarning;
begin
goToWarning(true);
end;
procedure TCESynMemo.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;
EnsureCursorPosVisible;
end;
end;
end;
procedure TCESynMemo.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 TCESynMemo.showCurLineWarning;
begin
showWarningForLine(CaretY);
end;
procedure TCESynMemo.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);
end;
end;
procedure TCESynMemo.goToProtectionGroup(next: boolean);
var
i: integer;
tk0, tk1: PLexToken;
tk: PLexToken = nil;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
fLexToks.Clear;
lex(Lines.Text, fLexToks, nil, [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
ExecuteCommand(ecGotoXY, #0, @tk^.position);
end;
procedure TCESynMemo.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;
EnsureCursorPosVisible;
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;
EnsureCursorPosVisible;
end;
end;
end;
procedure TCESynMemo.previousProtectionGroup;
begin
goToProtectionGroup(false);
end;
procedure TCESynMemo.nextProtectionGroup;
begin
goToProtectionGroup(true);
end;
function TCESynMemo.implementMain: THasMain;
var
res: char = '0';
prc: TProcess;
src: string;
begin
if fDastWorxExename.length = 0 then
exit(mainDefaultBehavior);
src := Lines.Text;
prc := TProcess.Create(nil);
try
prc.Executable:= fDastWorxExename;
prc.Parameters.Add('-m');
prc.Options := [poUsePipes{$IFDEF WINDOWS}, poNewConsole{$ENDIF}];
prc.ShowWindow := swoHIDE;
prc.Execute;
prc.Input.Write(src[1], src.length);
prc.CloseInput;
prc.Output.Read(res, 1);
while prc.Running do
sleep(1);
finally
prc.Free;
end;
case res = '1' of
false:result := mainNo;
true: result := mainYes;
end;
end;
procedure TCESynMemo.autoClosePair(value: TAutoClosedPair);
var
i, p: integer;
tk0, tk1: PLexToken;
str: string;
begin
fLexToks.Clear;
if value in [autoCloseBackTick, autoCloseDoubleQuote] then
begin
p := selStart;
lex(Lines.Text, fLexToks);
for i:=0 to fLexToks.Count-2 do
begin
tk0 := fLexToks[i];
tk1 := fLexToks[i+1];
if (tk0^.offset+1 <= p) and (p < tk1^.offset+2) and
(tk0^.kind in [ltkString, ltkComment]) then
exit;
end;
tk0 := fLexToks[fLexToks.Count-1];
if (tk0^.offset+1 <= p) and (tk0^.kind <> ltkIllegal) then
exit;
end
else if value = autoCloseSingleQuote then
begin
p := selStart;
lex(Lines.Text, fLexToks);
for i:=0 to fLexToks.Count-2 do
begin
tk0 := fLexToks[i];
tk1 := fLexToks[i+1];
if (tk0^.offset+1 <= p) and (p < tk1^.offset+2) and
(tk0^.kind in [ltkChar, ltkComment]) then
exit;
end;
tk0 := fLexToks[fLexToks.Count-1];
if (tk0^.offset+1 <= p) and (tk0^.kind <> ltkIllegal) then
exit;
end
else if value = autoCloseSquareBracket then
begin
p := selStart;
lex(Lines.Text, fLexToks);
for i:=0 to fLexToks.Count-2 do
begin
tk0 := fLexToks[i];
tk1 := fLexToks[i+1];
if (tk0^.offset+1 <= p) and (p < tk1^.offset+2) and
(tk0^.kind = ltkComment) then
exit;
end;
tk0 := fLexToks[fLexToks.Count-1];
if (tk0^.offset+1 <= p) and (tk0^.kind <> ltkIllegal) then
exit;
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 TCESynMemo.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 TCESynMemo.sortSelectedLines(descending, caseSensitive: boolean);
var
i,j: integer;
lne: string;
lst: TStringListUTF8;
pt0: TPoint;
begin
if BlockEnd.Y - BlockBegin.Y < 1 then
exit;
lst := TStringListUTF8.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 TCESynMemo.sortLines;
begin
if not assigned(fSortDialog) then
fSortDialog := TSortDialog.construct(self);
fSortDialog.Show;
end;
procedure TCESynMemo.addCurLineBreakPoint;
begin
if not findBreakPoint(CaretY) then
addBreakPoint(CaretY);
end;
procedure TCESynMemo.removeCurLineBreakPoint;
begin
if findBreakPoint(CaretY) then
removeBreakPoint(CaretY);
end;
procedure TCESynMemo.toggleCurLineBreakpoint;
begin
if not findBreakPoint(CaretY) then
addBreakPoint(CaretY)
else
removeBreakPoint(CaretY);
end;
procedure TCESynMemo.insertDdocTemplate;
var
d: TStringList;
i: integer;
j: integer;
k: integer;
s: string;
p: TPoint;
begin
d := TStringList.Create;
try
getDdocTemplate(lines, d, 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 TCESynMemo.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[p.x-1];
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 TCESynMemo.InitHintWins;
begin
if fCallTipWin.isNil then
begin
fCallTipWin := TCEEditorCallTipWindow.Create(self);
fCallTipWin.Color := clInfoBk + $01010100;
fCallTipWin.Font.Color:= clInfoText;
end;
if fDDocWin.isNil then
begin
fDDocWin := TCEEditorHintWindow.Create(self);
fDDocWin.Color := clInfoBk + $01010100;
fDDocWin.Font.Color:= clInfoText;
end;
end;
procedure TCESynMemo.showCallTips(findOpenParen: boolean = true);
var
str, lne: string;
i, x: integer;
j: integer = 0;
n: integer = 0;
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
if not fCallTipWin.Visible then
fCallTipStrings.Clear;
str := LineText[1..CaretX];
x := CaretX;
i := min(x, str.length);
if findOpenParen then while true do
begin
if i = 1 then
break;
if str[i] = ',' then
j += 1;
if str[i] = ')' then
n += 1;
if str[i-1] = '(' then
begin
if n = 0 then
begin
LogicalCaretXY := Point(i, CaretY);
break;
end
else n -= 1;
end;
if str[i] = #9 then
i -= TabWidth
else
i -= 1;
end;
DcdWrapper.getCallTip(str);
i := fCallTipStrings.Count;
if (fCallTipStrings.Count <> 0) and str.isNotEmpty then
fCallTipStrings.Insert(0, '---');
fCallTipStrings.Insert(0, str);
i := fCallTipStrings.Count - i;
// overload count to delete on ')'
{$PUSH}{$HINTS OFF}{$WARNINGS OFF}
fCallTipStrings.Objects[0] := TObject(pointer(i));
{$POP}
str := '';
for lne in fCallTipStrings do
if lne.isNotEmpty then
str += lne + LineEnding;
if str.isNotEmpty then
begin
{$IFDEF WINDOWS}
str := str[1..str.length-2];
{$ELSE}
str := str[1..str.length-1];
{$ENDIF}
showCallTipsString(str, j);
end;
if findOpenParen then
CaretX:=x;
end;
procedure TCESynMemo.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);
// see procedure THintWindow.ActivateHint(const AHint: String);
// caused a regression in call tips stacking
fCallTipWin.Caption:= tips;
fCallTipWin.ActivateHint(tips);
end;
procedure TCESynMemo.hideCallTips;
begin
if not fCallTipWin.Visible then
exit;
fCallTipStrings.Clear;
fCallTipWin.Hide;
end;
procedure TCESynMemo.decCallTipsLvl;
var
i: integer;
begin
{$PUSH}{$HINTS OFF}{$WARNINGS OFF}
i := integer(pointer(fCallTipStrings.Objects[0]));
{$POP}
for i in [0..i-1] do
fCallTipStrings.Delete(0);
if fCallTipStrings.Count = 0 then
hideCallTips
else
showCallTipsString(fCallTipStrings.Text, 0);
end;
procedure TCESynMemo.showDDocs;
var
str: string;
begin
fCanShowHint := false;
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
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 TCESynMemo.hideDDocs;
begin
fCanShowHint := false;
fDDocWin.Hide;
end;
procedure TCESynMemo.setDDocDelay(value: Integer);
begin
fDDocDelay:=value;
fDDocTimer.Interval:=fDDocDelay;
end;
procedure TCESynMemo.DDocTimerEvent(sender: TObject);
begin
if (not Visible) or (not isDSource) or (not fCanShowHint) then
exit;
showDDocs;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION Completion ------------------------------------------------------------}
procedure TCESynMemo.completionExecute(sender: TObject);
begin
if not fIsDSource and not alwaysAdvancedFeatures then
exit;
fCompletion.TheForm.Font.Size := Font.Size;
fCompletion.TheForm.BackgroundColor:= self.Color;
fCompletion.TheForm.TextColor:= fD2Highlighter.identifiers.Foreground;
getCompletionList;
end;
procedure TCESynMemo.completionDeleteKey(sender: TObject);
begin
if CaretX > 0 then
begin
caretX := CaretX - 1;
getCompletionList();
caretX := CaretX + 1;
end;
if fCompletionMenuAutoClose and (fCompletion.CurrentString.length < 2) then
fCompletion.TheForm.Close;
end;
procedure TCESynMemo.getCompletionList;
var
i: integer;
o: TObject;
begin
if not DcdWrapper.available then
exit;
fCompletion.Position := 0;
fCompletion.ItemList.Clear;
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;
procedure TCESynMemo.completionCodeCompletion(var value: string;
SourceValue: string; var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char;
Shift: TShiftState);
begin
if KeyChar <> '' then
begin
if KeyChar[1] = ' ' then
value := sourceValue + KeyChar[1]
else
begin
fLastCompletion := value;
if KeyChar[1] in fCloseCompletionCharsWithSpace then
value += ' ' + KeyChar[1]
else if KeyChar[1] in fCloseCompletionChars then
value += KeyChar[1];
end;
end;
end;
procedure TCESynMemo.completionFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if char(key) = #9 then
key := 13;
end;
function TCESynMemo.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;
end;
ACanvas.Font.Style := [fsItalic];
ACanvas.TextOut(2 + X + len + 2, Y, knd);
end;
procedure TCESynMemo.AutoDotTimerEvent(sender: TObject);
begin
if (not fCanAutoDot) or (fAutoDotDelay = 0) then
exit;
fCanAutoDot := false;
fCompletion.Execute('', ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
procedure TCESynMemo.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 TCESynMemo.setDscannerOptions(dsEnabled: boolean; dsDelay: integer);
begin
fDscannerTimer.Interval:=dsDelay;
fDscannerEnabled := dsEnabled;
if not dsEnabled then
removeDscannerWarnings
else
dscannerTimerEvent(nil);
end;
procedure TCESynMemo.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 TCESynMemo.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 TCESynMemo.removeDscannerWarnings;
var
i: integer;
n: TSynEditMark;
begin
IncPaintLock;
fDscannerResults.clear;
for i:= Marks.Count-1 downto 0 do
if marks.Items[i].ImageIndex = longint(giWarn) then
begin
n := marks.Items[i];
marks.Delete(i);
FreeAndNil(n);
end;
DecPaintLock;
repaint;
end;
function TCESynMemo.getDscannerWarning(line: integer): string;
const
spec = '@column %d: %s' + LineEnding;
var
i: integer;
begin
result := '';
for i := 0 to fDscannerResults.count-1 do
if fDscannerResults[i]^.line = line then
result += format(spec, [fDscannerResults[i]^.column, fDscannerResults[i]^.warning]);
end;
function TCESynMemo.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 TCESynMemo.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.isNotNil 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 TCESynMemo.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 = 0 then
begin
if fFilename.length > 0 then
result := fFilename.extractFileName
else
result := '<new document>';
end;
end;
procedure TCESynMemo.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 TCESynMemo.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 TCESynMemo.lexCanCloseBrace: boolean;
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(false);
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 = 0) then
exit(false);
end;
if (tok <> nil) and (tok^.kind = ltkIllegal) then
result := false
else
result := c > 0;
end;
procedure TCESynMemo.SetHighlighter(const Value: TSynCustomHighlighter);
begin
inherited;
fIsDSource := Highlighter = fD2Highlighter;
end;
procedure TCESynMemo.highlightCurrentIdentifier;
var
str: string;
i: integer;
begin
fIdentifier := GetWordAtRowCol(LogicalCaretXY);
if (fIdentifier.length > 2) and (not SelAvail) then
SetHighlightSearch(fIdentifier, fMatchIdentOpts)
else if SelAvail and (BlockBegin.Y = BlockEnd.Y) then
begin
str := SelText;
for i := 1 to str.length do
begin
if not (str[i] in [' ', #10, #13]) then
begin
SetHighlightSearch(str, fMatchSelectionOpts);
break;
end;
if i = str.length then
SetHighlightSearch('', []);
end;
end
else SetHighlightSearch('', []);
end;
procedure TCESynMemo.setMatchOpts(value: TIdentifierMatchOptions);
begin
fMatchOpts:= value;
fMatchIdentOpts := TSynSearchOptions(fMatchOpts);
fMatchSelectionOpts:= TSynSearchOptions(fMatchOpts - [wholeWord]);
end;
procedure TCESynMemo.changeNotify(Sender: TObject);
begin
highlightCurrentIdentifier;
fModified := true;
fPositions.store;
subjDocChanged(TCEMultiDocSubject(fMultiDocSubject), self);
end;
procedure TCESynMemo.loadFromFile(const fname: string);
var
e: string;
c: boolean;
begin
e := fname.extractFileExt;
fIsDsource := hasDlangSyntax(e);
c := hasCppSyntax(e);
if not fIsDsource then
begin
if c then
Highlighter := CppHighlighter
else
Highlighter := TxtSyn;
end;
Lines.LoadFromFile(fname);
fFilename := fname;
FileAge(fFilename, fFileDate);
fModified := false;
if Showing then
begin
setFocus;
loadCache;
fCacheLoaded := true;
end;
tryToPatchMixedIndentation();
subjDocChanged(TCEMultiDocSubject(fMultiDocSubject), self);
fCanDscan := true;
end;
procedure TCESynMemo.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
Highlighter := TxtHighlighter;
end;
FileAge(fFilename, fFileDate);
fModified := false;
if fFilename <> fTempFileName then
begin
if fTempFileName.fileExists then
sysutils.DeleteFile(fTempFileName);
subjDocChanged(TCEMultiDocSubject(fMultiDocSubject), self);
end;
end;
procedure TCESynMemo.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(TCEMultiDocSubject(fMultiDocSubject), self);
end;
procedure TCESynMemo.saveTempFile;
begin
saveToFile(fTempFileName);
fModified := false;
end;
function TCESynMemo.getIfTemp: boolean;
begin
exit(fFilename = fTempFileName);
end;
procedure TCESynMemo.saveCache;
var
cache: TCESynMemoCache;
begin
cache := TCESynMemoCache.create(self);
try
cache.save;
finally
cache.free;
end;
end;
procedure TCESynMemo.loadCache;
var
cache: TCESynMemoCache;
begin
cache := TCESynMemoCache.create(self);
try
cache.load;
finally
cache.free;
end;
end;
class procedure TCESynMemo.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 TCESynMemo.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;
EnsureCursorPosVisible;
fModified := true;
end;
procedure TCESynMemo.checkFileDate;
var
mr: TModalResult;
newDate: double;
newMd5: TMDDigest;
curMd5: TMDDigest;
str: TStringList;
txt: string;
begin
if fDiffDialogWillClose or fDisableFileDateCheck then
exit;
if fFilename.isNotEmpty and not fFilename.fileExists and
(fFilename <> '<new document>') 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
str := TStringList.Create;
try
str.LoadFromFile(fFilename);
txt := str.strictText;
newMd5 := MD5String(txt);
txt := lines.strictText;
curMd5 := MD5String(txt);
if not MDMatch(curMd5, newMd5) then
begin
lines.SaveToFile(tempFilename);
fDiffDialogWillClose := true;
With TCEDiffViewer.construct(self, fTempFileName, fFilename) do
try
mr := ShowModal;
case mr of
mrOK:
begin
replaceUndoableContent(str.strictText);
fModified := false;
fFileDate := newDate;
end;
mrIgnore: fFileDate := newDate;
mrCancel:;
end;
finally
free;
fDiffDialogWillClose := false;
end;
end;
finally
str.Free;
end;
end
else fFileDate := newDate;
end;
function TCESynMemo.getMouseBytePosition: Integer;
var
i, len, llen: Integer;
begin
result := 0;
if fMousePos.y-1 > Lines.Count-1 then exit;
llen := Lines[fMousePos.y-1].length;
if fMousePos.X > llen then exit;
len := getSysLineEndLen;
for i:= 0 to fMousePos.y-2 do
result += Lines[i].length + len;
result += fMousePos.x;
end;
procedure TCESynMemo.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
begin
lst[i] := leadingTabsToSpaces(lst[i], TabWidth);
end;
clipboard.asText := lst.strictText;
finally
lst.free;
end;
end;
{$ENDREGION --------------------------------------------------------------------}
{$REGION user input ------------------------------------------------------------}
procedure TCESynMemo.KeyDown(var Key: Word; Shift: TShiftState);
var
line: string;
ddc: char;
lxd: boolean;
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:
begin
fCanDscan:=true;
line := LineText;
if [ssCtrl] <> Shift then
begin
case fAutoCloseCurlyBrace of
autoCloseOnNewLineAlways: if (CaretX > 1) and (line[LogicalCaretXY.X - 1] = '{') then
begin
Key := 0;
curlyBraceCloseAndIndent;
end;
autoCloseOnNewLineEof: if (CaretX > 1) and (line[LogicalCaretXY.X - 1] = '{') then
if (CaretY = Lines.Count) and (CaretX = line.length+1) then
begin
Key := 0;
curlyBraceCloseAndIndent;
end;
end;
if (fAutoCloseCurlyBrace = autoCloseOnNewLineLexically) or
fSmartDdocNewline then
begin
lxd := false;
if (LogicalCaretXY.X - 1 >= line.length)
or isBlank(line[LogicalCaretXY.X .. line.length]) then
begin
lxd := true;
fLexToks.Clear;
lex(lines.Text, fLexToks);
if lexCanCloseBrace then
begin
Key := 0;
curlyBraceCloseAndIndent;
lxd := false;
end;
end;
if (fSmartDdocNewline) then
begin
if not lxd then
begin
fLexToks.Clear;
lex(lines.Text, fLexToks);
end;
ddc := canInsertLeadingDdocSymbol;
if ddc in ['*', '+'] then
begin
inherited;
insertLeadingDDocSymbol(ddc);
fCanShowHint:=false;
fDDocWin.Hide;
exit;
end;
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 TCESynMemo.KeyUp(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_PRIOR, VK_NEXT, VK_UP: fPositions.store;
VK_OEM_PERIOD, VK_DECIMAL: fCanAutoDot := true;
end;
inherited;
if fAutoCallCompletion and fIsDSource and (not fCompletion.IsActive) and
(Key < $80) and (char(Key) in ['a'..'z', 'A'..'Z']) then
begin
fCompletion.Execute(GetWordAtRowCol(LogicalCaretXY),
ClientToScreen(point(CaretXPix, CaretYPix + LineHeight)));
end;
end;
procedure TCESynMemo.UTF8KeyPress(var Key: TUTF8Char);
var
c: AnsiChar;
begin
c := Key[1];
inherited;
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 GetKeyShiftState <> [ssShift] then
begin
case fAutoCloseCurlyBrace of
autoCloseAlways:
curlyBraceCloseAndIndent;
autoCloseAtEof:
if (CaretY = Lines.Count) and (CaretX = LineText.length+1) then
curlyBraceCloseAndIndent;
autoCloseLexically:
begin
fLexToks.Clear;
lex(lines.Text, fLexToks);
if lexCanCloseBrace then
curlyBraceCloseAndIndent;
end;
end;
end;
end;
if fCompletion.IsActive then
fCompletion.CurrentString:=GetWordAtRowCol(LogicalCaretXY);
end;
procedure TCESynMemo.MouseLeave;
begin
inherited;
hideDDocs;
hideCallTips;
fScrollMemo.Visible:=false;
end;
procedure TCESynMemo.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 = []) then if
((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);
fMousePos := PixelsToRowColumn(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 TCESynMemo.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 TCESynMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:Integer);
var
pt: TPoint;
begin
inherited;
if fScrollPreview and fScrollMemo.Visible and (button = mbLeft) then
begin
pt := Mouse.CursorPos;
pt.x:= pt.x - 40;
CaretY := fScrollMemo.fMemo.CaretY;
EnsureCursorPosVisible;
fScrollMemo.Visible:=false;
mouse.CursorPos := pt;
fPositions.store;
end;
case Button of
mbMiddle: if (Shift = [ssCtrl]) then
Font.Size := fDefaultFontSize;
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 TCESynMemo.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 TCESynMemo.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 TCESynMemo.tryToPatchMixedIndentation;
var
s: integer;
t: integer;
begin
if fLifeTimeManager.isNotNil and not fIdentDialShown and (lines.Count <> 0) and
((fLifeTimeManager as ICELifetimeManager).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];
end;
11:
begin
forceIndentation(imSpaces, TMixedIndentationDialog.fSpacesPerTab);
Options:= Options + [eoTabsToSpaces];
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 TCESynMemo.addBreakPoint(line: integer);
begin
if findBreakPoint(line) then
exit;
addGutterIcon(line, giBreakSet);
if assigned(fDebugger) then
fDebugger.addBreakPoint(fFilename, line, bpkBreak);
end;
procedure TCESynMemo.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 assigned(fDebugger) then
begin
fDebugger.removeBreakPoint(fFilename, line);
if break2step and fDebugger.running then
addGutterIcon(line, giStep);
end;
end;
procedure TCESynMemo.showHintEvent(Sender: TObject; HintInfo: PHintInfo);
var
p: TPoint;
begin
//if cursor <> crDefault then
// exit;
p := ScreenToClient(mouse.CursorPos);
if p.x > Gutter.MarksPart.Width then
exit;
p := self.PixelsToRowColumn(p);
showWarningForLine(p.y);
end;
procedure TCESynMemo.removeDebugTimeMarks;
var
i: integer;
begin
IncPaintLock;
for i:= marks.Count-1 downto 0 do
Marks.Items[i].Visible := not (TGutterIcon(Marks.Items[i].ImageIndex) in debugTimeGutterIcons);
DecPaintLock;
end;
function TCESynMemo.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.isNotNil then
for i := 0 to m.count - 1 do
if (m[i].ImageIndex = integer(value)) then
exit(true);
end;
function TCESynMemo.findBreakPoint(line: integer): boolean;
begin
result := isGutterIconSet(line, giBreakSet);
end;
procedure TCESynMemo.gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark);
begin
if findBreakPoint(line) then
removeBreakPoint(line)
else
addBreakPoint(line);
CaretY := Line;
EnsureCursorPosVisible;
end;
procedure TCESynMemo.addGutterIcon(line: integer; value: TGutterIcon);
var
m: TSynEditMarkLine;
n: TSynEditMark;
i: integer;
s: boolean = false;
begin
m := Marks.Line[line];
if m.isNotNil then
for i := 0 to m.Count-1 do
begin
s := m.Items[i].ImageIndex = longint(value);
m.Items[i].Visible := s;
end;
if not s then
begin
n:= TSynEditMark.Create(self);
n.Line := line;
n.ImageList := fImages;
n.ImageIndex := longint(value);
n.Visible := true;
Marks.Add(n);
end;
end;
procedure TCESynMemo.removeGutterIcon(line: integer; value: TGutterIcon);
var
m: TSynEditMarkLine;
n: TSynEditMark;
i: integer;
begin
m := Marks.Line[line];
if m.isNotNil 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 TCESynMemo.debugStart(debugger: ICEDebugger);
var
i: integer;
m: TSynEditMark;
begin
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 TCESynMemo.debugStop;
begin
removeDebugTimeMarks;
end;
procedure TCESynMemo.debugContinue;
begin
removeDebugTimeMarks;
end;
function TCESynMemo.debugQueryBpCount: integer;
begin
exit(breakPointsCount());
end;
procedure TCESynMemo.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 TCESynMemo.debugBreak(const fname: string; line: integer;
reason: TCEDebugBreakReason);
begin
if fname <> fFilename then
exit;
showPage;
caretY := line;
EnsureCursorPosVisible;
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];
//
TCEEditorHintWindow.FontSize := 10;
//
RegisterKeyCmdIdentProcs(@CustomStringToCommand, @CustomCommandToSstring);
finalization
D2Syn.Free;
LfmSyn.Free;
TxtSyn.Free;
JsSyn.Free;
//
TCESynMemo.cleanCache;
end.