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, //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; // 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); procedure writeBreakpoints(str: TStream); procedure readBreakpoints(str: TStream); 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 DefineProperties(Filer: TFiler); 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; fSource: TCESynMemo; procedure updateFromSource; protected procedure SetVisible(Value: Boolean); override; public constructor construct(editor: TCESynMemo); procedure goToLine(value: integer); end; TCESynMemo = class(TSynEdit, ICEDebugObserver) private //fIndentGuideMarkup: TSynEditMarkupFoldColors; fScrollMemo: TCEScrollMemo; fFilename: string; fDastWorxExename: string; fModified: boolean; fFileDate: double; fCacheLoaded: boolean; fIsDSource: boolean; fIsTxtFile: boolean; fFocusForInput: boolean; fIdentifier: string; fTempFileName: string; fMultiDocSubject: TObject; fDefaultFontSize: Integer; fPositions: TCESynMemoPositions; fMousePos: TPoint; fCallTipWin: TCEEditorHintWindow; 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; fImages: TImageList; fBreakPoints: TFPList; 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; 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; 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 showCallTips(const tips: string); function lexCanCloseBrace: boolean; function lexInDdoc: 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 gutterClick(Sender: TObject; X, Y, Line: integer; mark: TSynEditMark); procedure addBreakPoint(line: integer); procedure removeBreakPoint(line: integer); procedure removeDebugTimeMarks; function findBreakPoint(line: integer): boolean; procedure debugStart(debugger: ICEDebugger); procedure debugStop; procedure debugContinue; function debugQueryBpCount: integer; procedure debugQueryBreakPoint(const index: integer; out fname: string; out line: integer; out kind: TBreakPointKind); procedure debugBreak(const fname: string; line: integer; reason: TCEDebugBreakReason); function breakPointsCount: integer; function breakPointLine(index: integer): integer; 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 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; // 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; 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 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; procedure SetDefaultCoeditKeystrokes(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; 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, ce_staticmacro, 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; {$REGION TSortDialog -----------------------------------------------------------} constructor TSortDialog.construct(editor: TCESynMemo); var pnl: TPanel; begin inherited Create(nil); 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 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.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineBinaryProperty('breakpoints', @readBreakpoints, @writeBreakpoints, true); end; procedure TCESynMemoCache.setFolds(someFolds: TCollection); begin fFolds.Assign(someFolds); end; procedure TCESynMemoCache.writeBreakpoints(str: TStream); var i: integer; begin if fMemo.isNil then exit; {$HINTS OFF} for i:= 0 to fMemo.fBreakPoints.Count-1 do str.Write(PtrUint(fMemo.fBreakPoints.Items[i]), sizeOf(PtrUint)); {$HINTS ON} end; procedure TCESynMemoCache.readBreakpoints(str: TStream); var i, cnt: integer; line: ptrUint = 0; begin if fMemo.isNil then exit; cnt := str.Size div sizeOf(PtrUint); for i := 0 to cnt-1 do begin str.Read(line, sizeOf(line)); fMemo.addBreakPoint(line); end; 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; // // TODO-cimprovment: handle nested folding in TCESynMemoCache // cf. other ways: http://forum.lazarus.freepascal.org/index.php?topic=26748.msg164722#msg164722 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 := getCoeditDocPath + '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 := getCoeditDocPath + '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; parent := editor; width := 475; height := 275; CaptureMouseButtons:=[]; fMemo:= TSynEdit.Create(self); fMemo.Parent := self; fMemo.Align:= alCLient; fMemo.ReadOnly:=true; fMemo.ScrollBars:=ssNone; fMemo.MouseActions.Clear; fMemo.Keystrokes.Clear; fMemo.CaptureMouseButtons:=[]; fD2Hl:= TSynD2Syn.create(self); fTxtHl:= TSynTxtSyn.Create(self); fSource:= editor; updateFromSource(); end; procedure TCEScrollMemo.updateFromSource; begin fMemo.Font.Assign(fSource.Font); fMemo.Lines := fSource.Lines; if fSource.Highlighter.isNotNil then begin fMemo.Color:= fSource.Color; fMemo.LineHighlightColor.Assign(fSource.LineHighlightColor); fMemo.SelectedColor.Assign(fSource.SelectedColor); if fSource.Highlighter is TSynD2Syn then begin fD2Hl.Assign(fSource.Highlighter); fMemo.Highlighter := fD2Hl; end else begin fTxtHl.Assign(fSource.Highlighter); fMemo.Highlighter := fTxtHl; end; end; end; procedure TCEScrollMemo.SetVisible(Value: Boolean); var o: boolean; begin o := IsVisible(); inherited; if (o <> value) and value then updateFromSource; end; procedure TCEScrollMemo.goToLine(value: integer); begin fMemo.CaretY := value; fMemo.SelectLine(true); fMemo.CaretX := 1; end; {$ENDREGION} {$REGION TCESynMemo ------------------------------------------------------------} {$REGION Standard Obj and Comp -------------------------------------------------} constructor TCESynMemo.Create(aOwner: TComponent); begin inherited; fScrollMemo := TCEScrollMemo.construct(self); OnShowHint:= @showHintEvent; OnStatusChange:= @handleStatusChanged; fDefaultFontSize := 10; Font.Size:=10; SetDefaultCoeditKeystrokes(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 := 20; 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; AssignPng(fSyncEdit.GutterGlyph, 'LINK_EDIT'); 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); Highlighter := fD2Highlighter; fTempFileName := GetTempDir(false) + 'temp_' + uniqueObjStr(self) + '.d'; fFilename := ''; fModified := false; TextBuffer.AddNotifyHandler(senrUndoRedoAdded, @changeNotify); fImages := TImageList.Create(self); 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'); fBreakPoints := TFPList.Create; 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; destructor TCESynMemo.destroy; begin saveCache; //fIndentGuideMarkup.Free; EntitiesConnector.removeObserver(self); subjDocClosing(TCEMultiDocSubject(fMultiDocSubject), self); fMultiDocSubject.Free; fPositions.Free; fCompletion.Free; fBreakPoints.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; //checkFileDate; 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; 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 SetDefaultCoeditKeystrokes(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, []); 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; 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; else exit(false); end; end; procedure TCESynMemo.DoOnProcessCommand(var Command: TSynEditorCommand; var AChar: TUTF8Char; Data: pointer); begin inherited; case Command of 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); end; if fOverrideColMode and not SelAvail then begin fOverrideColMode := false; Options := Options - [eoScrollPastEol]; end; end; procedure TCESynMemo.insertLeadingDDocSymbol(c: char); begin 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; 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 i -= 1 else break; 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 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 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; procedure errorMessage; begin dlgOkError('html documentation cannot be found for "' + Identifier + '"'); end; var str: string; pth: string; idt: string = ''; pos: integer; len: integer; sum: integer; edt: TSynEdit; rng: TStringRange = (ptr:nil; pos:0; len: 0); i: integer; linelen: integer; begin DcdWrapper.getDeclFromCursor(str, pos); if not str.fileExists then begin errorMessage; exit; end; // verify that the decl is in phobos pth := str; while true do begin if pth.extractFilePath = pth then begin errorMessage; exit; end; pth := pth.extractFilePath; setLength(pth,pth.length-1); if (pth.extractFilename = 'phobos') 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 exit; 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; if fPhobosDocRoot.dirExists then pth := 'file://' + fPhobosDocRoot else pth := fPhobosDocRoot; 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.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 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 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 < 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; {$ENDREGION} {$REGION DDoc & CallTip --------------------------------------------------------} procedure TCESynMemo.InitHintWins; begin if fCallTipWin.isNil then begin fCallTipWin := TCEEditorHintWindow.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; begin if not fIsDSource and not alwaysAdvancedFeatures then exit; if not fCallTipWin.Visible then fCallTipStrings.Clear; str := LineText[1..CaretX]; x := CaretX; i := x; if findOpenParen then while true do begin if i = 1 then break; if str[i-1] = '(' then begin LogicalCaretXY := Point(i, CaretY); break; end; if str[i] = #9 then i -= TabWidth else i -= 1; end; DcdWrapper.getCallTip(str); begin 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.isEmpty then exit; {$IFDEF WINDOWS} str := str[1..str.length-2]; {$ELSE} str := str[1..str.length-1]; {$ENDIF} showCallTips(str); end; if findOpenParen then CaretX:=x; end; procedure TCESynMemo.showCallTips(const tips: string); var pnt: TPoint; begin if (not fIsDSource and not alwaysAdvancedFeatures) or tips.isEmpty then exit; pnt := ClientToScreen(point(CaretXPix, CaretYPix)); fCallTipWin.FontSize := Font.Size; fCallTipWin.HintRect := fCallTipWin.CalcHintRect(0, tips, nil); fCallTipWin.OffsetHintRect(pnt, Font.Size * 2); fCallTipWin.ActivateHint(tips); end; procedure TCESynMemo.hideCallTips; begin 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 showCallTips(fCallTipStrings.Text); 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 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[1] = ' ') then begin value := sourceValue + KeyChar; end else begin fLastCompletion := value; if KeyChar[1] in fCloseCompletionCharsWithSpace then value += ' ' + KeyChar else if KeyChar[1] in fCloseCompletionChars then value += KeyChar; 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; 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; {$ENDREGION --------------------------------------------------------------------} {$REGION Coedit 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 := ''; 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.lexInDdoc: char; var i: integer; p: integer; tk1: PLexToken = nil; tk2: PLexToken = nil; begin result := #0; p := SelStart; 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^.offset < p) and (tk1^.kind in [ltkComment, ltkIllegal]) and (tk1^.Data[1] in ['*','+']) and (tk2^.offset > p) then exit(tk1^.Data[1]) else if (tk1^.offset > p) then exit; end else if (tk1^.offset < 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; fIsTxtFile := Highlighter = fTxtHighlighter; 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 ext: string; begin ext := fname.extractFileExt; fIsDsource := hasDlangSyntax(ext); if not fIsDsource then Highlighter := TxtSyn; Lines.LoadFromFile(fname); fFilename := fname; FileAge(fFilename, fFileDate); ReadOnly := FileIsReadOnly(fFilename); fModified := false; if Showing then begin setFocus; loadCache; fCacheLoaded := true; end; if detectIndentMode then begin case indentationMode(lines) of imTabs: Options:= Options - [eoTabsToSpaces]; imSpaces: Options:= Options + [eoTabsToSpaces]; end; end; subjDocChanged(TCEMultiDocSubject(fMultiDocSubject), self); fCanDscan := true; end; procedure TCESynMemo.saveToFile(const fname: string); var ext: string; begin ext := fname.extractFilePath; if FileIsReadOnly(ext) then begin getMessageDisplay.message('No write access in: ' + ext, self, amcEdit, amkWarn); exit; end; ReadOnly := false; Lines.SaveToFile(fname); fFilename := fname; ext := fname.extractFileExt; fIsDsource := hasDlangSyntax(ext); if fIsDsource then Highlighter := fD2Highlighter else if not isProjectDescription then Highlighter := TxtHighlighter; 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 readOnly then exit; 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, getCoeditDocPath + '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 fDisableFileDateCheck then exit; if fFilename.isNotEmpty and not fFilename.fileExists and (fFilename <> '') 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); With TCEDiffViewer.construct(fTempFileName, fFilename) do try mr := ShowModal; case mr of mrOK: begin replaceUndoableContent(str.strictText); fFileDate := newDate; end; mrIgnore: fFileDate := newDate; mrCancel:; end; finally free; 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; lne: string; 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 lne := lst[i]; //if eoTabsToSpaces in Options then //begin leadingTabsToSpaces(lne, TabWidth); lst[i] := lne; //end {else if eoSpacesToTabs in Options then begin //leadingSpacesToTabs(lne, TabWidth); //lst[i] := lne; end} 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; 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 := lexInDdoc; if ddc in ['*', '+'] then begin inherited; insertLeadingDDocSymbol(ddc); fCanShowHint:=false; fDDocWin.Hide; exit; end; end; end; 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; if StaticEditorMacro.automatic then StaticEditorMacro.Execute; end; procedure TCESynMemo.UTF8KeyPress(var Key: TUTF8Char); var c: TUTF8Char; begin c := Key; inherited; fCanDscan := true; case c of #39: if autoCloseSingleQuote in fAutoClosedPairs then autoClosePair(autoCloseSingleQuote); '"': 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; '{': 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; if fCompletion.IsActive then fCompletion.CurrentString:=GetWordAtRowCol(LogicalCaretXY); end; procedure TCESynMemo.MouseLeave; begin inherited; hideDDocs; hideCallTips; 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 - 1) then begin; fScrollMemo.Visible:=true; fScrollMemo.goToLine((lines.Count div height) * (Y)); fScrollMemo.left := width - 40 - fScrollMemo.Width; fScrollMemo.Top:= Y - 5; end else begin fScrollMemo.Visible:=false; end; end; end; procedure TCESynMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); 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; begin exit(fBreakPoints.Count); end; function TCESynMemo.BreakPointLine(index: integer): integer; begin if index >= fBreakPoints.Count then exit(0); {$PUSH}{$WARNINGS OFF}{$HINTS OFF} exit(Integer(fBreakPoints.Items[index])); {$POP} end; procedure TCESynMemo.addBreakPoint(line: integer); begin if findBreakPoint(line) then exit; addGutterIcon(line, giBreakSet); {$PUSH}{$WARNINGS OFF}{$HINTS OFF} fBreakPoints.Add(pointer(line)); {$POP} if assigned(fDebugger) then fDebugger.addBreakPoint(fFilename, line, bpkBreak); end; procedure TCESynMemo.removeBreakPoint(line: integer); begin if not findBreakPoint(line) then exit; removeGutterIcon(line, giBreakSet); {$PUSH}{$WARNINGS OFF}{$HINTS OFF} fBreakPoints.Remove(pointer(line)); {$POP} if assigned(fDebugger) then fDebugger.removeBreakPoint(fFilename, line); end; procedure TCESynMemo.showHintEvent(Sender: TObject; HintInfo: PHintInfo); var p: TPoint; s: string; begin if cursor <> crDefault then exit; p := ScreenToClient(mouse.CursorPos); if p.x > Gutter.MarksPart.Width then exit; p := self.PixelsToRowColumn(p); s := getDscannerWarning(p.y); if s.isNotEmpty then begin s := 'Warning(s):' + LineEnding + s; fDDocWin.FontSize := Font.Size; fDDocWin.HintRect := fDDocWin.CalcHintRect(0, s, nil); fDDocWin.OffsetHintRect(mouse.CursorPos, Font.Size); fDDocWin.ActivateHint(fDDocWin.HintRect, s); end; 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.findBreakPoint(line: integer): boolean; begin {$PUSH}{$WARNINGS OFF}{$HINTS OFF} exit(fBreakPoints.IndexOf(pointer(line)) <> -1); {$POP} 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); begin fDebugger := debugger; end; procedure TCESynMemo.debugStop; begin fDebugger := nil; removeDebugTimeMarks; end; procedure TCESynMemo.debugContinue; begin removeDebugTimeMarks; end; function TCESynMemo.debugQueryBpCount: integer; begin exit(fBreakPoints.Count); end; procedure TCESynMemo.debugQueryBreakPoint(const index: integer; out fname: string; out line: integer; out kind: TBreakPointKind); begin fname:= fFilename; line := breakPointLine(index); kind := bpkBreak; 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); RegisterClasses([TCESynMemoCache, TCEFoldCache]); finalization D2Syn.Free; LfmSyn.Free; TxtSyn.Free; JsSyn.Free; // TCESynMemo.cleanCache; end.