mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-17 19:42:44 +02:00
11481 lines
373 KiB
ObjectPascal
11481 lines
373 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: SynEdit.pas, released 2000-04-07.
|
|
The Original Code is based on mwCustomEdit.pas by Martin Waldenburg, part of
|
|
the mwEdit component suite.
|
|
Portions created by Martin Waldenburg are Copyright (C) 1998 Martin Waldenburg.
|
|
All Rights Reserved.
|
|
|
|
Contributors to the SynEdit and mwEdit projects are listed in the
|
|
Contributors.txt file.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.
|
|
|
|
$Id$
|
|
|
|
You may retrieve the latest version of this file at the SynEdit home page,
|
|
located at http://SynEdit.SourceForge.net
|
|
|
|
Known Issues:
|
|
|
|
-DoubleBuffered
|
|
-Font.CharSet
|
|
-THintWindow
|
|
-DragAcceptFiles
|
|
-Font DBCS / MBCS double, multi byte character set
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
unit SynEdit;
|
|
|
|
{$I synedit.inc}
|
|
|
|
{$IFDEF LCLGTK1}
|
|
{$DEFINE EnableDoubleBuf} // gtk1 does not have double buffering
|
|
{$ENDIF}
|
|
{$IFDEF LCLGTK2}
|
|
{ $DEFINE EnableDoubleBuf} // gtk2.10 paints faster to memory
|
|
// gtk2.12 paints faster directly
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
{ $DEFINE VerboseKeys}
|
|
|
|
uses
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
FreeBIDI, utf8bidi,
|
|
{$ENDIF}
|
|
Types, FPCAdds, LCLIntf, LCLType, LMessages, LCLProc,
|
|
{$ELSE}
|
|
Windows,
|
|
{$ENDIF}
|
|
{$IFDEF DebugCodeFolding}
|
|
Dialogs,
|
|
{$ENDIF}
|
|
SysUtils, Classes, Messages, Controls, Graphics, Forms, StdCtrls, ExtCtrls,
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
Imm,
|
|
{$ENDIF}
|
|
SynEditTypes, SynEditSearch, SynEditKeyCmds, SynEditMiscProcs,
|
|
{$ifdef SYN_LAZARUS}
|
|
SynEditMarkup, SynEditMarkupHighAll, SynEditMarkupBracket,
|
|
{$ENDIF}
|
|
SynEditMiscClasses, SynEditTextBuffer, SynEditHighlighter, SynTextDrawer;
|
|
|
|
const
|
|
DIGIT = ['0'..'9'];
|
|
// ALPHA = ['A'..'Z', 'a'..'z'];
|
|
// break these up because we exceed the 4 byte limit when combined.
|
|
ALPHA_UC = ['A'..'Z'];
|
|
ALPHA_LC = ['a'..'z'];
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
ScrollBarWidth=0;
|
|
{$ENDIF}
|
|
|
|
{$IFNDEF SYN_COMPILER_3_UP}
|
|
// not defined in all Delphi versions
|
|
WM_MOUSEWHEEL = $020A;
|
|
{$ENDIF}
|
|
|
|
// maximum scroll range
|
|
MAX_SCROLL = 32767;
|
|
|
|
// Max number of book/gutter marks returned from GetEditMarksForLine - that
|
|
// really should be enough.
|
|
maxMarks = 16;
|
|
|
|
SYNEDIT_CLIPBOARD_FORMAT = 'SynEdit Control Block Type';
|
|
|
|
{$IFNDEF SYN_LAZARUS}
|
|
var
|
|
SynEditClipboardFormat: UINT;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
{$IFNDEF SYN_COMPILER_4_UP}
|
|
{Windows.pas in D4}
|
|
const
|
|
C3_NONSPACING = 1; { nonspacing character }
|
|
C3_DIACRITIC = 2; { diacritic mark }
|
|
C3_VOWELMARK = 4; { vowel mark }
|
|
C3_SYMBOL = 8; { symbols }
|
|
C3_KATAKANA = $0010; { katakana character }
|
|
C3_HIRAGANA = $0020; { hiragana character }
|
|
C3_HALFWIDTH = $0040; { half width character }
|
|
C3_FULLWIDTH = $0080; { full width character }
|
|
C3_IDEOGRAPH = $0100; { ideographic character }
|
|
C3_KASHIDA = $0200; { Arabic kashida character }
|
|
C3_LEXICAL = $0400; { lexical character }
|
|
C3_ALPHA = $8000; { any linguistic char (C1_ALPHA) }
|
|
C3_NOTAPPLICABLE = 0; { ctype 3 is not applicable }
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
type
|
|
TSynReplaceAction = (raCancel, raSkip, raReplace, raReplaceAll);
|
|
|
|
ESynEditError = class(Exception);
|
|
|
|
TDropFilesEvent = procedure(Sender: TObject; X, Y: integer; AFiles: TStrings)
|
|
of object;
|
|
|
|
THookedCommandEvent = procedure(Sender: TObject; AfterProcessing: boolean;
|
|
var Handled: boolean; var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer; HandlerData: pointer) of object;
|
|
|
|
TPaintEvent = procedure(Sender: TObject; ACanvas: TCanvas) of object;
|
|
|
|
TProcessCommandEvent = procedure(Sender: TObject;
|
|
var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer) of object;
|
|
|
|
TReplaceTextEvent = procedure(Sender: TObject; const ASearch, AReplace:
|
|
string; Line, Column: integer; var ReplaceAction: TSynReplaceAction) of object;
|
|
|
|
TSpecialLineColorsEvent = procedure(Sender: TObject; Line: integer;
|
|
var Special: boolean; var FG, BG: TColor) of object;
|
|
|
|
TSynEditCaretType = (ctVerticalLine, ctHorizontalLine, ctHalfBlock, ctBlock);
|
|
|
|
TSynStateFlag = (sfCaretChanged, sfScrollbarChanged, sfLinesChanging,
|
|
sfIgnoreNextChar, sfCaretVisible, sfDblClicked, sfPossibleGutterClick,
|
|
{$IFDEF SYN_LAZARUS}
|
|
sfTripleClicked, sfQuadClicked, sfPainting,
|
|
{$ENDIF}
|
|
sfWaitForDragging,{$IFDEF SYN_LAZARUS} sfIsDragging,{$ENDIF} sfInsideRedo
|
|
); //mh 2000-10-30
|
|
TSynStateFlags = set of TSynStateFlag;
|
|
|
|
TSynEditorOption = (
|
|
eoAltSetsColumnMode, // Holding down the Alt Key will put the selection mode into columnar format
|
|
eoAutoIndent, // Will indent the caret on new lines with the same amount of leading white space as the preceding line
|
|
eoAutoSizeMaxScrollWidth, //TODO Automatically resizes the MaxScrollWidth property when inserting text
|
|
eoDisableScrollArrows, //TODO Disables the scroll bar arrow buttons when you can't scroll in that direction any more
|
|
eoDragDropEditing, // Allows you to select a block of text and drag it within the document to another location
|
|
eoDropFiles, //TODO Allows the editor accept file drops
|
|
eoEnhanceHomeKey, // home key jumps to line start if nearer, similar to visual studio
|
|
eoGroupUndo, // When undoing/redoing actions, handle all continous changes of the same kind in one call instead undoing/redoing each command separately
|
|
eoHalfPageScroll, // When scrolling with page-up and page-down commands, only scroll a half page at a time
|
|
eoHideShowScrollbars, //TODO if enabled, then the scrollbars will only show when necessary. If you have ScrollPastEOL, then it the horizontal bar will always be there (it uses MaxLength instead)
|
|
eoKeepCaretX, // When moving through lines w/o Cursor Past EOL, keeps the X position of the cursor
|
|
eoNoCaret, // Makes it so the caret is never visible
|
|
eoNoSelection, // Disables selecting text
|
|
eoRightMouseMovesCursor, // When clicking with the right mouse for a popup menu, move the cursor to that location
|
|
eoScrollByOneLess, // Forces scrolling to be one less
|
|
eoScrollHintFollows, //TODO The scroll hint follows the mouse when scrolling vertically
|
|
eoScrollPastEof, // Allows the cursor to go past the end of file marker
|
|
eoScrollPastEol, // Allows the cursor to go past the last character into the white space at the end of a line
|
|
eoShowScrollHint, // Shows a hint of the visible line numbers when scrolling vertically
|
|
eoShowSpecialChars, //TODO Shows the special Characters
|
|
eoSmartTabDelete, //TODO similar to Smart Tabs, but when you delete characters
|
|
eoSmartTabs, // When tabbing, the cursor will go to the next non-white space character of the previous line
|
|
//eoSpecialLineDefaultFg, //TODO disables the foreground text color override when using the OnSpecialLineColor event
|
|
eoTabIndent, // When active <Tab> and <Shift><Tab> act as block indent, unindent when text is selected
|
|
eoTabsToSpaces, // Converts a tab character to a specified number of space characters
|
|
eoTrimTrailingSpaces, // Spaces at the end of lines will be trimmed and not saved
|
|
{$IFDEF SYN_LAZARUS}
|
|
eoBracketHighlight, // Highlight matching bracket
|
|
eoDoubleClickSelectsLine, // Select line on double click
|
|
eoHideRightMargin, // Hides the right margin line
|
|
eoPersistentCaret, // Do not hide caret when focus lost
|
|
eoShowCtrlMouseLinks, // Pressing Ctrl will highlight the word under the mouse cursor
|
|
eoAutoIndentOnPaste, // Indent text inserted from clipboard
|
|
eoSpacesToTabs // Converts space characters to tabs and spaces
|
|
{$ENDIF}
|
|
);
|
|
TSynEditorOptions = set of TSynEditorOption;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
TSynEditorOption2 = (
|
|
eoCaretSkipsSelection, // Caret skips selection on VK_LEFT/VK_RIGHT
|
|
eoAlwaysVisibleCaret // Move caret to be always visible when scrolling
|
|
);
|
|
TSynEditorOptions2 = set of TSynEditorOption2;
|
|
{$ENDIF}
|
|
|
|
const
|
|
SYNEDIT_DEFAULT_OPTIONS = [
|
|
eoAutoIndent,
|
|
eoDragDropEditing,
|
|
eoScrollPastEol,
|
|
eoShowScrollHint,
|
|
eoSmartTabs,
|
|
eoTabsToSpaces,
|
|
eoTrimTrailingSpaces,
|
|
eoSmartTabDelete,
|
|
eoGroupUndo,
|
|
{$IFDEF SYN_LAZARUS}
|
|
eoBracketHighlight
|
|
{$ENDIF}
|
|
];
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
SYNEDIT_DEFAULT_OPTIONS2 = [
|
|
];
|
|
{$ENDIF}
|
|
|
|
type
|
|
// use scAll to update a statusbar when another TCustomSynEdit got the focus
|
|
TSynStatusChange = (scAll, scCaretX, scCaretY, scLeftChar, scTopLine,
|
|
scInsertMode, scModified, scSelection, scReadOnly);
|
|
TSynStatusChanges = set of TSynStatusChange;
|
|
|
|
TStatusChangeEvent = procedure(Sender: TObject; Changes: TSynStatusChanges)
|
|
of object;
|
|
|
|
TCustomSynEdit = class;
|
|
|
|
TSynEditMark = class
|
|
protected
|
|
fLine, fColumn, fImage: Integer;
|
|
fEdit: TCustomSynEdit;
|
|
fVisible: boolean;
|
|
fInternalImage: boolean;
|
|
fBookmarkNum: integer;
|
|
function GetEdit: TCustomSynEdit; virtual;
|
|
procedure SetColumn(const Value: Integer); virtual;
|
|
procedure SetImage(const Value: Integer); virtual;
|
|
procedure SetLine(const Value: Integer); virtual;
|
|
procedure SetVisible(const Value: boolean); {$IFDEF SYN_LAZARUS}virtual;{$ENDIF} //MWE: Laz needs to know when a line gets visible, so the editor color can be updated
|
|
procedure SetInternalImage(const Value: boolean);
|
|
function GetIsBookmark: boolean;
|
|
public
|
|
constructor Create(AOwner: TCustomSynEdit);
|
|
property Line: integer read fLine write SetLine;
|
|
property Column: integer read fColumn write SetColumn;
|
|
property ImageIndex: integer read fImage write SetImage;
|
|
property BookmarkNumber: integer read fBookmarkNum write fBookmarkNum;
|
|
property Visible: boolean read fVisible write SetVisible;
|
|
property InternalImage: boolean read fInternalImage write SetInternalImage;
|
|
property IsBookmark: boolean read GetIsBookmark;
|
|
end;
|
|
|
|
TPlaceMarkEvent = procedure(Sender: TObject; var Mark: TSynEditMark)
|
|
of object;
|
|
|
|
TSynEditMarks = array[1..maxMarks] of TSynEditMark;
|
|
|
|
{ A list of mark objects. Each object cause a litle picture to be drawn in the
|
|
gutter. }
|
|
TSynEditMarkList = class(TList)
|
|
protected
|
|
fEdit: TCustomSynEdit;
|
|
fOnChange: TNotifyEvent;
|
|
procedure DoChange;
|
|
function Get(Index: Integer): TSynEditMark;
|
|
procedure Put(Index: Integer; Item: TSynEditMark);
|
|
public
|
|
constructor Create(AOwner: TCustomSynEdit);
|
|
destructor Destroy; override;
|
|
function Add(Item: TSynEditMark): Integer;
|
|
procedure ClearLine(line: integer);
|
|
procedure Delete(Index: Integer);
|
|
function First: TSynEditMark;
|
|
procedure GetMarksForLine(line: integer; var Marks: TSynEditMarks);
|
|
procedure Insert(Index: Integer; Item: TSynEditMark);
|
|
function Last: TSynEditMark;
|
|
procedure Place(Mark: TSynEditMark);
|
|
function Remove(Item: TSynEditMark): Integer;
|
|
public
|
|
property Items[Index: Integer]: TSynEditMark read Get write Put; default;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
TGutterClickEvent = procedure(Sender: TObject; X, Y, Line: integer;
|
|
mark: TSynEditMark) of object;
|
|
|
|
TSynEditPlugin = class(TObject)
|
|
private
|
|
fOwner: TCustomSynEdit;
|
|
protected
|
|
procedure AfterPaint(ACanvas: TCanvas; AClip: TRect;
|
|
FirstLine, LastLine: integer); virtual; abstract;
|
|
procedure LinesInserted(FirstLine, Count: integer); virtual; abstract;
|
|
procedure LinesDeleted(FirstLine, Count: integer); virtual; abstract;
|
|
protected
|
|
property Editor: TCustomSynEdit read fOwner; //mh 2000-11-10
|
|
public
|
|
constructor Create(AOwner: TCustomSynEdit);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
{ TSynCustomBeautifier }
|
|
|
|
TSynCustomBeautifier = class(TComponent)
|
|
public
|
|
function LeftSpaces(Editor: TCustomSynEdit; const Line: string;
|
|
Physical: boolean): Integer;
|
|
// InsertPos is 1 based. e.g. left,top is 1,1
|
|
function GetIndentForLineBreak(Editor: TCustomSynEdit;
|
|
InsertPos: TPoint; var NextText: string): integer; virtual;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TCustomSynEdit }
|
|
|
|
TCustomSynEdit = class(TCustomControl)
|
|
private
|
|
procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;
|
|
procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
|
|
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
procedure WMHScroll(var Msg: {$IFDEF SYN_LAZARUS}TLMScroll{$ELSE}TWMScroll{$ENDIF}); message WM_HSCROLL;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
procedure WMImeComposition(var Msg: TMessage); message WM_IME_COMPOSITION;
|
|
procedure WMImeNotify(var Msg: TMessage); message WM_IME_NOTIFY;
|
|
{$ENDIF}
|
|
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure WMExit(var Message: TLMExit); message LM_EXIT;
|
|
procedure Resize; override;
|
|
{$ELSE}
|
|
procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL;
|
|
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
|
|
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
|
|
{$ENDIF}
|
|
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
|
procedure WMVScroll(var Msg: {$IFDEF SYN_LAZARUS}TLMScroll{$ELSE}TWMScroll{$ENDIF}); message WM_VSCROLL;
|
|
private
|
|
fFirstLine: integer;
|
|
fBlockBegin: TPoint; // logical position (byte)
|
|
fBlockEnd: TPoint; // logical position (byte)
|
|
fBlockIndent: integer;
|
|
fCaretX: Integer; // physical position (screen)
|
|
{$IFDEF SYN_LAZARUS}
|
|
fCtrlMouseActive: boolean;
|
|
FCFDividerDrawLevel: Integer;
|
|
fMarkupManager : TSynEditMarkupManager;
|
|
fMarkupHighAll : TSynEditMarkupHighlightAll;
|
|
fMarkupBracket : TSynEditMarkupBracket;
|
|
{$ENDIF}
|
|
fLastCaretX: integer; // physical position (screen) //mh 2000-10-19
|
|
fCaretY: Integer;
|
|
fCharsInWindow: Integer;
|
|
fCharWidth: Integer;
|
|
fFontDummy: TFont;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
fImeCount: Integer;
|
|
fMBCSStepAside: Boolean;
|
|
{$ENDIF}
|
|
fInserting: Boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fLastMouseCaret: TPoint; // physical (screen)
|
|
fLastControlIsPressed: boolean;
|
|
fLastCtrlMouseLinkY: integer;
|
|
fLastCtrlMouseLinkX1: integer; // logical (byte)
|
|
fLastCtrlMouseLinkX2: integer; // logical (byte)
|
|
fHighlighterNeedsUpdateStartLine: integer; // 1 based, 0 means invalid
|
|
fHighlighterNeedsUpdateEndLine: integer; // 1 based, 0 means invalid
|
|
fBeautifier: TSynCustomBeautifier;
|
|
fExtraCharSpacing: integer;
|
|
{$ENDIF}
|
|
fLines: TStrings;
|
|
fLinesInWindow: Integer;// MG: fully visible lines in window
|
|
fLeftChar: Integer; // first visible screen column
|
|
fMaxLeftChar: Integer; // 1024
|
|
fPaintLock: Integer;
|
|
fReadOnly: Boolean;
|
|
fRightEdge: Integer;
|
|
fRightEdgeColor: TColor;
|
|
FScrollBars: TScrollStyle;
|
|
FTabChar: char;
|
|
fTextHeight: Integer;
|
|
fTextOffset: Integer;
|
|
fTopLine: Integer;
|
|
fHighlighter: TSynCustomHighlighter;
|
|
fSelectedColor: TSynSelectedColor;
|
|
fUndoList: TSynEditUndoList;
|
|
fRedoList: TSynEditUndoList;
|
|
fBookMarks: array[0..9] of TSynEditMark;
|
|
fMouseDownX: integer;
|
|
fMouseDownY: integer;
|
|
fBookMarkOpt: TSynBookMarkOpt;
|
|
{$ifndef SYN_LAZARUS}
|
|
fBorderStyle: TBorderStyle;
|
|
fMouseWheelAccumulator: integer;
|
|
{$endif}
|
|
fHideSelection: boolean;
|
|
fOverwriteCaret: TSynEditCaretType;
|
|
fInsertCaret: TSynEditCaretType;
|
|
fCaretOffset: TPoint;
|
|
fKeyStrokes: TSynEditKeyStrokes;
|
|
fModified: Boolean;
|
|
fMarkList: TSynEditMarkList;
|
|
fExtraLineSpacing: integer;
|
|
fSelectionMode: TSynSelectionMode;
|
|
FUseUTF8: boolean;
|
|
fWantTabs: boolean;
|
|
fGutter: TSynGutter;
|
|
fTabWidth: integer;
|
|
fTextDrawer: TheTextDrawer;
|
|
fInvalidateRect: TRect;
|
|
fStateFlags: TSynStateFlags;
|
|
fOptions: TSynEditorOptions;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fOptions2: TSynEditorOptions2;
|
|
{$ENDIF}
|
|
fStatusChanges: TSynStatusChanges;
|
|
fLastKey: word;
|
|
fLastShiftState: TShiftState;
|
|
fTSearch: TSynEditSearch;
|
|
fHookedCommandHandlers: TList;
|
|
fPlugins: TList;
|
|
fScrollTimer: TTimer;
|
|
fScrollDeltaX, fScrollDeltaY: Integer;
|
|
// event handlers
|
|
fOnChange: TNotifyEvent;
|
|
fOnClearMark: TPlaceMarkEvent; // djlp 2000-08-29
|
|
fOnCommandProcessed: TProcessCommandEvent;
|
|
fOnDropFiles: TDropFilesEvent;
|
|
fOnGutterClick: TGutterClickEvent;
|
|
fOnPaint: TPaintEvent;
|
|
fOnPlaceMark: TPlaceMarkEvent;
|
|
fOnProcessCommand: TProcessCommandEvent;
|
|
fOnProcessUserCommand: TProcessCommandEvent;
|
|
fOnReplaceText: TReplaceTextEvent;
|
|
fOnSpecialLineColors: TSpecialLineColorsEvent;
|
|
fOnStatusChange: TStatusChangeEvent;
|
|
{$IFDEF SYN_LAZARUS}
|
|
FOnClickLink: TMouseEvent;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure AquirePrimarySelection;
|
|
{$ENDIF}
|
|
procedure BookMarkOptionsChanged(Sender: TObject);
|
|
procedure ComputeCaret(X, Y: Integer);
|
|
procedure DoBlockIndent;
|
|
procedure DoBlockUnindent;
|
|
procedure DoHomeKey(Selection: boolean);
|
|
procedure DoLinesDeleted(FirstLine, Count: integer);
|
|
procedure DoLinesInserted(FirstLine, Count: integer);
|
|
procedure DoTabKey;
|
|
function FindHookedCmdEvent(AHandlerProc: THookedCommandEvent): integer;
|
|
procedure FontChanged(Sender: TObject); {$IFDEF SYN_LAZARUS}override;{$ENDIF}
|
|
function GetBlockBegin: TPoint;
|
|
function GetBlockEnd: TPoint;
|
|
function GetCanPaste: Boolean;
|
|
function GetCanRedo: Boolean;
|
|
function GetCanUndo: Boolean;
|
|
function GetCaretXY: TPoint;
|
|
function GetFont: TFont;
|
|
function GetHookedCommandHandlersCount: integer;
|
|
function GetLineText: string;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function GetCharLen(const Line: string; CharStartPos: integer): integer;
|
|
function AdjustBytePosToCharacterStart(Line: integer; BytePos: integer): integer;
|
|
function AdjustPhysPosToCharacterStart(Line: integer; PhysPos: integer): integer;
|
|
function GetLogicalCaretXY: TPoint;
|
|
procedure SetCFDividerDrawLevel(const AValue: Integer);
|
|
procedure SetHighlightAllColor(const AValue : TSynSelectedColor); {TODO: move into highlighter? markupHA.GetAttributesFrom(editoptions)}
|
|
function GetHighlightAllColor : TSynSelectedColor;
|
|
procedure SetLogicalCaretXY(const NewLogCaretXY: TPoint);
|
|
procedure SetBeautifier(NewBeautifier: TSynCustomBeautifier);
|
|
{$ENDIF}
|
|
function GetMaxUndo: Integer;
|
|
function GetSelAvail: Boolean;
|
|
function GetSelText: string;
|
|
function SynGetText: string;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure SetTabChar(const AValue: Char);
|
|
function RealGetText: TCaption; override;
|
|
{$ENDIF}
|
|
procedure GutterChanged(Sender: TObject);
|
|
procedure InsertBlock(BB, BE: TPoint; ChangeStr: PChar);
|
|
function IsPointInSelection(Value: TPoint): boolean;
|
|
function LeftSpaces(const Line: string): Integer;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function LeftSpaces(const Line: string; Physical: boolean): Integer;
|
|
{$ENDIF}
|
|
procedure LinesChanging(Sender: TObject);
|
|
procedure LinesChanged(Sender: TObject);
|
|
procedure LockUndo;
|
|
procedure MoveCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}const {$ENDIF}ptBefore, ptAfter: TPoint;
|
|
SelectionCommand: boolean);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure MoveCaretAndSelectionPhysical(
|
|
const ptBeforePhysical, ptAfterPhysical: TPoint;
|
|
SelectionCommand: boolean);
|
|
{$ENDIF}
|
|
procedure MoveCaretHorz(DX: integer; SelectionCommand: boolean);
|
|
procedure MoveCaretVert(DY: integer; SelectionCommand: boolean);
|
|
procedure PluginsAfterPaint(ACanvas: TCanvas; AClip: TRect;
|
|
FirstLine, LastLine: integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure PrimarySelectionRequest(const RequestedFormatID: TClipboardFormat;
|
|
Data: TStream);
|
|
{$ENDIF}
|
|
function ScanFrom(Index: integer
|
|
{$IFDEF SYN_LAZARUS}; AtLeastTilIndex: integer = -1{$ENDIF}): integer;
|
|
procedure ScrollTimerHandler(Sender: TObject);
|
|
procedure SelectedColorsChanged(Sender: TObject);
|
|
procedure SetBlockBegin(Value: TPoint);
|
|
procedure SetBlockEnd(Value: TPoint);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure SetBlockIndent(const AValue: integer);
|
|
{$ELSE}
|
|
procedure SetBorderStyle(Value: TBorderStyle);
|
|
{$ENDIF}
|
|
procedure SetCaretAndSelection({$IFDEF SYN_LAZARUS}const {$ENDIF}ptCaret,
|
|
ptBefore, ptAfter: TPoint);
|
|
procedure SetCaretX(Value: Integer);
|
|
procedure SetCaretY(Value: Integer);
|
|
procedure SetExtraLineSpacing(const Value: integer);
|
|
procedure SetFont(const Value: TFont);
|
|
procedure SetGutter(const Value: TSynGutter);
|
|
procedure SetGutterWidth(Value: Integer);
|
|
procedure SetHideSelection(const Value: boolean);
|
|
procedure SetHighlighter(const Value: TSynCustomHighlighter);
|
|
procedure SetInsertCaret(const Value: TSynEditCaretType);
|
|
procedure SetInsertMode(const Value: boolean);
|
|
procedure SetKeystrokes(const Value: TSynEditKeyStrokes);
|
|
{$ifdef SYN_LAZARUS}
|
|
procedure SetExtraCharSpacing(const Value: integer);
|
|
procedure SetLastMouseCaret(const AValue: TPoint);
|
|
{$ENDIF}
|
|
procedure SetLeftChar(Value: Integer);
|
|
procedure SetLines(Value: TStrings);
|
|
procedure SetLineText(Value: string);
|
|
procedure SetMaxLeftChar(Value: integer);
|
|
procedure SetMaxUndo(const Value: Integer);
|
|
procedure SetModified(Value: boolean);
|
|
procedure SetOptions(Value: TSynEditorOptions);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure SetOptions2(const Value: TSynEditorOptions2);
|
|
{$ENDIF}
|
|
procedure SetOverwriteCaret(const Value: TSynEditCaretType);
|
|
procedure SetRightEdge(Value: Integer);
|
|
procedure SetRightEdgeColor(Value: TColor);
|
|
procedure SetScrollBars(const Value: TScrollStyle);
|
|
procedure SetSelectionMode(const Value: TSynSelectionMode);
|
|
procedure SetSelText(const Value: string);
|
|
procedure SetSelTextExternal(const Value: string);
|
|
procedure SetTabWidth(Value: integer);
|
|
procedure SynSetText(const Value: string);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure RealSetText(const Value: TCaption); override;
|
|
{$ENDIF}
|
|
procedure SetTopLine(Value: Integer);
|
|
procedure SetWantTabs(const Value: boolean);
|
|
procedure SetWordBlock(Value: TPoint);
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure SetLineBlock(Value: TPoint);
|
|
procedure SetParagraphBlock(Value: TPoint);
|
|
{$ENDIF}
|
|
procedure SizeOrFontChanged(bFont: boolean);
|
|
procedure StatusChanged(AChanges: TSynStatusChanges);
|
|
procedure TrimmedSetLine(ALine: integer; ALineText: string);
|
|
procedure UndoRedoAdded(Sender: TObject);
|
|
procedure UnlockUndo;
|
|
procedure UpdateCaret;
|
|
procedure UpdateCtrlMouse;
|
|
procedure UpdateScrollBars;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DblClick; override;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TripleClick; override;
|
|
procedure QuadClick; override;
|
|
{$ENDIF}
|
|
procedure DecPaintLock;
|
|
procedure DestroyWnd; override;
|
|
procedure DragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean); override;
|
|
procedure FindMatchingBracket; virtual;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function FindMatchingBracket(PhysStartBracket: TPoint;
|
|
StartIncludeNeighborChars, MoveCaret,
|
|
SelectBrackets, OnlyVisible: boolean
|
|
): TPoint; virtual;
|
|
public
|
|
procedure FindMatchingBracketPair(const PhysCaret: TPoint;
|
|
var StartBracket, EndBracket: TPoint;
|
|
OnlyVisible: boolean);
|
|
protected
|
|
{$ENDIF}
|
|
function GetReadOnly: boolean; virtual;
|
|
procedure HideCaret;
|
|
procedure HighlighterAttrChanged(Sender: TObject);
|
|
procedure IncPaintLock;
|
|
procedure InitializeCaret;
|
|
// note: FirstLine and LastLine don't need to be in correct order
|
|
procedure InvalidateGutterLines(FirstLine, LastLine: integer);
|
|
procedure InvalidateLines(FirstLine, LastLine: integer);
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure UTF8KeyPress(var Key: TUTF8Char); override;
|
|
{$ENDIF}
|
|
procedure KeyPress(var Key: Char); override;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure KeyUp(var Key : Word; Shift : TShiftState); override;
|
|
{$ENDIF}
|
|
procedure ListAdded(Index: integer); //mh 2000-10-10
|
|
procedure ListCleared(Sender: TObject);
|
|
procedure ListDeleted(Index: integer);
|
|
procedure ListInserted(Index: integer);
|
|
procedure ListPutted(Index: integer);
|
|
procedure ListScanRanges(Sender: TObject);
|
|
procedure Loaded; override;
|
|
procedure MarkListChange(Sender: TObject);
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
procedure MBCSGetSelRangeInLineWhenColumnSelectionMode(const s: string;
|
|
var ColFrom, ColTo: Integer);
|
|
{$ENDIF}
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
|
|
Integer); override;
|
|
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
override;
|
|
procedure NotifyHookedCommandHandlers(AfterProcessing: boolean;
|
|
var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer); virtual;
|
|
procedure Paint; override;
|
|
procedure PaintGutter(AClip: TRect; FirstLine, LastLine: integer); virtual;
|
|
procedure PaintTextLines(AClip: TRect; FirstLine, LastLine,
|
|
FirstCol, LastCol: integer); virtual;
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure StartPaintBuffer(const ClipRect: TRect);
|
|
procedure EndPaintBuffer(const ClipRect: TRect);
|
|
procedure EraseBackground(DC: HDC); override;
|
|
{$ENDIF}
|
|
procedure RecalcCharExtent;
|
|
procedure RedoItem; //sbs 2000-11-19
|
|
procedure SetCaretXY(Value: TPoint); virtual;
|
|
procedure SetName(const Value: TComponentName); override;
|
|
procedure SetReadOnly(Value: boolean); virtual;
|
|
procedure SetSelTextPrimitive(PasteMode: TSynSelectionMode; Value: PChar;
|
|
ATag: PInteger);
|
|
procedure ShowCaret;
|
|
// If the translations requires Data, memory will be allocated for it via a
|
|
// GetMem call. The client must call FreeMem on Data if it is not NIL.
|
|
function TranslateKeyCode(Code: word; Shift: TShiftState;
|
|
var Data: pointer): TSynEditorCommand;
|
|
procedure UndoItem; //sbs 2000-11-19
|
|
protected
|
|
fGutterWidth: Integer;
|
|
fInternalImage: TSynInternalImage;
|
|
{$IFDEF EnableDoubleBuf}
|
|
BufferBitmap: TBitmap; // the double buffer
|
|
{$ENDIF}
|
|
SavedCanvas: TCanvas; // the normal TCustomControl canvas during paint
|
|
procedure DoOnClearBookmark(var Mark: TSynEditMark); virtual; // djlp - 2000-08-29
|
|
procedure DoOnCommandProcessed(Command: TSynEditorCommand;
|
|
AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer); virtual;
|
|
// no method DoOnDropFiles, intercept the WM_DROPFILES instead
|
|
procedure DoOnGutterClick(X, Y: integer); virtual;
|
|
procedure DoOnPaint; virtual;
|
|
procedure DoOnPlaceMark(var Mark: TSynEditMark); virtual;
|
|
procedure DoOnProcessCommand(var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer); virtual;
|
|
function DoOnReplaceText(const ASearch, AReplace: string;
|
|
Line, Column: integer): TSynReplaceAction; virtual;
|
|
function DoOnSpecialLineColors(Line: integer;
|
|
var Foreground, Background: TColor): boolean; virtual;
|
|
procedure DoOnStatusChange(Changes: TSynStatusChanges); virtual;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property LastMouseCaret: TPoint read FLastMouseCaret write SetLastMouseCaret;
|
|
function GetSelEnd: integer; //L505
|
|
function GetSelStart: integer;
|
|
procedure SetSelEnd(const Value: integer);
|
|
procedure SetSelStart(const Value: integer);
|
|
{$ENDIF}
|
|
public
|
|
{$IFDEF SYN_LAZARUS}
|
|
//code fold
|
|
procedure CodeFoldAction(iLine: integer);
|
|
function FindNextUnfoldedLine(iLine: integer; Down: boolean): Integer;
|
|
procedure UnfoldAll;
|
|
{$ENDIF}
|
|
|
|
procedure AddKey(Command: TSynEditorCommand; Key1: word; SS1: TShiftState;
|
|
Key2: word; SS2: TShiftState);
|
|
procedure BeginUndoBlock; //sbs 2000-11-19
|
|
procedure BeginUpdate;
|
|
function CaretXPix: Integer;
|
|
function CaretYPix: Integer;
|
|
procedure ClearAll;
|
|
procedure ClearBookMark(BookMark: Integer);
|
|
procedure ClearSelection;
|
|
procedure CommandProcessor(Command:TSynEditorCommand;
|
|
AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data:pointer); virtual;
|
|
procedure ClearUndo;
|
|
procedure CopyToClipboard;
|
|
constructor Create(AOwner: TComponent); override;
|
|
procedure CutToClipboard;
|
|
destructor Destroy; override;
|
|
procedure DoCopyToClipboard(const SText: string);
|
|
procedure DragDrop(Source: TObject; X, Y: Integer); override;
|
|
procedure EndUndoBlock; //sbs 2000-11-19
|
|
procedure EndUpdate;
|
|
procedure EnsureCursorPosVisible;
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
function ExecuteAction(ExeAction: TBasicAction): boolean; override;
|
|
{$ENDIF}
|
|
procedure ExecuteCommand(Command: TSynEditorCommand;
|
|
{$IFDEF SYN_LAZARUS}const AChar: TUTF8Char{$ELSE}AChar: Char{$ENDIF};
|
|
Data: pointer); virtual;
|
|
function GetBookMark(BookMark: integer; var X, Y: integer): boolean;
|
|
function GetHighlighterAttriAtRowCol(XY: TPoint; var Token: string;
|
|
var Attri: TSynHighlighterAttributes): boolean;
|
|
function GetHighlighterAttriAtRowColEx(XY: TPoint; var Token: string;
|
|
var TokenType, Start: Integer;
|
|
var Attri: TSynHighlighterAttributes): boolean; //L505
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure GetWordBoundsAtRowCol(const XY: TPoint; var StartX, EndX: integer);
|
|
function GetLineIndentProposal(Line: integer;
|
|
IgnoreCurrentLineText: boolean): integer;
|
|
{$ENDIF}
|
|
function GetWordAtRowCol(XY: TPoint): string;
|
|
procedure GotoBookMark(BookMark: Integer);
|
|
function IdentChars: TSynIdentChars;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function IsIdentChar(const c: TUTF8Char): boolean;
|
|
{$ENDIF}
|
|
procedure InvalidateGutter;
|
|
procedure InvalidateLine(Line: integer);
|
|
function IsBookmark(BookMark: integer): boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function LogicalToPhysicalPos(const p: TPoint): TPoint;
|
|
function LogicalToPhysicalCol(const Line: string;
|
|
LogicalPos: integer): integer;
|
|
function LogicalToPhysicalCol(Line: PChar; LineLen: integer;
|
|
LogicalPos, StartBytePos, StartPhysicalPos: integer): integer;
|
|
function PhysicalLineLength(Line: PChar; LineLen: integer;
|
|
WithTabs: boolean): integer;
|
|
function PhysicalToLogicalPos(const p: TPoint): TPoint;
|
|
function PhysicalToLogicalCol(const Line: string;
|
|
PhysicalPos: integer): integer;
|
|
function PhysicalToLogicalCol(const Line: string;
|
|
PhysicalPos, StartBytePos, StartPhysicalPos: integer): integer;
|
|
procedure MoveCaretToVisibleArea;
|
|
procedure MoveCaretIgnoreEOL(const NewCaret: TPoint);
|
|
procedure MoveLogicalCaretIgnoreEOL(const NewLogCaret: TPoint);
|
|
function NextTokenPos: TPoint; virtual;
|
|
{$ELSE}
|
|
function LogicalToPhysicalPos(p: TPoint): TPoint;
|
|
{$ENDIF}
|
|
function NextWordPos: TPoint; virtual;
|
|
procedure Notification(AComponent: TComponent;
|
|
Operation: TOperation); override;
|
|
procedure PasteFromClipboard;
|
|
function PrevWordPos: TPoint; virtual;
|
|
function PixelsToRowColumn(Pixels: TPoint): TPoint;
|
|
{$IFDEF SYN_LAZARUS}
|
|
function PixelsToLogicalPos(const Pixels: TPoint): TPoint;
|
|
function ScreenRowToRow(ScreenRow: integer): integer;
|
|
function RowToScreenRow(PhysicalRow: integer): integer;
|
|
{$ENDIF}
|
|
procedure Redo;
|
|
procedure RegisterCommandHandler(AHandlerProc: THookedCommandEvent;
|
|
AHandlerData: pointer);
|
|
function RowColumnToPixels(
|
|
{$IFDEF SYN_LAZARUS}const {$ENDIF}RowCol: TPoint): TPoint;
|
|
function SearchReplace(const ASearch, AReplace: string;
|
|
AOptions: TSynSearchOptions): integer;
|
|
procedure SelectAll;
|
|
{$IFDEF SYN_LAZARUS}
|
|
Procedure SetHighlightSearch(const ASearch: String; AOptions: TSynSearchOptions);
|
|
procedure SelectToBrace;
|
|
procedure SelectLine;
|
|
procedure SelectParagraph;
|
|
{$ENDIF}
|
|
procedure SetBookMark(BookMark: Integer; X: Integer; Y: Integer);
|
|
procedure SetDefaultKeystrokes; virtual;
|
|
procedure SetOptionFlag(Flag: TSynEditorOption; Value: boolean);
|
|
procedure SetSelWord;
|
|
procedure Undo;
|
|
procedure UnregisterCommandHandler(AHandlerProc: THookedCommandEvent);
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
function UpdateAction(TheAction: TBasicAction): boolean; override;
|
|
{$ENDIF}
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
public
|
|
property BlockBegin: TPoint read GetBlockBegin write SetBlockBegin;
|
|
property BlockEnd: TPoint read GetBlockEnd write SetBlockEnd;
|
|
property CanPaste: Boolean read GetCanPaste;
|
|
property CanRedo: boolean read GetCanRedo;
|
|
property CanUndo: boolean read GetCanUndo;
|
|
property CaretX: Integer read fCaretX write SetCaretX;
|
|
property CaretY: Integer read fCaretY write SetCaretY;
|
|
property CaretXY: TPoint read GetCaretXY write SetCaretXY;
|
|
property CharsInWindow: Integer read fCharsInWindow;
|
|
property CharWidth: integer read fCharWidth;
|
|
property Color default clWhite;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property Beautifier: TSynCustomBeautifier read fBeautifier write SetBeautifier;
|
|
property CtrlMouseActive: boolean read fCtrlMouseActive;
|
|
property LogicalCaretXY: TPoint read GetLogicalCaretXY write SetLogicalCaretXY;
|
|
property SelStart: Integer read GetSelStart write SetSelStart;
|
|
property SelEnd: Integer read GetSelEnd write SetSelEnd;
|
|
{$ENDIF}
|
|
property Font: TFont read GetFont write SetFont;
|
|
property GutterWidth: Integer read fGutterWidth;
|
|
property Highlighter: TSynCustomHighlighter
|
|
read fHighlighter write SetHighlighter;
|
|
property LeftChar: Integer read fLeftChar write SetLeftChar;
|
|
property LineHeight: integer read fTextHeight;
|
|
property LinesInWindow: Integer read fLinesInWindow; // MG: fully visible lines
|
|
property LineText: string read GetLineText write SetLineText;
|
|
property Lines: TStrings read fLines write SetLines;
|
|
property Marks: TSynEditMarkList read fMarkList;
|
|
property MaxLeftChar: integer read fMaxLeftChar write SetMaxLeftChar
|
|
default 1024;
|
|
property Modified: Boolean read fModified write SetModified;
|
|
property PaintLock: Integer read fPaintLock;
|
|
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default FALSE;
|
|
property SelAvail: Boolean read GetSelAvail;
|
|
property SelText: string read GetSelText write SetSelTextExternal;
|
|
property Text: string read SynGetText write SynSetText;
|
|
property TopLine: Integer read fTopLine write SetTopLine;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property UseUTF8: boolean read FUseUTF8;
|
|
procedure Update; override;
|
|
procedure Invalidate; override;
|
|
{$ENDIF}
|
|
public
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnProcessCommand: TProcessCommandEvent
|
|
read FOnProcessCommand write FOnProcessCommand;
|
|
protected
|
|
property BookMarkOptions: TSynBookMarkOpt
|
|
read fBookMarkOpt write fBookMarkOpt;
|
|
property BorderStyle {$ifndef SYN_LAZARUS}: TBorderStyle read FBorderStyle write SetBorderStyle{$endif}
|
|
default bsSingle;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property BlockIndent: integer read fBlockIndent write SetBlockIndent default 2;
|
|
property ExtraCharSpacing: integer
|
|
read fExtraCharSpacing write SetExtraCharSpacing default 0;
|
|
{$ENDIF}
|
|
property ExtraLineSpacing: integer
|
|
read fExtraLineSpacing write SetExtraLineSpacing default 0;
|
|
property Gutter: TSynGutter read fGutter write SetGutter;
|
|
property HideSelection: boolean read fHideSelection write SetHideSelection
|
|
default false;
|
|
property InsertCaret: TSynEditCaretType read FInsertCaret
|
|
write SetInsertCaret default ctVerticalLine;
|
|
property InsertMode: boolean read fInserting write SetInsertMode
|
|
default true;
|
|
property Keystrokes: TSynEditKeyStrokes
|
|
read FKeystrokes write SetKeystrokes;
|
|
property MaxUndo: Integer read GetMaxUndo write SetMaxUndo default 1024;
|
|
property Options: TSynEditorOptions read fOptions write SetOptions
|
|
default SYNEDIT_DEFAULT_OPTIONS;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property Options2: TSynEditorOptions2 read fOptions2 write SetOptions2
|
|
default SYNEDIT_DEFAULT_OPTIONS2;
|
|
{$ENDIF}
|
|
property OverwriteCaret: TSynEditCaretType read FOverwriteCaret
|
|
write SetOverwriteCaret default ctBlock;
|
|
property RightEdge: Integer read fRightEdge write SetRightEdge default 80;
|
|
property RightEdgeColor: TColor
|
|
read fRightEdgeColor write SetRightEdgeColor default clSilver;
|
|
property ScrollBars: TScrollStyle
|
|
read FScrollBars write SetScrollBars default ssBoth;
|
|
property SelectedColor: TSynSelectedColor
|
|
read FSelectedColor write FSelectedColor;
|
|
property SelectionMode: TSynSelectionMode
|
|
read FSelectionMode write SetSelectionMode default smNormal;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property HighlightAllColor: TSynSelectedColor
|
|
read GetHighlightAllColor write SetHighlightAllColor;
|
|
property TabChar: char read FTabChar write SetTabChar;
|
|
property CFDividerDrawLevel: Integer
|
|
read FCFDividerDrawLevel write SetCFDividerDrawLevel;
|
|
{$ENDIF}
|
|
property TabWidth: integer read fTabWidth write SetTabWidth default 8;
|
|
property WantTabs: boolean read fWantTabs write SetWantTabs default FALSE;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnClearBookmark: TPlaceMarkEvent read fOnClearMark
|
|
write fOnClearMark;
|
|
property OnCommandProcessed: TProcessCommandEvent
|
|
read fOnCommandProcessed write fOnCommandProcessed;
|
|
property OnDropFiles: TDropFilesEvent read fOnDropFiles write fOnDropFiles;
|
|
property OnGutterClick: TGutterClickEvent
|
|
read fOnGutterClick write fOnGutterClick;
|
|
property OnPaint: TPaintEvent read fOnPaint write fOnPaint;
|
|
property OnPlaceBookmark: TPlaceMarkEvent
|
|
read FOnPlaceMark write FOnPlaceMark;
|
|
property OnProcessUserCommand: TProcessCommandEvent
|
|
read FOnProcessUserCommand write FOnProcessUserCommand;
|
|
property OnReplaceText: TReplaceTextEvent read fOnReplaceText
|
|
write fOnReplaceText;
|
|
property OnSpecialLineColors: TSpecialLineColorsEvent
|
|
read fOnSpecialLineColors write fOnSpecialLineColors;
|
|
property OnStatusChange: TStatusChangeEvent
|
|
read fOnStatusChange write fOnStatusChange;
|
|
end;
|
|
|
|
TSynEdit = class(TCustomSynEdit)
|
|
published
|
|
// inherited properties
|
|
property Align;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property Beautifier;
|
|
property BlockIndent;
|
|
property BorderSpacing;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
property Anchors;
|
|
property Constraints;
|
|
{$ENDIF}
|
|
property Color;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property Cursor default crIBeam;
|
|
property CFDividerDrawLevel;
|
|
{$ENDIF}
|
|
property Ctl3D;
|
|
property Enabled;
|
|
property Font;
|
|
property Height;
|
|
property Name;
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property Tag;
|
|
property Visible;
|
|
property Width;
|
|
// inherited events
|
|
property OnClick;
|
|
property OnDblClick;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property OnTripleClick;
|
|
property OnQuadClick;
|
|
{$ENDIF}
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
// ToDo Docking
|
|
property OnEndDock;
|
|
{$ENDIF}
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property OnClickLink : TMouseEvent read FOnClickLink write FOnClickLink;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
// ToDo Docking
|
|
property OnStartDock;
|
|
{$ENDIF}
|
|
property OnStartDrag;
|
|
// TCustomSynEdit properties
|
|
property BookMarkOptions;
|
|
property BorderStyle;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property ExtraCharSpacing;
|
|
{$ENDIF}
|
|
property ExtraLineSpacing;
|
|
property Gutter;
|
|
property HideSelection;
|
|
property Highlighter;
|
|
property InsertCaret;
|
|
property InsertMode;
|
|
property Keystrokes;
|
|
property Lines;
|
|
property MaxLeftChar;
|
|
property MaxUndo;
|
|
property Options;
|
|
{$IFDEF SYN_LAZARUS}
|
|
property Options2;
|
|
property HighlightAllColor;
|
|
{$ENDIF}
|
|
property OverwriteCaret;
|
|
property ReadOnly;
|
|
property RightEdge;
|
|
property RightEdgeColor;
|
|
property ScrollBars;
|
|
property SelectedColor;
|
|
property SelectionMode;
|
|
property TabWidth;
|
|
property WantTabs;
|
|
// TCustomSynEdit events
|
|
property OnChange;
|
|
property OnClearBookmark; // djlp 2000-08-29
|
|
property OnCommandProcessed;
|
|
property OnDropFiles;
|
|
property OnGutterClick;
|
|
property OnPaint;
|
|
property OnPlaceBookmark;
|
|
property OnProcessCommand;
|
|
property OnProcessUserCommand;
|
|
property OnReplaceText;
|
|
property OnSpecialLineColors;
|
|
property OnStatusChange;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function SynEditClipboardFormat: TClipboardFormat;
|
|
{$ENDIF}
|
|
|
|
implementation
|
|
|
|
// { $R SynEdit.res}
|
|
|
|
uses
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
StdActns,
|
|
{$ENDIF}
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo ShellAPI
|
|
ShellAPI, SynEditStrConst,
|
|
{$ENDIF}
|
|
Clipbrd;
|
|
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
const
|
|
fSynEditClipboardFormat: TClipboardFormat = 0;
|
|
|
|
function SynEditClipboardFormat: TClipboardFormat;
|
|
begin
|
|
if fSynEditClipboardFormat=0 then
|
|
fSynEditClipboardFormat := ClipboardRegisterFormat(SYNEDIT_CLIPBOARD_FORMAT);
|
|
Result:=fSynEditClipboardFormat;
|
|
end;
|
|
|
|
function CreateTabsAndSpaces(StartPos, SpaceLen, TabWidth: integer;
|
|
UseTabs: boolean): string;
|
|
var
|
|
TabCount: Integer;
|
|
EndPos: Integer;
|
|
PosPlusOneTab: Integer;
|
|
begin
|
|
Result:='';
|
|
if not UseTabs then begin
|
|
Result:=StringOfChar(' ',SpaceLen);
|
|
exit;
|
|
end;
|
|
TabCount:=0;
|
|
EndPos:=StartPos+SpaceLen;
|
|
while StartPos<EndPos do begin
|
|
PosPlusOneTab:=StartPos+TabWidth-((StartPos-1) mod TabWidth);
|
|
if PosPlusOneTab<=EndPos then begin
|
|
inc(TabCount);
|
|
StartPos:=PosPlusOneTab;
|
|
end else begin
|
|
Result:=StringOfChar(' ',EndPos-StartPos);
|
|
break;
|
|
end;
|
|
end;
|
|
if TabCount>0 then
|
|
Result:=StringOfChar(#9,TabCount)+Result;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function Roundoff(X: Extended): Longint;
|
|
begin
|
|
if (x >= 0) then begin
|
|
Result := TruncToInt(x + 0.5)
|
|
end else begin
|
|
Result := TruncToInt(x - 0.5);
|
|
end;
|
|
end;
|
|
|
|
{ THookedCommandHandlerEntry }
|
|
|
|
type
|
|
THookedCommandHandlerEntry = class(TObject)
|
|
private
|
|
fEvent: THookedCommandEvent;
|
|
fData: pointer;
|
|
function Equals(AEvent: THookedCommandEvent): boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
public
|
|
{$ENDIF}
|
|
constructor Create(AEvent: THookedCommandEvent; AData: pointer);
|
|
end;
|
|
|
|
constructor THookedCommandHandlerEntry.Create(AEvent: THookedCommandEvent;
|
|
AData: pointer);
|
|
begin
|
|
inherited Create;
|
|
fEvent := AEvent;
|
|
fData := AData;
|
|
end;
|
|
|
|
function THookedCommandHandlerEntry.Equals(AEvent: THookedCommandEvent): boolean;
|
|
begin
|
|
with TMethod(fEvent) do
|
|
Result := (Code = TMethod(AEvent).Code) and (Data = TMethod(AEvent).Data);
|
|
end;
|
|
|
|
{ TCustomSynEdit }
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.AquirePrimarySelection;
|
|
var
|
|
FormatList: TClipboardFormat;
|
|
begin
|
|
if (not SelAvail)
|
|
or (PrimarySelection.OnRequest=@PrimarySelectionRequest) then exit;
|
|
FormatList:=CF_TEXT;
|
|
try
|
|
PrimarySelection.SetSupportedFormats(1,@FormatList);
|
|
PrimarySelection.OnRequest:=@PrimarySelectionRequest;
|
|
except
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.PixelsToRowColumn(Pixels: TPoint): TPoint;
|
|
// converts the client area coordinate
|
|
// to Caret position (screen position, (1,1) based)
|
|
// To get the text/physical position use PixelsToLogicalPos
|
|
var
|
|
f: Single;
|
|
begin
|
|
f := ((Pixels.X+(fLeftChar-1)*fCharWidth-fGutterWidth-2)/fCharWidth)+1;
|
|
// don't return a partially visible last line
|
|
if Pixels.Y >= fLinesInWindow * fTextHeight then begin
|
|
Pixels.Y := fLinesInWindow * fTextHeight - 1;
|
|
if Pixels.Y < 0 then Pixels.Y := 0;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
Result := Point(RoundOff(f), ScreenRowToRow(Pixels.Y div fTextHeight));
|
|
{$ELSE}
|
|
Result := Point(RoundOff(f), Pixels.Y div fTextHeight + TopLine);
|
|
{$ENDIF}
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (Result.Y >= 1) and (Result.Y <= Lines.Count) then begin
|
|
s := Lines[Result.Y - 1];
|
|
if (Length(s) >= Result.x) and (ByteType(s, Result.X) = mbTrailByte) then
|
|
if Frac(f) >= 0.5 then
|
|
Dec(Result.X)
|
|
else
|
|
Inc(Result.X);
|
|
end;
|
|
fMBCSStepAside := False;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.PixelsToLogicalPos(const Pixels: TPoint): TPoint;
|
|
begin
|
|
Result:=PhysicalToLogicalPos(PixelsToRowColumn(Pixels));
|
|
end;
|
|
|
|
function TCustomSynEdit.ScreenRowToRow(ScreenRow: integer): integer;
|
|
begin
|
|
Result:=TopLine;
|
|
if ScreenRow>LinesInWindow+1 then ScreenRow:=LinesInWindow+1;
|
|
while ScreenRow>0 do begin
|
|
inc(Result);
|
|
if (Result>Lines.Count)
|
|
or (not TSynEditStringList(fLines).Folded[Result-1]) then
|
|
dec(ScreenRow);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.RowToScreenRow(PhysicalRow: integer): integer;
|
|
// returns -1 for lines above visible screen (<TopLine)
|
|
// 0 for the first line
|
|
// Max(0,LinesInWindow-1) for the last fully visible line
|
|
// and returns LinesInWindow for lines below visible screen including the
|
|
// partially visible line at the bottom
|
|
var
|
|
i: LongInt;
|
|
begin
|
|
if PhysicalRow<TopLine then exit(-1);
|
|
Result:=0;
|
|
i:=TopLine;
|
|
while (Result<=LinesInWindow) and (i<PhysicalRow) do begin
|
|
if (i>Lines.Count)
|
|
or (not TSynEditStringList(fLines).Folded[i-1]) then
|
|
inc(Result);
|
|
inc(i);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.RowColumnToPixels(
|
|
{$IFDEF SYN_LAZARUS}const {$ENDIF}RowCol: TPoint): TPoint;
|
|
// converts screen position (1,1) based
|
|
// to client area coordinate
|
|
begin
|
|
Result:=RowCol;
|
|
Result.X := (Result.X - 1) * fCharWidth + fTextOffset;
|
|
Result.Y := (Result.Y - fTopLine) * fTextHeight + 1;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ComputeCaret(X, Y: Integer);
|
|
// set caret to pixel position
|
|
begin
|
|
CaretXY := PixelsToRowColumn(Point(X,Y));
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoCopyToClipboard(const SText: string);
|
|
var
|
|
{$IFDEF SYN_LAZARUS}
|
|
Buf: Pointer;
|
|
BufSize: integer;
|
|
{$ELSE}
|
|
Mem: HGLOBAL;
|
|
{$ENDIF}
|
|
P: PChar;
|
|
SLen: integer;
|
|
Failed: boolean;
|
|
begin
|
|
if SText <> '' then begin
|
|
Failed := TRUE; // assume the worst.
|
|
SLen := Length(SText);
|
|
{$IFDEF SYN_LAZARUS}
|
|
try
|
|
Clipboard.Clear;
|
|
Clipboard.AsText:=SText;
|
|
Failed:=not Clipboard.HasFormat(CF_TEXT);
|
|
except
|
|
end;
|
|
if not Failed then begin
|
|
Failed:=true;
|
|
// Copy it in our custom format so we know what kind of block it is.
|
|
// That effects how it is pasted in.
|
|
BufSize:=SLen+SizeOf(TSynSelectionMode)+1;
|
|
GetMem(Buf,BufSize);
|
|
if Buf<>nil then
|
|
try
|
|
P:=PChar(Buf);
|
|
// Our format: TSynSelectionMode value followed by text.
|
|
PSynSelectionMode(P)^ := SelectionMode;
|
|
inc(P, SizeOf(TSynSelectionMode));
|
|
if SLen>0 then begin
|
|
Move(SText[1], P^, SLen);
|
|
inc(P,SLen);
|
|
end;
|
|
P[0]:=#0;
|
|
try
|
|
Failed:=not Clipboard.AddFormat(SynEditClipboardFormat,Buf^,BufSize);
|
|
except
|
|
end;
|
|
finally
|
|
FreeMem(Buf);
|
|
end;
|
|
end;
|
|
if Failed then
|
|
raise ESynEditError.Create('Clipboard copy operation failed');
|
|
{$ELSE}
|
|
// Open and Close are the only TClipboard methods we use because TClipboard
|
|
// is very hard (impossible) to work with if you want to put more than one
|
|
// format on it at a time.
|
|
Clipboard.Open;
|
|
try
|
|
// Clear anything already on the clipboard.
|
|
EmptyClipboard;
|
|
// Put it on the clipboard as normal text format so it can be pasted into
|
|
// things like notepad or Delphi.
|
|
Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, SLen + 1);
|
|
if Mem <> 0 then begin
|
|
P := GlobalLock(Mem);
|
|
try
|
|
if P <> nil then begin
|
|
Move(PChar(SText)^, P^, SLen + 1);
|
|
// Put it on the clipboard in text format
|
|
Failed := SetClipboardData(CF_TEXT, Mem) = 0;
|
|
end;
|
|
finally
|
|
GlobalUnlock(Mem);
|
|
end;
|
|
end;
|
|
// Don't free Mem! It belongs to the clipboard now, and it will free it
|
|
// when it is done with it.
|
|
if not Failed then begin
|
|
// Copy it in our custom format so we know what kind of block it is.
|
|
// That effects how it is pasted in.
|
|
Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, SLen +
|
|
SizeOf(TSynSelectionMode) + 1);
|
|
P := GlobalLock(Mem);
|
|
try
|
|
if P <> nil then begin
|
|
// Our format: TSynSelectionMode value followed by text.
|
|
PSynSelectionMode(P)^ := SelectionMode;
|
|
inc(P, SizeOf(TSynSelectionMode));
|
|
Move(PChar(SText)^, P^, SLen + 1);
|
|
Failed := SetClipboardData(SynEditClipboardFormat, Mem) = 0;
|
|
end;
|
|
finally
|
|
GlobalUnlock(Mem);
|
|
end;
|
|
// Don't free Mem! It belongs to the clipboard now, and it will free it
|
|
// when it is done with it.
|
|
end;
|
|
finally
|
|
Clipboard.Close;
|
|
if Failed then
|
|
raise ESynEditError.Create('Clipboard copy operation failed');
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.CopyToClipboard;
|
|
var
|
|
SText: string;
|
|
begin
|
|
if SelAvail then begin
|
|
SText := SelText;
|
|
DoCopyToClipboard(SText);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.CutToClipboard;
|
|
var
|
|
SText: string;
|
|
begin
|
|
if SelAvail then begin
|
|
SText := SelText;
|
|
DoCopyToClipboard(SText);
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SText, SelectionMode);
|
|
LockUndo;
|
|
SelText := '';
|
|
UnlockUndo;
|
|
end;
|
|
end;
|
|
|
|
constructor TCustomSynEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
{begin} //mh 2000-10-10
|
|
// fLines := TSynEditList.Create;
|
|
fLines := TSynEditStringList.Create;
|
|
// with TSynEditList(fLines) do begin
|
|
with TSynEditStringList(fLines) do begin
|
|
OnAdded := {$IFDEF FPC}@{$ENDIF}ListAdded;
|
|
OnChange := {$IFDEF FPC}@{$ENDIF}LinesChanged;
|
|
OnChanging := {$IFDEF FPC}@{$ENDIF}LinesChanging;
|
|
OnCleared := {$IFDEF FPC}@{$ENDIF}ListCleared;
|
|
OnDeleted := {$IFDEF FPC}@{$ENDIF}ListDeleted;
|
|
OnInserted := {$IFDEF FPC}@{$ENDIF}ListInserted;
|
|
OnPutted := {$IFDEF FPC}@{$ENDIF}ListPutted;
|
|
// OnScanRanges := {$IFDEF FPC}@{$ENDIF}ListScanRanges;
|
|
end;
|
|
{end} //mh 2000-10-10
|
|
fFontDummy := TFont.Create;
|
|
fUndoList := TSynEditUndoList.Create;
|
|
fUndoList.OnAddedUndo := {$IFDEF FPC}@{$ENDIF}UndoRedoAdded;
|
|
fRedoList := TSynEditUndoList.Create;
|
|
fRedoList.OnAddedUndo := {$IFDEF FPC}@{$ENDIF}UndoRedoAdded;
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo DoubleBuffered
|
|
DoubleBuffered := false;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
fSelectedColor := TSynSelectedColor.Create;
|
|
fSelectedColor.OnChange := {$IFDEF FPC}@{$ENDIF}SelectedColorsChanged;
|
|
fBookMarkOpt := TSynBookMarkOpt.Create(Self);
|
|
fBookMarkOpt.OnChange := {$IFDEF FPC}@{$ENDIF}BookMarkOptionsChanged;
|
|
// fRightEdge has to be set before FontChanged is called for the first time
|
|
fRightEdge := 80;
|
|
fGutter := TSynGutter.Create;
|
|
fGutter.OnChange := {$IFDEF FPC}@{$ENDIF}GutterChanged;
|
|
fGutterWidth := fGutter.Width;
|
|
fTextOffset := fGutterWidth + 2;
|
|
ControlStyle := ControlStyle + [csOpaque, csSetCaption
|
|
{$IFDEF SYN_LAZARUS}, csTripleClicks, csQuadClicks{$ENDIF}];
|
|
Height := 150;
|
|
Width := 200;
|
|
Cursor := crIBeam;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// needed before setting color
|
|
fMarkupHighAll := TSynEditMarkupHighlightAll.Create(self);
|
|
fMarkupBracket := TSynEditMarkupBracket.Create(self);
|
|
|
|
fMarkupManager := TSynEditMarkupManager.Create(self);
|
|
fMarkupManager.AddMarkUp(fMarkupHighAll);
|
|
fMarkupManager.AddMarkUp(fMarkupBracket);
|
|
fMarkupManager.Lines := TSynEditStringList(fLines);
|
|
fMarkupManager.InvalidateLinesMethod := @InvalidateLines;
|
|
|
|
Color := clWhite;
|
|
{$IFDEF LCLgtk}
|
|
fFontDummy.Name := '-adobe-courier-medium-r-normal-*-*-140-*-*-*-*-iso10646-1';
|
|
fFontDummy.Height := 14;
|
|
{$ELSE}
|
|
fFontDummy.Name := 'courier';
|
|
fFontDummy.Size := 12;
|
|
{$ENDIF}
|
|
fFontDummy.Pitch := fpFixed;
|
|
fLastMouseCaret := Point(-1,-1);
|
|
fLastCtrlMouseLinkY := -1;
|
|
fLastControlIsPressed := false;
|
|
fBlockIndent := 2;
|
|
FTabChar := {$IFDEF DebugShowTabs}'%'{$ELSE}' '{$ENDIF};
|
|
{$ELSE}
|
|
Color := clWindow;
|
|
fFontDummy.Name := 'Courier New';
|
|
fFontDummy.Size := 10;
|
|
{$IFDEF SYN_COMPILER_3_UP}
|
|
// ToDo Font CharSet
|
|
fFontDummy.CharSet := DEFAULT_CHARSET;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
fTextDrawer := TheTextDrawer.Create([fsBold], fFontDummy);
|
|
Font.Assign(fFontDummy);
|
|
Font.OnChange := {$IFDEF FPC}@{$ENDIF}FontChanged;
|
|
FontChanged(nil);
|
|
ParentFont := False;
|
|
ParentColor := False;
|
|
TabStop := True;
|
|
fInserting := True;
|
|
fMaxLeftChar := 1024;
|
|
fScrollBars := ssBoth;
|
|
{$IFDEF SYN_LAZARUS}
|
|
BorderStyle := bsSingle;
|
|
{$ELSE}
|
|
fBorderStyle := bsSingle;
|
|
{$ENDIF}
|
|
fInsertCaret := ctVerticalLine;
|
|
fOverwriteCaret := ctBlock;
|
|
FSelectionMode := smNormal;
|
|
fKeystrokes := TSynEditKeyStrokes.Create(Self);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if assigned(Owner) and not (csLoading in Owner.ComponentState) then
|
|
{$ENDIF}
|
|
SetDefaultKeystrokes;
|
|
fMarkList := TSynEditMarkList.Create(self);
|
|
fMarkList.OnChange := {$IFDEF FPC}@{$ENDIF}MarkListChange;
|
|
fRightEdgeColor := clSilver;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
fImeCount := 0;
|
|
fMBCSStepAside := False;
|
|
{$ENDIF}
|
|
fWantTabs := False;
|
|
fTabWidth := 8;
|
|
fLeftChar := 1;
|
|
fTopLine := 1;
|
|
fCaretX := 1;
|
|
fLastCaretX := 1; //mh 2000-10-19
|
|
fCaretY := 1;
|
|
fBlockBegin := Point(1, 1);
|
|
fBlockEnd := fBlockBegin;
|
|
// find / replace
|
|
fTSearch := TSynEditSearch.Create;
|
|
fOptions := SYNEDIT_DEFAULT_OPTIONS;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fOptions2 := SYNEDIT_DEFAULT_OPTIONS2;
|
|
{$ENDIF}
|
|
fScrollTimer := TTimer.Create(Self);
|
|
fScrollTimer.Enabled := False;
|
|
fScrollTimer.Interval := 100;
|
|
fScrollTimer.OnTimer := {$IFDEF FPC}@{$ENDIF}ScrollTimerHandler;
|
|
fFirstLine := 1;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.CreateParams(var Params: TCreateParams);
|
|
const
|
|
ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
|
|
WS_HSCROLL or WS_VSCROLL, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL);
|
|
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
|
|
ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do begin
|
|
{$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
|
|
WindowClass.Style := WindowClass.Style and not Cardinal(ClassStylesOff);
|
|
Style := Style or ScrollBar[FScrollBars] or BorderStyles[BorderStyle]
|
|
or WS_CLIPCHILDREN;
|
|
{$IFDEF RangeCheckOn}{$R+}{$ENDIF}
|
|
if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then begin
|
|
Style := Style and not Cardinal(WS_BORDER);
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DecPaintLock;
|
|
var
|
|
LastLineChanged: LongInt;
|
|
StartY: Integer;
|
|
begin
|
|
if (fPaintLock=1) and HandleAllocated then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fHighlighterNeedsUpdateStartLine>0 then begin
|
|
//DebugLn('TCustomSynEdit.DecPaintLock ',dbgs(fHighlighterNeedsUpdateStartLine),'-',dbgs(fHighlighterNeedsUpdateEndLine));
|
|
if fHighlighterNeedsUpdateStartLine<=Lines.Count then begin
|
|
if fHighlighterNeedsUpdateEndLine>Lines.Count then
|
|
fHighlighterNeedsUpdateEndLine:=Lines.Count;
|
|
LastLineChanged:=fHighlighterNeedsUpdateEndLine;
|
|
if Assigned(fHighlighter) then begin
|
|
// rescan all lines in range
|
|
// Note: The highlighter range of the line can be invalid as well,
|
|
// so start scan one line earlier
|
|
StartY:=fHighlighterNeedsUpdateStartLine-2;
|
|
if StartY<=0 then begin
|
|
StartY:=0;
|
|
fHighlighter.ReSetRange;
|
|
end else begin
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[StartY]);
|
|
end;
|
|
LastLineChanged:=ScanFrom(StartY,
|
|
fHighlighterNeedsUpdateEndLine-1);
|
|
//DebugLn('TCustomSynEdit.DecPaintLock ',dbgs(fHighlighterNeedsUpdateStartLine),'-',dbgs(fHighlighterNeedsUpdateEndLine),' LastLineChanged=',dbgs(LastLineChanged));
|
|
end;
|
|
InvalidateLines(fHighlighterNeedsUpdateStartLine,LastLineChanged+1);
|
|
InvalidateGutterLines(fHighlighterNeedsUpdateStartLine,LastLineChanged+1);
|
|
end;
|
|
fHighlighterNeedsUpdateStartLine:=0;
|
|
fHighlighterNeedsUpdateEndLine:=0;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Dec(fPaintLock);
|
|
if (fPaintLock = 0) and HandleAllocated then begin
|
|
if sfScrollbarChanged in fStateFlags then
|
|
UpdateScrollbars;
|
|
if sfCaretChanged in fStateFlags then
|
|
UpdateCaret
|
|
else if not(sfPainting in fStateFlags) and assigned(fMarkupBracket)
|
|
then fMarkupBracket.InvalidateBracketHighlight;
|
|
if fStatusChanges <> [] then
|
|
DoOnStatusChange(fStatusChanges);
|
|
end;
|
|
end;
|
|
|
|
destructor TCustomSynEdit.Destroy;
|
|
var
|
|
i: integer;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if HandleAllocated then LCLIntf.DestroyCaret(Handle);
|
|
Beautifier:=nil;
|
|
{$ENDIF}
|
|
Highlighter := nil;
|
|
// free listeners while other fields are still valid
|
|
if Assigned(fHookedCommandHandlers) then begin
|
|
for i := 0 to fHookedCommandHandlers.Count - 1 do
|
|
THookedCommandHandlerEntry(fHookedCommandHandlers[i]).Free;
|
|
fHookedCommandHandlers.Free;
|
|
end;
|
|
if fPlugins <> nil then begin
|
|
for i := fPlugins.Count - 1 downto 0 do
|
|
TSynEditPlugin(fPlugins[i]).Free;
|
|
fPlugins.Free;
|
|
end;
|
|
{$IFNDEF SYN_LAZARUS}
|
|
fScrollTimer.Free;
|
|
fTSearch.Free;
|
|
fMarkList.Free;
|
|
fBookMarkOpt.Free;
|
|
fBookMarkOpt := nil;
|
|
fKeyStrokes.Free;
|
|
fSelectedColor.Free;
|
|
fUndoList.Free;
|
|
fRedoList.Free;
|
|
fGutter.Free;
|
|
fTextDrawer.Free;
|
|
fInternalImage.Free;
|
|
fFontDummy.Free;
|
|
Lines.Free;
|
|
{$ELSE}
|
|
fHookedCommandHandlers:=nil;
|
|
fPlugins:=nil;
|
|
FreeAndNil(fScrollTimer);
|
|
FreeAndNil(fTSearch);
|
|
FreeAndNil(fMarkupManager);
|
|
FreeAndNil(fMarkList);
|
|
FreeAndNil(fBookMarkOpt);
|
|
FreeAndNil(fKeyStrokes);
|
|
FreeAndNil(fSelectedColor);
|
|
FreeAndNil(fUndoList);
|
|
FreeAndNil(fRedoList);
|
|
FreeAndNil(fGutter);
|
|
FreeAndNil(fTextDrawer);
|
|
FreeAndNil(fInternalImage);
|
|
FreeAndNil(fFontDummy);
|
|
FreeAndNil(fLines);
|
|
{$ENDIF}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetBlockBegin: TPoint;
|
|
begin
|
|
if (fBlockEnd.Y < fBlockBegin.Y)
|
|
or ((fBlockEnd.Y = fBlockBegin.Y) and (fBlockEnd.X < fBlockBegin.X))
|
|
then
|
|
Result := fBlockEnd
|
|
else
|
|
Result := fBlockBegin;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetBlockEnd: TPoint;
|
|
begin
|
|
if (fBlockEnd.Y < fBlockBegin.Y)
|
|
or ((fBlockEnd.Y = fBlockBegin.Y) and (fBlockEnd.X < fBlockBegin.X))
|
|
then
|
|
Result := fBlockBegin
|
|
else
|
|
Result := fBlockEnd;
|
|
end;
|
|
|
|
function TCustomSynEdit.CaretXPix: Integer;
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
p := Point(fCaretX, fCaretY);
|
|
Result := RowColumnToPixels(p).X;
|
|
end;
|
|
|
|
function TCustomSynEdit.CaretYPix: Integer;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Result := RowToScreenRow(fCaretY) * fTextHeight + 1;
|
|
{$ELSE}
|
|
Result := RowColumnToPixels(Point(1, fCaretY)).Y;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.FontChanged(Sender: TObject);
|
|
begin
|
|
RecalcCharExtent;
|
|
SizeOrFontChanged(TRUE);
|
|
end;
|
|
|
|
function TCustomSynEdit.GetFont: TFont;
|
|
begin
|
|
Result := inherited Font;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetLineText: string;
|
|
begin
|
|
if (CaretY >= 1) and (CaretY <= Lines.Count) then
|
|
Result := Lines[CaretY - 1]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.GetCharLen(const Line: string; CharStartPos: integer
|
|
): integer;
|
|
begin
|
|
if UseUTF8 and (length(Line)>=CharStartPos) then
|
|
Result:=UTF8CharacterLength(@Line[CharStartPos])
|
|
else
|
|
Result:=1;
|
|
end;
|
|
|
|
function TCustomSynEdit.AdjustBytePosToCharacterStart(Line: integer;
|
|
BytePos: integer): integer;
|
|
var
|
|
s: string;
|
|
begin
|
|
Result:=BytePos;
|
|
if Result<1 then
|
|
Result:=1
|
|
else if (Line>=1) and (Line<=Lines.Count) then begin
|
|
s:=Lines[Line-1];
|
|
if (Result<=length(s)) and UseUTF8 then
|
|
Result:=UTF8FindNearestCharStart(PChar(Pointer(s)),length(s),Result);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.AdjustPhysPosToCharacterStart(Line: integer;
|
|
PhysPos: integer): integer;
|
|
var
|
|
s: string;
|
|
BytePos: LongInt;
|
|
begin
|
|
Result:=PhysPos;
|
|
if Result<1 then
|
|
Result:=1
|
|
else if (Line>=1) and (Line<=Lines.Count) then begin
|
|
s:=Lines[Line-1];
|
|
BytePos:=PhysicalToLogicalCol(s,Result);
|
|
Result:=LogicalToPhysicalCol(s,BytePos);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetLogicalCaretXY: TPoint;
|
|
begin
|
|
Result:=PhysicalToLogicalPos(CaretXY);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetCFDividerDrawLevel(const AValue: Integer);
|
|
begin
|
|
if FCFDividerDrawLevel = AValue then
|
|
Exit; //==>
|
|
FCFDividerDrawLevel := AValue;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetHighlightAllColor(const AValue : TSynSelectedColor);
|
|
begin
|
|
fMarkupHighAll.FGColor := AValue.Foreground;
|
|
fMarkupHighAll.BGColor := AValue.Background;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetHighlightAllColor : TSynSelectedColor;
|
|
begin
|
|
result := fMarkupHighAll.MarkupInfo;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetLogicalCaretXY(const NewLogCaretXY: TPoint);
|
|
begin
|
|
CaretXY:=LogicalToPhysicalPos(NewLogCaretXY);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetBeautifier(NewBeautifier: TSynCustomBeautifier);
|
|
begin
|
|
if fBeautifier=NewBeautifier then exit;
|
|
fBeautifier:=NewBeautifier;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.GetSelAvail: Boolean;
|
|
begin
|
|
Result := (fBlockBegin.X <> fBlockEnd.X) or
|
|
((fBlockBegin.Y <> fBlockEnd.Y) and (fSelectionMode <> smColumn));
|
|
end;
|
|
|
|
function TCustomSynEdit.GetSelText: string;
|
|
|
|
function CopyPadded(const S: string; Index, Count: integer): string;
|
|
var
|
|
SrcLen: Integer;
|
|
DstLen: integer;
|
|
P: PChar;
|
|
begin
|
|
SrcLen := Length(S);
|
|
DstLen := Index + Count;
|
|
if SrcLen >= DstLen then
|
|
Result := Copy(S, Index, Count)
|
|
else begin
|
|
SetLength(Result, DstLen);
|
|
P := PChar(Pointer(Result));
|
|
StrPCopy(P, Copy(S, Index, Count));
|
|
Inc(P, SrcLen);
|
|
FillChar(P^, DstLen - Srclen, $20);
|
|
end;
|
|
end;
|
|
|
|
procedure CopyAndForward(const S: string; Index, Count: Integer; var P:
|
|
PChar);
|
|
var
|
|
pSrc: PChar;
|
|
SrcLen: Integer;
|
|
DstLen: Integer;
|
|
begin
|
|
SrcLen := Length(S);
|
|
if (Index <= SrcLen) and (Count > 0) then begin
|
|
Dec(Index);
|
|
pSrc := PChar(Pointer(S)) + Index;
|
|
DstLen := Min(SrcLen - Index, Count);
|
|
Move(pSrc^, P^, DstLen);
|
|
Inc(P, DstLen);
|
|
P^ := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure CopyPaddedAndForward(const S: string; Index, Count: Integer;
|
|
var P: PChar);
|
|
var
|
|
OldP: PChar;
|
|
Len: Integer;
|
|
begin
|
|
OldP := P;
|
|
CopyAndForward(S, Index, Count, P);
|
|
Len := Count - (P - OldP);
|
|
FillChar(P^, Len, #$20);
|
|
Inc(P, Len);
|
|
end;
|
|
|
|
|
|
const
|
|
sLineBreak = {$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#$0D#$0A{$ENDIF};
|
|
var
|
|
First, Last, TotalLen: Integer;
|
|
ColFrom, ColTo: Integer;
|
|
I: Integer;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
l, r: Integer;
|
|
s: string;
|
|
{$ELSE}
|
|
ColLen: integer;
|
|
{$ENDIF}
|
|
P: PChar;
|
|
begin
|
|
if not SelAvail then
|
|
Result := ''
|
|
else begin
|
|
with BlockBegin do begin
|
|
ColFrom := X;
|
|
First := Y - 1;
|
|
end;
|
|
with BlockEnd do begin
|
|
ColTo := X;
|
|
Last := Y - 1;
|
|
end;
|
|
TotalLen := 0;
|
|
case SelectionMode of
|
|
smNormal:
|
|
if (First = Last) then
|
|
Result := Copy(Lines[First], ColFrom, ColTo - ColFrom)
|
|
else begin
|
|
// step1: calculate total length of result string
|
|
TotalLen := Max(0, Length(Lines[First]) - ColFrom + 1);
|
|
for i := First + 1 to Last - 1 do
|
|
Inc(TotalLen, Length(Lines[i]));
|
|
Inc(TotalLen, ColTo - 1);
|
|
Inc(TotalLen, Length(sLineBreak) * (Last - First));
|
|
// step2: build up result string
|
|
SetLength(Result, TotalLen);
|
|
P := PChar(Pointer(Result));
|
|
CopyAndForward(Lines[First], ColFrom, MaxInt, P);
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
for i := First + 1 to Last - 1 do begin
|
|
CopyAndForward(Lines[i], 1, MaxInt, P);
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
CopyPaddedAndForward(Lines[Last], 1, ColTo - 1, P);
|
|
{$ELSE}
|
|
CopyAndForward(Lines[Last], 1, ColTo - 1, P);
|
|
{$ENDIF}
|
|
end;
|
|
smColumn:
|
|
begin
|
|
if ColFrom > ColTo then
|
|
SwapInt(ColFrom, ColTo);
|
|
// step1: calclate total length of result string
|
|
{$IFNDEF SYN_MBCSSUPPORT}
|
|
ColLen := ColTo - ColFrom;
|
|
TotalLen := ColLen + (ColLen + Length(sLineBreak)) * (Last - First);
|
|
// step2: build up result string
|
|
SetLength(Result, TotalLen);
|
|
P := PChar(Pointer(Result));
|
|
for i := First to Last - 1 do begin
|
|
CopyPaddedAndForward(Lines[i], ColFrom, ColLen, P);
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
end;
|
|
CopyPaddedAndForward(Lines[Last], ColFrom, ColLen, P);
|
|
{$ELSE} //SYN_MBCSSUPPORT
|
|
for i := First to Last do begin
|
|
s := Lines[i];
|
|
l := ColFrom;
|
|
r := ColTo;
|
|
MBCSGetSelRangeInLineWhenColumnSelectionMode(s, l, r);
|
|
Inc(TotalLen, r - l);
|
|
end;
|
|
Inc(TotalLen, Length(sLineBreak) * (Last - First));
|
|
// step2: build up result string
|
|
SetLength(Result, TotalLen);
|
|
P := PChar(Result);
|
|
for i := First to Last - 1 do begin
|
|
s := Lines[i];
|
|
l := ColFrom;
|
|
r := ColTo;
|
|
MBCSGetSelRangeInLineWhenColumnSelectionMode(s, l, r);
|
|
CopyPaddedAndForward(s, l, r - l, P);
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
end;
|
|
s := Lines[Last];
|
|
l := ColFrom;
|
|
r := ColTo;
|
|
MBCSGetSelRangeInLineWhenColumnSelectionMode(s, l, r);
|
|
CopyPaddedAndForward(Lines[Last], l, r - l, P);
|
|
{$ENDIF}
|
|
end;
|
|
smLine:
|
|
begin
|
|
// If block selection includes LastLine,
|
|
// line break code(s) of the last line will not be added.
|
|
// step1: calclate total length of result string
|
|
for i := First to Last do
|
|
Inc(TotalLen, Length(Lines[i]) + Length(sLineBreak));
|
|
if Last = Lines.Count then
|
|
Dec(TotalLen, Length(sLineBreak));
|
|
// step2: build up result string
|
|
SetLength(Result, TotalLen);
|
|
P := PChar(Pointer(Result));
|
|
for i := First to Last - 1 do begin
|
|
CopyAndForward(Lines[i], 1, MaxInt, P);
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
end;
|
|
CopyAndForward(Lines[Last], 1, MaxInt, P);
|
|
if (Last + 1) < Lines.Count then
|
|
CopyAndForward(sLineBreak, 1, MaxInt, P);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.SynGetText: string;
|
|
begin
|
|
Result := Lines.Text;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetTabChar(const AValue: Char);
|
|
begin
|
|
if FTabChar=AValue then exit;
|
|
FTabChar:=AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
function TCustomSynEdit.RealGetText: TCaption;
|
|
begin
|
|
if fLines<>nil then
|
|
Result := Lines.Text
|
|
else
|
|
Result := '';
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.HideCaret;
|
|
begin
|
|
//DebugLn('[TCustomSynEdit.HideCaret] ',Name,' ',sfCaretVisible in fStateFlags,' ',eoPersistentCaret in Options);
|
|
if sfCaretVisible in fStateFlags then begin
|
|
if {$IFDEF SYN_LAZARUS}LCLIntf{$ELSE}Windows{$ENDIF}.HideCaret(Handle) then
|
|
Exclude(fStateFlags, sfCaretVisible);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
procedure TCustomSynEdit.WMImeComposition(var Msg: TMessage);
|
|
var
|
|
imc: HIMC;
|
|
p: PChar;
|
|
begin
|
|
if ((Msg.LParam and GCS_RESULTSTR) <> 0) then begin
|
|
imc := ImmGetContext(Handle);
|
|
try
|
|
fImeCount := ImmGetCompositionString(imc, GCS_RESULTSTR, nil, 0);
|
|
GetMem(p, fImeCount + 1);
|
|
try
|
|
ImmGetCompositionString(imc, GCS_RESULTSTR, p, fImeCount + 1);
|
|
p[fImeCount] := #0;
|
|
CommandProcessor(ecImeStr, #0, p);
|
|
finally
|
|
FreeMem(p, fImeCount + 1);
|
|
end;
|
|
finally
|
|
ImmReleaseContext(Handle, imc);
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMImeNotify(var Msg: TMessage);
|
|
var
|
|
imc: HIMC;
|
|
logFont: TLogFont;
|
|
begin
|
|
with Msg do begin
|
|
case WParam of
|
|
IMN_SETOPENSTATUS:
|
|
begin
|
|
imc := ImmGetContext(Handle);
|
|
if (imc <> 0) then begin
|
|
GetObject(Font.Handle, SizeOf(TLogFont), @logFont);
|
|
ImmSetCompositionFont(imc, @logFont);
|
|
|
|
ImmReleaseContext(Handle, imc);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.IncPaintLock;
|
|
begin
|
|
inc(fPaintLock);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InvalidateGutter;
|
|
begin
|
|
InvalidateGutterLines(-1, -1);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InvalidateGutterLines(FirstLine, LastLine: integer);
|
|
var
|
|
rcInval: TRect;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if sfPainting in fStateFlags then exit;
|
|
{$ENDIF}
|
|
if Visible and HandleAllocated then
|
|
if (FirstLine = -1) and (LastLine = -1) then begin
|
|
rcInval := Rect(0, 0, fGutterWidth,
|
|
ClientHeight{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF});
|
|
if sfLinesChanging in fStateFlags then
|
|
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
|
|
else
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end else begin
|
|
{ find the visible lines first }
|
|
if (LastLine < FirstLine) then SwapInt(LastLine, FirstLine);
|
|
FirstLine := Max(FirstLine, TopLine);
|
|
LastLine := Min(LastLine,
|
|
{$IFDEF SYN_LAZARUS}
|
|
ScreenRowToRow(LinesInWindow)
|
|
{$ELSE}
|
|
TopLine + LinesInWindow
|
|
{$ENDIF}
|
|
);
|
|
{ any line visible? }
|
|
if (LastLine >= FirstLine) then begin
|
|
rcInval := Rect(0,
|
|
fTextHeight * {$IFDEF SYN_LAZARUS}RowToScreenRow(FirstLine)
|
|
{$ELSE}(FirstLine - TopLine){$ENDIF},
|
|
fGutterWidth,
|
|
fTextHeight * {$IFDEF SYN_LAZARUS}(RowToScreenRow(LastLine)+1)
|
|
{$ELSE}(LastLine - TopLine + 1){$ENDIF});
|
|
if sfLinesChanging in fStateFlags then
|
|
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
|
|
else
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InvalidateLines(FirstLine, LastLine: integer);
|
|
var
|
|
rcInval: TRect;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if sfPainting in fStateFlags then exit;
|
|
{$ENDIF}
|
|
if Visible and HandleAllocated then
|
|
if (FirstLine = -1) and (LastLine = -1) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
fMarkupHighAll.InvalidateScreenLines(0, LinesInWindow+1);
|
|
{$ENDIF}
|
|
rcInval := ClientRect;
|
|
rcInval.Left := fGutterWidth;
|
|
if sfLinesChanging in fStateFlags then
|
|
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
|
|
else
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end else begin
|
|
{ find the visible lines first }
|
|
if (LastLine < FirstLine) then SwapInt(LastLine, FirstLine);
|
|
FirstLine := Max(FirstLine, TopLine);
|
|
LastLine := Min(LastLine,
|
|
{$IFDEF SYN_LAZARUS}
|
|
ScreenRowToRow(LinesInWindow)
|
|
{$ELSE}
|
|
TopLine + LinesInWindow
|
|
{$ENDIF}
|
|
);
|
|
{ any line visible? }
|
|
if (LastLine >= FirstLine) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
fMarkupHighAll.InvalidateLines(FirstLine, LastLine);
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
rcInval := Rect(fGutterWidth, fTextHeight * RowToScreenRow(FirstLine),
|
|
ClientWidth-ScrollBarWidth,
|
|
fTextHeight * (RowToScreenRow(LastLine)+1));
|
|
{$ELSE}
|
|
rcInval := Rect(fGutterWidth,fTextHeight * (FirstLine - TopLine),
|
|
ClientWidth, fTextHeight * (LastLine - TopLine + 1));
|
|
{$ENDIF}
|
|
if sfLinesChanging in fStateFlags then
|
|
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
|
|
else
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.FindMatchingBracketPair(const PhysCaret: TPoint;
|
|
var StartBracket, EndBracket: TPoint; OnlyVisible: boolean);
|
|
var
|
|
StartLine: string;
|
|
LogCaretXY: TPoint;
|
|
begin
|
|
StartBracket.Y:=-1;
|
|
EndBracket.Y:=-1;
|
|
if (PhysCaret.Y<1) or (PhysCaret.Y>Lines.Count) or (PhysCaret.X<1) then exit;
|
|
StartLine := Lines[PhysCaret.Y - 1];
|
|
LogCaretXY:=PhysicalToLogicalPos(PhysCaret);
|
|
if (length(StartLine)<LogCaretXY.X)
|
|
or (not (StartLine[LogCaretXY.X] in ['(',')','{','}','[',']'])) then exit;
|
|
StartBracket:=PhysCaret;
|
|
EndBracket:=FindMatchingBracket(PhysCaret,false,false,false,OnlyVisible);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.KeyDown(var Key: Word; Shift: TShiftState);
|
|
var
|
|
Data: pointer;
|
|
C: char;
|
|
Cmd: TSynEditorCommand;
|
|
begin
|
|
{$IFDEF VerboseKeys}
|
|
DebugLn('[TCustomSynEdit.KeyDown] ',dbgs(Key),' ',dbgs(Shift));
|
|
{$ENDIF}
|
|
inherited;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fLastControlIsPressed<>(GetKeyShiftState=[ssCtrl]) then
|
|
UpdateCtrlMouse;
|
|
{$ENDIF}
|
|
Data := nil;
|
|
C := #0;
|
|
try
|
|
Cmd := TranslateKeyCode(Key, Shift, Data);
|
|
if Cmd <> ecNone then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=Point(-1,-1);
|
|
{$ENDIF}
|
|
//DebugLn('[TCustomSynEdit.KeyDown] key translated ',cmd);
|
|
Key := 0; // eat it.
|
|
Include(fStateFlags, sfIgnoreNextChar);
|
|
CommandProcessor(Cmd, C, Data);
|
|
end else
|
|
Exclude(fStateFlags, sfIgnoreNextChar);
|
|
finally
|
|
if Data <> nil then
|
|
FreeMem(Data);
|
|
end;
|
|
//DebugLn('[TCustomSynEdit.KeyDown] END ',dbgs(Key),' ',dbgs(Shift));
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
{$IFDEF VerboseKeys}
|
|
DebugLn('[TCustomSynEdit.KeyUp] ',Key
|
|
,' Shift=',ssShift in Shift,' Ctrl=',ssCtrl in Shift,' Alt=',ssAlt in Shift);
|
|
{$ENDIF}
|
|
inherited KeyUp(Key, Shift);
|
|
if fLastControlIsPressed<>(GetKeyShiftState=[ssCtrl]) then
|
|
UpdateCtrlMouse;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
GutterChanged(Self);
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.UTF8KeyPress(var Key: TUTF8Char);
|
|
begin
|
|
// don't fire the event if key is to be ignored
|
|
if not (sfIgnoreNextChar in fStateFlags) then begin
|
|
if Assigned(OnUTF8KeyPress) then OnUTF8KeyPress(Self, Key);
|
|
// The key will be handled in UTFKeyPress always and KeyPress won't be called
|
|
// so we we fire the OnKeyPress here
|
|
if (ord(key[1])< %1100000) and (key[1]<>#0) and Assigned(OnKeyPress) then
|
|
OnKeyPress(Self, Key[1]);
|
|
{$IFDEF VerboseKeyboard}
|
|
DebugLn('TCustomSynEdit.UTF8KeyPress ',DbgSName(Self),' Key="',DbgStr(Key),'" UseUTF8=',dbgs(UseUTF8));
|
|
{$ENDIF}
|
|
CommandProcessor(ecChar, Key, nil);
|
|
end else
|
|
// don't ignore further keys
|
|
Exclude(fStateFlags, sfIgnoreNextChar);
|
|
// Key was handled anyway, so eat it!
|
|
Key:='';
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.KeyPress(var Key: Char);
|
|
begin
|
|
// don't fire the event if key is to be ignored
|
|
if not (sfIgnoreNextChar in fStateFlags) then begin
|
|
{$IFDEF VerboseKeyboard}
|
|
DebugLn('TCustomSynEdit.KeyPress ',DbgSName(Self),' Key="',DbgStr(Key),'" UseUTF8=',dbgs(UseUTF8));
|
|
{$ENDIF}
|
|
if Assigned(OnKeyPress) then OnKeyPress(Self, Key);
|
|
CommandProcessor(ecChar, Key, nil);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// Key was handled anyway, so eat it!
|
|
Key:=#0;
|
|
{$ENDIF}
|
|
end else
|
|
// don't ignore further keys
|
|
Exclude(fStateFlags, sfIgnoreNextChar);
|
|
{$IFDEF SYN_LAZARUS}
|
|
// Key was handled anyway, so eat it!
|
|
// MG: the comment was right, the implementation not consequent enough
|
|
Key:=#0;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomSynEdit.LeftSpaces(const Line: string): Integer;
|
|
begin
|
|
Result:=LeftSpaces(Line,false);
|
|
end;
|
|
|
|
function TCustomSynEdit.LeftSpaces(const Line: string;
|
|
Physical: boolean): Integer;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
p := pointer(Line);
|
|
if Assigned(p) and (eoAutoIndent in fOptions) then begin
|
|
Result := 0;
|
|
while p^ in [#1..#32] do begin
|
|
Inc(p);
|
|
Inc(Result);
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Physical and (Result>0) then
|
|
Result:=LogicalToPhysicalCol(Line,Result+1)-1;
|
|
{$ENDIF}
|
|
end else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.LinesChanging(Sender: TObject);
|
|
begin
|
|
Include(fStateFlags, sfLinesChanging);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.LinesChanged(Sender: TObject);
|
|
begin
|
|
Exclude(fStateFlags, sfLinesChanging);
|
|
if HandleAllocated then begin
|
|
UpdateScrollBars;
|
|
SetBlockBegin({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
InvalidateRect(Handle, @fInvalidateRect, False);
|
|
FillChar(fInvalidateRect, SizeOf(TRect), 0);
|
|
if fGutter.ShowLineNumbers and fGutter.AutoSize then
|
|
fGutter.AutoSizeDigitCount(Lines.Count);
|
|
if not (eoScrollPastEof in Options) then
|
|
TopLine := TopLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
bWasSel: boolean;
|
|
bStartDrag: boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
PrimarySelText: string;
|
|
LogCaretXY: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
//DebugLn('TCustomSynEdit.MouseDown START Mouse=',X,',',Y,' Caret=',CaretX,',',CaretY,', BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (X>=ClientWidth-ScrollBarWidth) or (Y>=ClientHeight-ScrollBarWidth) then
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
exit;
|
|
end;
|
|
LastMouseCaret:=PixelsToRowColumn(Point(X,Y));
|
|
fMouseDownX := X;
|
|
fMouseDownY := Y;
|
|
{$ENDIF}
|
|
Exclude(fStateFlags, sfPossibleGutterClick);
|
|
if (Button = mbRight) and SelAvail then //lt 2000-10-12
|
|
exit;
|
|
bWasSel := false;
|
|
bStartDrag := FALSE;
|
|
if Button = mbLeft then begin
|
|
if ssDouble in Shift then Exit;
|
|
if SelAvail then begin
|
|
//remember selection state, as it will be cleared later
|
|
bWasSel := true;
|
|
end;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Button=mbMiddle then begin
|
|
if ssDouble in Shift then Exit;
|
|
PrimarySelText:=PrimarySelection.AsText;
|
|
end;
|
|
{$ENDIF}
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
ComputeCaret(X, Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
{$ENDIF}
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
if Button = mbLeft then begin
|
|
//DebugLn('TCustomSynEdit.MouseDown ',DbgSName(Self),' START CAPTURE');
|
|
MouseCapture := True;
|
|
//if mousedown occured in selected block then begin drag operation
|
|
Exclude(fStateFlags, sfWaitForDragging);
|
|
if bWasSel and (eoDragDropEditing in fOptions) and (X >= fGutterWidth + 2)
|
|
and (SelectionMode = smNormal)
|
|
and IsPointInSelection({$IFDEF SYN_LAZARUS}LogCaretXY{$ELSE}CaretXY{$ENDIF})
|
|
then
|
|
bStartDrag := TRUE;
|
|
//debugln('TCustomSynEdit.MouseDown bStartDrag=',dbgs(bStartDrag),' MouseCapture=',dbgs(MouseCapture));
|
|
end;
|
|
if (Button = mbLeft) and bStartDrag then
|
|
Include(fStateFlags, sfWaitForDragging)
|
|
else begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if ((Button=mbLeft)
|
|
or ((eoRightMouseMovesCursor in Options) and (Button=mbRight)))
|
|
and ([sfDblClicked,sfTripleClicked,sfQuadClicked]*fStateFlags=[])
|
|
{$ELSE}
|
|
if (sfDblClicked in fStateFlags)
|
|
{$ENDIF}
|
|
then begin
|
|
if ssShift in Shift then
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}LogCaretXY
|
|
{$ELSE}CaretXY{$ENDIF})
|
|
else begin
|
|
SetBlockBegin({$IFDEF SYN_LAZARUS}LogCaretXY
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
{begin} //mh 2000-11-20
|
|
if (eoAltSetsColumnMode in Options) and (SelectionMode <> smLine) then
|
|
begin
|
|
if ssAlt in Shift then
|
|
SelectionMode := smColumn
|
|
else
|
|
SelectionMode := smNormal;
|
|
end;
|
|
{end} //mh 2000-11-20
|
|
end;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (Button=mbMiddle)
|
|
and ([sfDblClicked,sfTripleClicked,sfQuadClicked]*fStateFlags=[])
|
|
and ((PrimarySelText<>'') or SelAvail)
|
|
then begin
|
|
fBlockBegin := LogCaretXY;
|
|
fBlockEnd := LogCaretXY;
|
|
//debugln('TCustomSynEdit.MouseDown Old SelText="',DbgStr(SelText),'" fBlockBegin=',dbgs(fBlockBegin),' fBlockEnd=',dbgs(fBlockEnd),' LogCaretXY=',dbgs(LogCaretXY));
|
|
SelText:=PrimarySelText;
|
|
//debugln('TCustomSynEdit.MouseDown New SelText="',DbgStr(SelText),'" fBlockBegin=',dbgs(fBlockBegin),' fBlockEnd=',dbgs(fBlockEnd),' LogCaretXY=',dbgs(LogCaretXY));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (X < fGutterWidth) and (Button=mbLeft) then begin
|
|
Include(fStateFlags, sfPossibleGutterClick);
|
|
DoOnGutterClick(X, Y);
|
|
end;
|
|
LCLIntf.SetFocus(Handle);
|
|
UpdateCaret;
|
|
{$ELSE}
|
|
if (fMouseDownX < fGutterWidth) then
|
|
Include(fStateFlags, sfPossibleGutterClick);
|
|
Windows.SetFocus(Handle);
|
|
{$ENDIF}
|
|
//debugln('TCustomSynEdit.MouseDown END sfWaitForDragging=',dbgs(sfWaitForDragging in fStateFlags),' ');
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Z: integer;
|
|
begin
|
|
inherited MouseMove(Shift, x, y);
|
|
|
|
if (X >= fGutterWidth)
|
|
and (X < ClientWidth{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF})
|
|
and (Y >= 0)
|
|
and (Y < ClientHeight{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF})
|
|
then begin
|
|
if (Cursor <> crHandPoint) or (not (ssCtrl in Shift)) then
|
|
Cursor := crIBeam;
|
|
end
|
|
else
|
|
Cursor := crDefault;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=PixelsToRowColumn(Point(X,Y));
|
|
{$ENDIF}
|
|
|
|
//debugln('TCustomSynEdit.MouseMove sfWaitForDragging=',dbgs(sfWaitForDragging in fStateFlags),' MouseCapture=',dbgs(MouseCapture),' GetCaptureControl=',DbgSName(GetCaptureControl));
|
|
if MouseCapture
|
|
and (sfWaitForDragging in fStateFlags) then begin
|
|
if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG))
|
|
or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG))
|
|
then begin
|
|
Exclude(fStateFlags, sfWaitForDragging);
|
|
{$IFDEF SYN_LAZARUS}
|
|
Include(fStateFlags, sfIsDragging);
|
|
{$ENDIF}
|
|
//debugln('TCustomSynEdit.MouseMove BeginDrag');
|
|
BeginDrag({$IFDEF SYN_LAZARUS}true{$ELSE}false{$ENDIF});
|
|
end;
|
|
end else if (ssLeft in Shift)
|
|
and MouseCapture
|
|
then begin
|
|
//DebugLn(' TCustomSynEdit.MouseMove CAPTURE Mouse=',dbgs(X),',',dbgs(Y),' Caret=',dbgs(CaretXY),', BlockBegin=',dbgs(BlockBegin),' BlockEnd=',dbgs(BlockEnd));
|
|
if (X >= fGutterWidth)
|
|
and (X < ClientWidth{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF})
|
|
and (Y >= 0)
|
|
and (Y < ClientHeight{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF})
|
|
then
|
|
ComputeCaret(X, Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (not(sfIsDragging in fStateFlags))
|
|
then
|
|
{$ENDIF}
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
// should we begin scrolling?
|
|
Dec(X, fGutterWidth);
|
|
// calculate chars past right
|
|
Z := X - (fCharsInWindow * fCharWidth);
|
|
if Z > 0 then
|
|
Inc(Z, fCharWidth);
|
|
fScrollDeltaX := Max(Z div fCharWidth, 0);
|
|
if fScrollDeltaX = 0 then begin
|
|
// calculate chars past left
|
|
Z := X;
|
|
if Z < 0 then
|
|
Dec(Z, fCharWidth);
|
|
fScrollDeltaX := Min(Z div fCharWidth, 0);
|
|
end;
|
|
// calculate lines past bottom
|
|
Z := Y - (fLinesInWindow * fTextHeight);
|
|
if Z > 0 then
|
|
Inc(Z, fTextHeight);
|
|
fScrollDeltaY := Max(Z div fTextHeight, 0);
|
|
if fScrollDeltaY = 0 then begin
|
|
// calculate lines past top
|
|
Z := Y;
|
|
if Z < 0 then
|
|
Dec(Z, fTextHeight);
|
|
fScrollDeltaY := Min(Z div fTextHeight, 0);
|
|
end;
|
|
fScrollTimer.Enabled := (fScrollDeltaX <> 0) or (fScrollDeltaY <> 0);
|
|
{$IFDEF SYN_LAZARUS}
|
|
end else if MouseCapture
|
|
and (not(sfIsDragging in fStateFlags))
|
|
then begin
|
|
MouseCapture:=false;
|
|
fScrollTimer.Enabled := False;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ScrollTimerHandler(Sender: TObject);
|
|
var
|
|
C: TPoint;
|
|
{$IFDEF SYN_LAZARUS}
|
|
CurMousePos: TPoint;
|
|
Z: integer;
|
|
{$ENDIF}
|
|
X, Y: Integer;
|
|
begin
|
|
{$IFNDEF SYN_LAZARUS}
|
|
GetCursorPos(C);
|
|
C := PixelsToRowColumn(ScreenToClient(C));
|
|
{$ENDIF}
|
|
// changes to line / column in one go
|
|
IncPaintLock;
|
|
try
|
|
{$IFDEF SYN_LAZARUS}
|
|
GetCursorPos(CurMousePos);
|
|
CurMousePos:=ScreenToClient(CurMousePos);
|
|
C := PixelsToLogicalPos(CurMousePos);
|
|
// recalculate scroll deltas
|
|
Dec(CurMousePos.X, fGutterWidth);
|
|
// calculate chars past right
|
|
Z := CurMousePos.X - (fCharsInWindow * fCharWidth);
|
|
if Z > 0 then
|
|
Inc(Z, fCharWidth);
|
|
fScrollDeltaX := Max(Z div fCharWidth, 0);
|
|
if fScrollDeltaX = 0 then begin
|
|
// calculate chars past left
|
|
Z := CurMousePos.X;
|
|
if Z < 0 then
|
|
Dec(Z, fCharWidth);
|
|
fScrollDeltaX := Min(Z div fCharWidth, 0);
|
|
end;
|
|
// calculate lines past bottom
|
|
Z := CurMousePos.Y - (fLinesInWindow * fTextHeight);
|
|
if Z > 0 then
|
|
Inc(Z, fTextHeight);
|
|
fScrollDeltaY := Max(Z div fTextHeight, 0);
|
|
if fScrollDeltaY = 0 then begin
|
|
// calculate lines past top
|
|
Z := CurMousePos.Y;
|
|
if Z < 0 then
|
|
Dec(Z, fTextHeight);
|
|
fScrollDeltaY := Min(Z div fTextHeight, 0);
|
|
end;
|
|
fScrollTimer.Enabled := (fScrollDeltaX <> 0) or (fScrollDeltaY <> 0);
|
|
// now scroll
|
|
{$ENDIF}
|
|
if fScrollDeltaX <> 0 then begin
|
|
LeftChar := LeftChar + fScrollDeltaX;
|
|
X := LeftChar;
|
|
if fScrollDeltaX > 0 then // scrolling right?
|
|
Inc(X, CharsInWindow);
|
|
CaretXY := Point(X, C.Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (not(sfIsDragging in fStateFlags))
|
|
then
|
|
{$ENDIF}
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
end;
|
|
if fScrollDeltaY <> 0 then begin
|
|
if GetKeyState(VK_SHIFT) < 0 then
|
|
TopLine := TopLine + fScrollDeltaY * LinesInWindow
|
|
else
|
|
TopLine := TopLine + fScrollDeltaY;
|
|
Y := TopLine;
|
|
if fScrollDeltaY > 0 then // scrolling down?
|
|
Inc(Y, LinesInWindow - 1);
|
|
CaretXY := Point(C.X, Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (not(sfIsDragging in fStateFlags))
|
|
then
|
|
{$ENDIF}
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
end;
|
|
finally
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
var
|
|
wasDragging : Boolean;
|
|
{$ENDIF}
|
|
begin
|
|
//DebugLn('TCustomSynEdit.MouseUp Mouse=',X,',',Y,' Caret=',CaretX,',',CaretY,', BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
|
|
{$IFDEF SYN_LAZARUS}
|
|
wasDragging := (sfIsDragging in fStateFlags);
|
|
Exclude(fStateFlags, sfIsDragging);
|
|
{$ENDIF}
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
|
|
fScrollTimer.Enabled := False;
|
|
{$IFDEF SYN_LAZARUS}
|
|
MouseCapture := False;
|
|
if (X>=ClientWidth-ScrollBarWidth) or (Y>=ClientHeight-ScrollBarWidth) then
|
|
begin
|
|
exit;
|
|
end;
|
|
LastMouseCaret:=PixelsToRowColumn(Point(X,Y));
|
|
{$ENDIF}
|
|
if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu) then
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
fStateFlags:=fStateFlags-[sfDblClicked,sfTripleClicked,sfQuadClicked,
|
|
sfPossibleGutterClick];
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
MouseCapture := False;
|
|
if (sfPossibleGutterClick in fStateFlags) and (X < fGutterWidth)
|
|
{$IFDEF SYN_LAZARUS}and (Button = mbLeft){$ENDIF} then
|
|
begin
|
|
{$IFNDEF SYN_LAZARUS}
|
|
DoOnGutterClick(X, Y);
|
|
{$ENDIF}
|
|
end else
|
|
if fStateFlags * [sfDblClicked,
|
|
{$IFDEF SYN_LAZARUS}sfTripleClicked,sfQuadClicked,{$ENDIF}
|
|
sfWaitForDragging] = [sfWaitForDragging] then
|
|
begin
|
|
ComputeCaret(X, Y);
|
|
SetBlockBegin({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
Exclude(fStateFlags, sfWaitForDragging);
|
|
end;
|
|
if (Button=mbLeft)
|
|
and (fStateFlags * [sfWaitForDragging] = []) then
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
AquirePrimarySelection;
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fStateFlags:=fStateFlags-[sfDblClicked,sfTripleClicked,sfQuadClicked,
|
|
sfPossibleGutterClick];
|
|
{$ELSE}
|
|
Exclude(fStateFlags, sfDblClicked);
|
|
Exclude(fStateFlags, sfPossibleGutterClick);
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoShowCtrlMouseLinks in Options)
|
|
and not(wasDragging)
|
|
and (Button=mbLeft) and (ssCtrl in Shift)
|
|
and assigned(FOnClickLink)
|
|
then begin
|
|
FOnClickLink(Self, Button, Shift, X,Y);;
|
|
end;
|
|
{$ENDIF}
|
|
//DebugLn('TCustomSynEdit.MouseUp END Mouse=',X,',',Y,' Caret=',CaretX,',',CaretY,', BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoOnGutterClick(X, Y: integer);
|
|
var
|
|
i : integer;
|
|
offs : integer;
|
|
line : integer;
|
|
allmrk: TSynEditMarks;
|
|
mark : TSynEditMark;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
line := PixelsToRowColumn(Point(X, Y)).Y;
|
|
//debugln('TCustomSynEdit.DoOnGutterClick A ',dbgs(line));
|
|
if line <= Lines.Count then begin
|
|
mark := nil;
|
|
if Gutter.ShowCodeFolding and (X<Gutter.CodeFoldingWidth) then begin
|
|
CodeFoldAction(line);
|
|
end else begin
|
|
Marks.GetMarksForLine(line, allmrk);
|
|
offs := 0;
|
|
for i := 1 to maxMarks do begin
|
|
if assigned(allmrk[i]) then begin
|
|
Inc(offs, BookMarkOptions.XOffset);
|
|
if X < offs then begin
|
|
mark := allmrk[i];
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if Assigned(fOnGutterClick) then begin
|
|
// for compatibility invoke this only on the markable area
|
|
fOnGutterClick(Self, X, Y, line, mark);
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
if Assigned(fOnGutterClick) then begin
|
|
line := PixelsToRowColumn(Point(X, Y)).Y;
|
|
if line <= Lines.Count then begin
|
|
mark := nil;
|
|
Marks.GetMarksForLine(line, allmrk);
|
|
offs := 0;
|
|
mark := nil;
|
|
for i := 1 to maxMarks do begin
|
|
if assigned(allmrk[i]) then begin
|
|
Inc(offs, BookMarkOptions.XOffset);
|
|
if X < offs then begin
|
|
mark := allmrk[i];
|
|
break;
|
|
end;
|
|
end;
|
|
end; //for
|
|
fOnGutterClick(Self, X, Y, line, mark);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.Paint;
|
|
var
|
|
rcClip, rcDraw: TRect;
|
|
nL1, nL2, nC1, nC2: integer;
|
|
begin
|
|
// Get the invalidated rect. Compute the invalid area in lines / columns.
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$IFDEF EnableDoubleBuf}
|
|
//rcClip:=Rect(0,0,ClientWidth,ClientHeight);
|
|
rcClip := Canvas.ClipRect;
|
|
StartPaintBuffer(rcClip);
|
|
{$ELSE}
|
|
rcClip := Canvas.ClipRect;
|
|
//DebugLn(['TCustomSynEdit.Paint rcClip=',dbgs(rcClip)]);
|
|
{$ENDIF}
|
|
Include(fStateFlags,sfPainting);
|
|
{$ELSE}
|
|
rcClip := Canvas.ClipRect;
|
|
{$ENDIF}
|
|
// columns
|
|
nC1 := LeftChar;
|
|
if (rcClip.Left > fGutterWidth + 2) then
|
|
Inc(nC1, (rcClip.Left - fGutterWidth - 2) div CharWidth);
|
|
nC2 := {$IFDEF SYN_LAZARUS}LeftChar{$ELSE}nC1{$ENDIF} +
|
|
(rcClip.Right - fGutterWidth - 2 + CharWidth - 1) div CharWidth;
|
|
// lines
|
|
nL1 := Max({$IFDEF SYN_LAZARUS}
|
|
ScreenRowToRow(rcClip.Top div fTextHeight)
|
|
{$ELSE}
|
|
TopLine + rcClip.Top div fTextHeight
|
|
{$ENDIF},
|
|
TopLine);
|
|
nL2 := Min({$IFDEF SYN_LAZARUS}
|
|
ScreenRowToRow((rcClip.Bottom-1) div fTextHeight),
|
|
{$ELSE}
|
|
TopLine + (rcClip.Bottom + fTextHeight - 1) div fTextHeight,
|
|
{$ENDIF}
|
|
Lines.Count);
|
|
//DebugLn('TCustomSynEdit.Paint LinesInWindow=',dbgs(LinesInWindow),' nL1=',dbgs(nL1),' nL2=',dbgs(nL2));
|
|
// Now paint everything while the caret is hidden.
|
|
HideCaret;
|
|
try
|
|
// First paint the gutter area if it was (partly) invalidated.
|
|
if (rcClip.Left < fGutterWidth) then begin
|
|
rcDraw := rcClip;
|
|
rcDraw.Right := fGutterWidth;
|
|
PaintGutter(rcDraw, nL1, nL2);
|
|
end;
|
|
// Then paint the text area if it was (partly) invalidated.
|
|
if (rcClip.Right > fGutterWidth) then begin
|
|
rcDraw := rcClip;
|
|
rcDraw.Left := Max(rcDraw.Left, fGutterWidth);
|
|
PaintTextLines(rcDraw, nL1, nL2, nC1, nC2);
|
|
end;
|
|
PluginsAfterPaint(Canvas, rcDraw, nL1, nL2);
|
|
// If there is a custom paint handler call it.
|
|
DoOnPaint;
|
|
finally
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$IFDEF EnableDoubleBuf}
|
|
EndPaintBuffer(rcClip);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
UpdateCaret;
|
|
{$IFDEF SYN_LAZARUS}
|
|
Exclude(fStateFlags,sfPainting);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.CodeFoldAction(iLine: integer);
|
|
// iLine is 1 based as parameter
|
|
// and 0 based in the procedure below
|
|
|
|
procedure UpdateFolded(var iLine: integer);
|
|
var
|
|
FoldType: TSynEditCodeFoldType;
|
|
Level: LongInt;
|
|
CurFoldType: TSynEditCodeFoldType;
|
|
SLines: TSynEditStringList;
|
|
begin
|
|
SLines:=TSynEditStringList(fLines);
|
|
FoldType:=SLines.FoldType[iLine];
|
|
Level:=SLines.FoldEndLevel[iLine];
|
|
if FoldType=cfCollapsed then begin
|
|
// fold all lines including sub blocks
|
|
inc(iLine);
|
|
while (iLine<Lines.Count)
|
|
and (SLines.FoldMinLevel[iLine]>=Level) do begin
|
|
//debugln('UpdateFolded Fold ',dbgs(iLine),' ',Lines[iLine]);
|
|
SLines.Folded[iLine]:=true;
|
|
inc(iLine);
|
|
end;
|
|
// fold last line of block
|
|
if (iLine<Lines.Count)
|
|
and (SLines.FoldType[iLine]=cfEnd) then begin
|
|
//debugln('UpdateFolded Fold END ',dbgs(iLine),' ',Lines[iLine]);
|
|
SLines.Folded[iLine]:=true;
|
|
inc(iLine);
|
|
end;
|
|
end else if FoldType=cfExpanded then begin
|
|
// expand all lines of this block and all sub expanded blocks
|
|
// sub blocks, that are collapsed, remain collapsed
|
|
inc(iLine);
|
|
while (iLine<Lines.Count)
|
|
and (SLines.FoldMinLevel[iLine]>=Level) do begin
|
|
//debugln('UpdateFolded Expand ',dbgs(iLine),' ',Lines[iLine]);
|
|
SLines.Folded[iLine]:=false;
|
|
CurFoldType:=SLines.FoldType[iLine];
|
|
if CurFoldType in [cfExpanded,cfCollapsed] then
|
|
UpdateFolded(iLine)
|
|
else
|
|
inc(iLine);
|
|
end;
|
|
// expand last line of block
|
|
if (iLine<Lines.Count)
|
|
and (SLines.FoldType[iLine]=cfEnd) then begin
|
|
//debugln('UpdateFolded Expand END ',dbgs(iLine),' ',Lines[iLine]);
|
|
SLines.Folded[iLine]:=false;
|
|
inc(iLine);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
FoldType: TSynEditCodeFoldType;
|
|
begin
|
|
if (iLine<=0) or (iLine>Lines.Count) then exit;
|
|
dec(iLine);
|
|
FoldType:=TSynEditStringList(fLines).FoldType[iLine];
|
|
//debugln('TCustomSynEdit.CodeFoldAction A ',dbgs(iLine),' ',dbgs(ord(FoldType)));
|
|
if FoldType in [cfExpanded,cfCollapsed] then begin
|
|
if FoldType=cfExpanded then begin
|
|
// collapse the branch
|
|
FoldType:=cfCollapsed;
|
|
//debugln('collapsing node: ',dbgs(iLine));
|
|
end else begin
|
|
// expand the branch
|
|
//debugln('expanding node: ',dbgs(iLine));
|
|
FoldType:=cfExpanded;
|
|
end;
|
|
//DebugLn(['TCustomSynEdit.CodeFoldAction iLine=',iLine]);
|
|
TSynEditStringList(fLines).FoldType[iLine] := FoldType;
|
|
UpdateFolded(iLine);
|
|
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.FindNextUnfoldedLine(iLine: integer; Down: boolean
|
|
): Integer;
|
|
// iLine is 1 based
|
|
begin
|
|
Result:=iLine;
|
|
while (Result>0) and (Result<=Lines.Count)
|
|
and (TSynEditStringList(fLines).Folded[Result-1]) do
|
|
if Down then inc(Result) else dec(Result);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UnfoldAll;
|
|
var
|
|
SLines: TSynEditStringList;
|
|
i: Integer;
|
|
begin
|
|
SLines:=TSynEditStringList(Lines);
|
|
for i:=0 to SLines.Count-1 do
|
|
SLines.Folded[i]:=false;
|
|
Invalidate;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.PaintGutter(AClip: TRect; FirstLine, LastLine: integer);
|
|
var
|
|
i, iLine: integer;
|
|
rcLine: TRect;
|
|
bHasOtherMarks: boolean;
|
|
aGutterOffs: PIntArray;
|
|
s: string;
|
|
dc: HDC;
|
|
rcCodeFold: TRect;
|
|
tmp: TSynEditCodeFoldType;
|
|
CodeFoldOffset: Integer;
|
|
|
|
procedure DrawMark(iMark: integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
var
|
|
iLine: integer;
|
|
itop : Longint;
|
|
CurMark: TSynEditMark;
|
|
begin
|
|
iTop := 0;
|
|
CurMark:=Marks[iMark];
|
|
if (CurMark.Line>LastLine) or (CurMark.Line<FirstLine)
|
|
or (CurMark.Line<1) or (CurMark.Line>Lines.Count) then
|
|
exit;
|
|
if TSynEditStringList(fLines).Folded[CurMark.Line-1] then
|
|
exit;
|
|
iLine := RowToScreenRow(CurMark.Line);
|
|
|
|
if Assigned(fBookMarkOpt.BookmarkImages) and not CurMark.InternalImage
|
|
then begin
|
|
if (CurMark.ImageIndex <= fBookMarkOpt.BookmarkImages.Count) then begin
|
|
if CurMark.IsBookmark = BookMarkOptions.DrawBookmarksFirst then
|
|
aGutterOffs^[iLine] := CodeFoldOffset
|
|
else if aGutterOffs^[iLine] = 0 then
|
|
aGutterOffs^[iLine] := fBookMarkOpt.BookmarkImages.Width + CodeFoldOffset;
|
|
if fTextHeight > fBookMarkOpt.BookmarkImages.Height then
|
|
iTop := (fTextHeight - fBookMarkOpt.BookmarkImages.Height) div 2;
|
|
with fBookMarkOpt do
|
|
BookmarkImages.Draw(Canvas, LeftMargin + aGutterOffs^[iLine],
|
|
iTop + iLine * fTextHeight, CurMark.ImageIndex,true);
|
|
|
|
Inc(aGutterOffs^[iLine], fBookMarkOpt.BookmarkImages.Width);
|
|
end;
|
|
end else
|
|
begin
|
|
if CurMark.ImageIndex in [0..9] then begin
|
|
if not Assigned(fInternalImage) then begin
|
|
fInternalImage := TSynInternalImage.Create('SynEditInternalImages',10);
|
|
end;
|
|
if (aGutterOffs^[iLine]=0) and Gutter.ShowCodeFolding then
|
|
aGutterOffs^[iLine]:=Gutter.CodeFoldingWidth;
|
|
fInternalImage.DrawMark(Canvas, CurMark.ImageIndex,
|
|
fBookMarkOpt.LeftMargin + aGutterOffs^[iLine], iLine * fTextHeight,
|
|
fTextHeight);
|
|
Inc(aGutterOffs^[iLine], fBookMarkOpt.Xoffset);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ELSE below: not SYN_LAZARUS}
|
|
var
|
|
iLine: integer;
|
|
itop : Longint;
|
|
begin
|
|
iTop := 0;
|
|
if Assigned(fBookMarkOpt.BookmarkImages) and not Marks[i].InternalImage
|
|
then begin
|
|
if Marks[iMark].ImageIndex <= fBookMarkOpt.BookmarkImages.Count then begin
|
|
iLine := Marks[iMark].Line - TopLine;
|
|
// if Marks[iMark].IsBookmark then
|
|
if Marks[iMark].IsBookmark = BookMarkOptions.DrawBookmarksFirst then //mh 2000-10-12
|
|
aGutterOffs^[iLine] := 0
|
|
else if aGutterOffs^[iLine] = 0 then
|
|
aGutterOffs^[iLine] := fBookMarkOpt.XOffset;
|
|
If fTextHeight > fBookMarkOpt.BookmarkImages.Height then
|
|
iTop := (fTextHeight - fBookMarkOpt.BookmarkImages.Height) div 2;
|
|
with fBookMarkOpt do
|
|
if not TSynEditStringList(fLines).Folded[iLine] then
|
|
BookmarkImages.Draw(Canvas, LeftMargin + aGutterOffs^[iLine], iTop + iLine * fTextHeight, Marks[iMark].ImageIndex,true);
|
|
|
|
Inc(aGutterOffs^[iLine], fBookMarkOpt.XOffset);
|
|
end;
|
|
end else
|
|
begin
|
|
if Marks[iMark].ImageIndex in [0..9] then begin
|
|
iLine := Marks[iMark].Line - TopLine;
|
|
if not Assigned(fInternalImage) then begin
|
|
fInternalImage := TSynInternalImage.Create('SynEditInternalImages',
|
|
10);
|
|
end;
|
|
fInternalImage.DrawMark(Canvas, Marks[iMark].ImageIndex, fBookMarkOpt.LeftMargin + aGutterOffs^[iLine], iLine * fTextHeight, fTextHeight);
|
|
Inc(aGutterOffs^[iLine], fBookMarkOpt.XOffset);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure DrawNodeBox(rcCodeFold: TRect; Collapsed: boolean);
|
|
const cNodeOffset = 3;
|
|
var
|
|
rcNode: TRect;
|
|
ptCenter : TPoint;
|
|
iSquare: integer;
|
|
begin
|
|
//center of the draw area
|
|
ptCenter.X := (rcCodeFold.Left + rcCodeFold.Right) div 2;
|
|
ptCenter.Y := (rcCodeFold.Top + rcCodeFold.Bottom) div 2;
|
|
|
|
//make node rect square
|
|
iSquare := Max(0, rcCodeFold.Bottom - rcCodeFold.Top - 14) div 2;
|
|
|
|
//area of drawbox
|
|
rcNode.Right := rcCodeFold.Right - cNodeOffset + 1;
|
|
rcNode.Left := rcCodeFold.Left + cNodeOffset;
|
|
rcNode.Top := rcCodeFold.Top + cNodeOffset + iSquare;
|
|
rcNode.Bottom := rcCodeFold.Bottom - cNodeOffset - iSquare + 1;
|
|
|
|
Canvas.Brush.Color:=clWhite;
|
|
Canvas.Rectangle(rcNode);
|
|
|
|
//draw bottom handle to paragraph line
|
|
Canvas.MoveTo((rcNode.Left + rcNode.Right) div 2, rcNode.Bottom);
|
|
Canvas.LineTo((rcNode.Left + rcNode.Right) div 2, rcCodeFold.Bottom);
|
|
|
|
//draw unfolded sign in node box
|
|
Canvas.MoveTo(ptCenter.X - 2, ptCenter.Y);
|
|
Canvas.LineTo(ptCenter.X + 3, ptCenter.Y);
|
|
|
|
//draw folded sign
|
|
if Collapsed then
|
|
begin
|
|
Canvas.MoveTo(ptCenter.X, ptCenter.Y - 2);
|
|
Canvas.LineTo(ptCenter.X, ptCenter.Y + 3);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawParagraphContinue(rcCodeFold: TRect);
|
|
var
|
|
iCenter : integer;
|
|
begin
|
|
//center of the draw area
|
|
iCenter := (rcCodeFold.Left + rcCodeFold.Right) div 2;
|
|
|
|
Canvas.MoveTo(iCenter, rcCodeFold.Top);
|
|
Canvas.LineTo(iCenter, rcCodeFold.Bottom);
|
|
end;
|
|
|
|
procedure DrawParagraphEnd(rcCodeFold: TRect);
|
|
var
|
|
ptCenter : TPoint;
|
|
begin
|
|
//center of the draw area
|
|
ptCenter.X := (rcCodeFold.Left + rcCodeFold.Right) div 2;
|
|
ptCenter.Y := (rcCodeFold.Top + rcCodeFold.Bottom) div 2;
|
|
|
|
Canvas.MoveTo(ptCenter.X, rcCodeFold.Top);
|
|
Canvas.LineTo(ptCenter.X, ptCenter.Y);
|
|
Canvas.LineTo(rcCodeFold.Right, ptCenter.Y);
|
|
end;
|
|
|
|
begin
|
|
if (FirstLine = 1) and (LastLine = 0) then
|
|
LastLine := 1;
|
|
// Changed to use fTextDrawer.BeginDrawing and fTextDrawer.EndDrawing only
|
|
// when absolutely necessary. Note: Never change brush / pen / font of the
|
|
// canvas inside of this block (only through methods of fTextDrawer)!
|
|
Canvas.Brush.Color := Gutter.Color;
|
|
// If we have to draw the line numbers then we don't want to erase
|
|
// the background first. Do it line by line with TextRect instead
|
|
// and fill only the area after the last visible line.
|
|
dc := Canvas.Handle;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LCLIntf.SetBkColor(dc,Canvas.Brush.Color);
|
|
if Gutter.ShowCodeFolding then
|
|
CodeFoldOffset:=Gutter.CodeFoldingWidth
|
|
else
|
|
CodeFoldOffset:=0;
|
|
{$ENDIF}
|
|
if fGutter.ShowLineNumbers then begin
|
|
fTextDrawer.BeginDrawing(dc);
|
|
try
|
|
fTextDrawer.SetBackColor(fGutter.Color);
|
|
fTextDrawer.SetForeColor(Self.Font.Color);
|
|
if fGutter.UseFontStyle then
|
|
fTextDrawer.Style := Font.Style
|
|
else
|
|
fTextDrawer.Style := [];
|
|
// prepare the rect initially
|
|
rcLine := AClip;
|
|
rcLine.Right := fGutterWidth - 2;
|
|
//rcLine.Right := Max(rcLine.Right, fGutterWidth - 2);
|
|
rcLine.Bottom := RowToScreenRow(FirstLine) * fTextHeight;
|
|
for iLine := FirstLine to LastLine do begin
|
|
// next line rect
|
|
rcLine.Top := rcLine.Bottom;
|
|
// erase the background and draw the line number string in one go
|
|
{$IFDEF SYN_LAZARUS}
|
|
if not TSynEditStringList(fLines).Folded[iLine-1] then begin
|
|
s := fGutter.FormatLineNumber(iLine);
|
|
Inc(rcLine.Bottom, fTextHeight);
|
|
fTextDrawer.ExtTextOut(CodeFoldOffset+fGutter.LeftOffset,
|
|
rcLine.Top, ETO_OPAQUE,rcLine,PChar(Pointer(S)),Length(S));
|
|
end;
|
|
{$ELSE}
|
|
s := fGutter.FormatLineNumber(iLine);
|
|
Inc(rcLine.Bottom, fTextHeight);
|
|
Windows.ExtTextOut(DC, fGutter.LeftOffset, rcLine.Top, ETO_OPAQUE,
|
|
@rcLine, PChar(s), Length(s), nil);
|
|
{$ENDIF}
|
|
end;
|
|
// now erase the remaining area if any
|
|
if AClip.Bottom > rcLine.Bottom then begin
|
|
rcLine.Top := rcLine.Bottom;
|
|
rcLine.Bottom := AClip.Bottom;
|
|
with rcLine do
|
|
fTextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcLine, nil, 0);
|
|
end;
|
|
finally
|
|
fTextDrawer.EndDrawing;
|
|
end;
|
|
end else begin
|
|
InternalFillRect(dc, AClip);
|
|
end;
|
|
|
|
//draw the code folding marks
|
|
if fGutter.ShowCodeFolding then
|
|
begin
|
|
with Canvas do
|
|
begin
|
|
Pen.Color := clDkGray;
|
|
Pen.Width := 1;
|
|
|
|
rcLine.Bottom := RowToScreenRow(FirstLine) * fTextHeight;
|
|
for iLine := FirstLine to LastLine do
|
|
begin
|
|
//only draw visible items
|
|
if not TSynEditStringList(fLines).Folded[iLine-1] then
|
|
begin
|
|
// next line rect
|
|
rcLine.Top := rcLine.Bottom;
|
|
|
|
Inc(rcLine.Bottom, fTextHeight);
|
|
|
|
rcCodeFold.Left := 0;
|
|
rcCodeFold.Right := 14;
|
|
rcCodeFold.Top := rcLine.Top;
|
|
rcCodeFold.Bottom := rcLine.Bottom;
|
|
|
|
tmp := TSynEditStringList(fLines).FoldType[iLine-1];
|
|
|
|
case tmp of
|
|
cfCollapsed: DrawNodeBox(rcCodeFold, True);
|
|
cfExpanded: DrawNodeBox(rcCodeFold, False);
|
|
cfContinue: DrawParagraphContinue(rcCodeFold);
|
|
cfEnd: DrawParagraphEnd(rcCodeFold);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// the gutter separator if visible
|
|
if AClip.Right >= fGutterWidth - 2 then
|
|
with Canvas do begin
|
|
Pen.Color := {$IFDEF SYN_LAZARUS}clWhite{$ELSE}clBtnHighlight{$ENDIF};
|
|
Pen.Width := 1;
|
|
with AClip do begin
|
|
MoveTo(fGutterWidth - 2, Top);
|
|
LineTo(fGutterWidth - 2, Bottom);
|
|
Pen.Color := {$IFDEF SYN_LAZARUS}clDkGray{$ELSE}clBtnShadow{$ENDIF};
|
|
MoveTo(fGutterWidth - 1, Top);
|
|
LineTo(fGutterWidth - 1, Bottom);
|
|
end;
|
|
end;
|
|
// now the gutter marks
|
|
if BookMarkOptions.GlyphsVisible and (Marks.Count > 0)
|
|
and (LastLine >= FirstLine)
|
|
then begin
|
|
aGutterOffs := AllocMem((LastLine - TopLine + 1) * SizeOf(integer));
|
|
try
|
|
// Instead of making a two pass loop we look while drawing the bookmarks
|
|
// whether there is any other mark to be drawn
|
|
bHasOtherMarks := FALSE;
|
|
for i := 0 to Marks.Count - 1 do with Marks[i] do
|
|
if Visible and (Line >= FirstLine) and (Line <= LastLine) then
|
|
begin
|
|
if IsBookmark <> BookMarkOptions.DrawBookmarksFirst then //mh 2000-10-12
|
|
bHasOtherMarks := TRUE
|
|
else
|
|
DrawMark(i);
|
|
end;
|
|
if bHasOtherMarks then
|
|
for i := 0 to Marks.Count - 1 do with Marks[i] do
|
|
begin
|
|
if Visible and (IsBookmark <> BookMarkOptions.DrawBookmarksFirst) //mh 2000-10-12
|
|
and (Line >= FirstLine) and (Line <= LastLine)
|
|
then
|
|
DrawMark(i);
|
|
end;
|
|
finally
|
|
FreeMem(aGutterOffs);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.PaintTextLines(AClip: TRect; FirstLine, LastLine,
|
|
FirstCol, LastCol: integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
// FirstLine, LastLine are based 1
|
|
// FirstCol, LastCol are screen based 1 without scrolling (physical position).
|
|
// i.e. the real screen position is fTextOffset+Pred(FirstCol)*CharWidth
|
|
var
|
|
bDoRightEdge: boolean; // right edge
|
|
nRightEdge: integer;
|
|
// selection info
|
|
bSelectionVisible: boolean; // any selection visible?
|
|
nSelL1, nSelCol1: integer; // start of selected area (physical)
|
|
nSelL2, nSelCol2: integer; // end of selected area (physical)
|
|
// info about normal and selected text and background colors
|
|
bSpecialLine, bLineSelected: boolean;
|
|
colFG, colBG: TColor;
|
|
colSelFG, colSelBG: TColor;
|
|
colEditorBG: TColor;
|
|
// info about selection of the current line
|
|
nSelStart, nSelEnd: integer; // start, end of selected area in current line (physical)
|
|
bComplexLine: boolean; // selected and unselected area in current line
|
|
FirstColLogical: integer; // FirstCol converted to logical in current line
|
|
LastColLogical: integer; // LastCol converted to logical in current line
|
|
SelStartLogical: integer; // nSelStart converted to logical in current line
|
|
SelEndLogical: integer; // nSelEnd converted to logical in current line
|
|
// painting the background and the text
|
|
rcLine, rcToken: TRect;
|
|
CurLine: integer; // line index for the loop
|
|
TokenAccu: record
|
|
Len, MaxLen: integer;
|
|
CharsBefore: integer;
|
|
PhysicalStartPos, PhysicalEndPos: integer;
|
|
p: PChar;
|
|
FG, BG: TColor;
|
|
Style: TFontStyles;
|
|
end;
|
|
dc: HDC;
|
|
|
|
ExpandedPaintToken: string; // used to create the string sent to TextDrawer
|
|
|
|
LinkFGCol: TColor;
|
|
|
|
{ local procedures }
|
|
|
|
procedure SetTokenAccuLength;
|
|
begin
|
|
ReAllocMem(TokenAccu.p,TokenAccu.MaxLen+1);
|
|
TokenAccu.p[TokenAccu.MaxLen]:=#0;
|
|
end;
|
|
|
|
procedure ComputeSelectionInfo;
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
bSelectionVisible := FALSE;
|
|
// Only if selection is visible anyway.
|
|
if (not HideSelection or Self.Focused) then begin
|
|
bSelectionVisible := TRUE;
|
|
// Get the *real* start of the selected area.
|
|
if (fBlockBegin.Y < fBlockEnd.Y) then begin
|
|
nSelL1 := fBlockBegin.Y;
|
|
nSelCol1 := fBlockBegin.X;
|
|
nSelL2 := fBlockEnd.Y;
|
|
nSelCol2 := fBlockEnd.X;
|
|
end else if (fBlockBegin.Y > fBlockEnd.Y) then begin
|
|
nSelL2 := fBlockBegin.Y;
|
|
nSelCol2 := fBlockBegin.X;
|
|
nSelL1 := fBlockEnd.Y;
|
|
nSelCol1 := fBlockEnd.X;
|
|
end else if (fBlockBegin.X <> fBlockEnd.X) then begin
|
|
// No selection at all, or it is only on this line.
|
|
nSelL1 := fBlockBegin.Y;
|
|
nSelL2 := nSelL1;
|
|
if (fBlockBegin.X < fBlockEnd.X) then begin
|
|
nSelCol1 := fBlockBegin.X;
|
|
nSelCol2 := fBlockEnd.X;
|
|
end else begin
|
|
nSelCol2 := fBlockBegin.X;
|
|
nSelCol1 := fBlockEnd.X;
|
|
end;
|
|
end else
|
|
bSelectionVisible := FALSE;
|
|
// If there is any visible selection so far, then test if there is an
|
|
// intersection with the area to be painted.
|
|
if bSelectionVisible then begin
|
|
// Don't care if the selection is not visible.
|
|
bSelectionVisible := (nSelL2 >= FirstLine) and (nSelL1 <= LastLine);
|
|
// In the column selection mode sort the begin and end of the selection,
|
|
// this makes the painting code simpler.
|
|
if (SelectionMode = smColumn) and (nSelCol1 > nSelCol2) then
|
|
SwapInt(nSelCol1, nSelCol2);
|
|
if bSelectionVisible then begin
|
|
// Transform the selection from text space into screen space
|
|
p := LogicalToPhysicalPos(Point(nSelCol1, nSelL1));
|
|
nSelCol1 := p.x;
|
|
nSelL1 := p.y;
|
|
p := LogicalToPhysicalPos(point(nSelCol2, nSelL2));
|
|
nSelCol2 := p.x;
|
|
nSelL2 := p.y;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetDrawingColors(Selected: boolean);
|
|
begin
|
|
with fTextDrawer do
|
|
if Selected then begin
|
|
SetBackColor(colSelBG);
|
|
SetForeColor(colSelFG);
|
|
end else begin
|
|
SetBackColor(colBG);
|
|
SetForeColor(colFG);
|
|
end;
|
|
end;
|
|
|
|
function ScreenColumnToXValue(Col: integer): integer;
|
|
// map screen column to screen pixel
|
|
begin
|
|
Result := fTextOffset + Pred(Col) * fCharWidth;
|
|
end;
|
|
|
|
procedure ExpandSpecialChars(var p: PChar; var Count: integer;
|
|
PhysicalStartPos: integer);
|
|
// if there are no tabs or special chars: keep p and Count untouched
|
|
// if there are special chars: copy p into ExpandedPaintToken buffer,
|
|
// convert tabs to spaces, and return the buffer
|
|
var
|
|
i: integer;
|
|
TabCount, LengthNeeded: Integer;
|
|
DestPos: Integer;
|
|
SrcPos: Integer;
|
|
Dest: PChar;
|
|
c: Char;
|
|
ScreenPos: Integer;
|
|
SpaceCount: Integer;
|
|
CharLen: Integer;
|
|
Special: boolean;
|
|
begin
|
|
TabCount:=0;
|
|
for i:=0 to Count-1 do
|
|
if p[i]=#9 then inc(TabCount);
|
|
Special:=eoShowSpecialChars in Options;
|
|
if (not Special) and (TabCount=0)
|
|
and (FindInvalidUTF8Character(p,Count)<0) then
|
|
exit;
|
|
LengthNeeded:=(Count+TabCount*TabWidth);
|
|
if Special then LengthNeeded:=LengthNeeded*2;
|
|
if length(ExpandedPaintToken)<LengthNeeded then
|
|
SetLength(ExpandedPaintToken,LengthNeeded+CharsInWindow);
|
|
//DebugLn(['ExpandSpecialChars Count=',Count,' TabCount=',TabCount,' Special=',Special,' LengthNeeded=',LengthNeeded]);
|
|
SrcPos:=0;
|
|
DestPos:=0;
|
|
ScreenPos:=PhysicalStartPos;
|
|
Dest:=PChar(Pointer(ExpandedPaintToken));
|
|
if UseUTF8 then begin
|
|
while SrcPos<Count do begin
|
|
c:=p[SrcPos];
|
|
case c of
|
|
#128..#191:
|
|
begin
|
|
// non UTF-8 character
|
|
Dest[DestPos]:='?';
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
|
|
#192..#255:
|
|
begin
|
|
// could be UTF8 char
|
|
CharLen:=UTF8CharacterStrictLength(@p[SrcPos]);
|
|
if CharLen=0 then begin
|
|
// invalid character
|
|
Dest[DestPos]:='?';
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
end else begin
|
|
// normal UTF-8 character
|
|
for i:=1 to CharLen do begin
|
|
Dest[DestPos]:=p[SrcPos];
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
end;
|
|
end;
|
|
inc(ScreenPos);
|
|
end;
|
|
|
|
#9:
|
|
begin
|
|
// tab char
|
|
SpaceCount:=TabWidth - ((ScreenPos-1) mod TabWidth);
|
|
//debugln('ExpandSpecialChars SpaceCount=',dbgs(SpaceCount),' TabWidth=',dbgs(TabWidth),' ScreenPos=',dbgs(ScreenPos));
|
|
if not Special then begin
|
|
for i:=1 to SpaceCount do begin
|
|
Dest[DestPos]:=FTabChar;
|
|
inc(DestPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
end else begin
|
|
for i:=1 to SpaceCount do begin
|
|
// #194#187 looks like >>
|
|
Dest[DestPos]:=#194;
|
|
inc(DestPos);
|
|
Dest[DestPos]:=#187;
|
|
inc(DestPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
end;
|
|
inc(SrcPos);
|
|
end;
|
|
|
|
#32:
|
|
// space
|
|
if not Special then begin
|
|
// normal space
|
|
Dest[DestPos]:=p[SrcPos];
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
inc(ScreenPos);
|
|
end else begin
|
|
// #194#183 looks like .
|
|
Dest[DestPos]:=#194;
|
|
inc(DestPos);
|
|
Dest[DestPos]:=#183;
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
|
|
else
|
|
begin
|
|
// normal char
|
|
Dest[DestPos]:=p[SrcPos];
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
end;
|
|
end;
|
|
end else begin
|
|
// non UTF-8
|
|
while SrcPos<Count do begin
|
|
c:=p[SrcPos];
|
|
case c of
|
|
#9:
|
|
begin
|
|
// tab char
|
|
SpaceCount:=TabWidth - ((ScreenPos-1) mod TabWidth);
|
|
//debugln('ExpandSpecialChars SpaceCount=',dbgs(SpaceCount),' TabWidth=',dbgs(TabWidth),' ScreenPos=',dbgs(ScreenPos));
|
|
for i:=1 to SpaceCount do begin
|
|
Dest[DestPos]:=FTabChar;
|
|
inc(DestPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
inc(SrcPos);
|
|
end;
|
|
|
|
else
|
|
begin
|
|
// normal char
|
|
Dest[DestPos]:=p[SrcPos];
|
|
inc(DestPos);
|
|
inc(SrcPos);
|
|
inc(ScreenPos);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
p:=PChar(Pointer(ExpandedPaintToken));
|
|
Count:=DestPos;
|
|
//debugln('ExpandSpecialChars Token with Tabs: "',DbgStr(copy(ExpandedPaintToken,1,Count)),'"');
|
|
end;
|
|
|
|
procedure PaintToken(
|
|
Token: PChar;
|
|
TokenLen, // TokenLen is the maximum logical (byte) position for Token
|
|
CharsBefore, // CharsBefore tells if Token starts at column one or not
|
|
FirstPhysical,// FirstPhysical is the physical (screen without scrolling)
|
|
// column of the first character
|
|
First, Last // First, Last minus CharsBefore are logical (byte) positions in Token
|
|
: integer);
|
|
var
|
|
pszText: PChar;
|
|
nCharsToPaint: integer;
|
|
nX: integer;
|
|
const
|
|
ETOOptions = ETO_OPAQUE; // Note: clipping is slow and not needed
|
|
begin
|
|
{debugln('PaintToken A TokenLen=',dbgs(TokenLen),
|
|
' CharsBefore=',dbgs(CharsBefore),
|
|
' FirstPhysical=',dbgs(FirstPhysical),
|
|
' First='+dbgs(First),' Last=',dbgs(Last),
|
|
' Tok="'+copy(Token,First-CharsBefore,Last-First+1),'"',
|
|
' rcToken='+dbgs(rcToken.Left)+'-'+dbgs(rcToken.Right));}
|
|
if (Last < First) or (rcToken.Right <= rcToken.Left) then exit;
|
|
Dec(First, CharsBefore);
|
|
Dec(Last, CharsBefore);
|
|
if (First > TokenLen) then begin
|
|
pszText := nil;
|
|
nCharsToPaint := 0;
|
|
end else begin
|
|
pszText := PChar(@Token[First-1]);
|
|
nCharsToPaint := Min(Last - First + 1, TokenLen - First + 1);
|
|
ExpandSpecialChars(pszText,nCharsToPaint,FirstPhysical);
|
|
end;
|
|
// Draw the right edge under the text if necessary
|
|
nX := ScreenColumnToXValue(FirstPhysical);
|
|
if bDoRightEdge and (not (eoHideRightMargin in Options))
|
|
and (nRightEdge<rcToken.Right) and (nRightEdge>=rcToken.Left)
|
|
then begin
|
|
// draw background
|
|
InternalFillRect(dc,rcToken);
|
|
// draw edge
|
|
LCLIntf.MoveToEx(dc, nRightEdge, rcToken.Top, nil);
|
|
LCLIntf.LineTo(dc, nRightEdge, rcToken.Bottom + 1);
|
|
// draw text
|
|
fTextDrawer.ExtTextOut(nX, rcToken.Top, ETOOptions-ETO_OPAQUE, rcToken,
|
|
pszText, nCharsToPaint);
|
|
end else begin
|
|
// draw text with background
|
|
//debugln('PaintToken nX=',dbgs(nX),' Token=',dbgstr(copy(pszText,1,nCharsToPaint)),' rcToken=',dbgs(rcToken));
|
|
fTextDrawer.ExtTextOut(nX, rcToken.Top, ETOOptions, rcToken,
|
|
pszText, nCharsToPaint);
|
|
end;
|
|
rcToken.Left := rcToken.Right;
|
|
end;
|
|
|
|
procedure PaintHighlightToken(bFillToEOL: boolean);
|
|
var
|
|
bComplexToken: boolean;
|
|
nC1, nC2, nC1Sel, nC2Sel: integer; // logical (byte)
|
|
bU1, bSel, bU2: boolean;
|
|
nX1, nX2: integer;
|
|
C1Phys: integer;
|
|
C1SelPhys: integer;
|
|
C2Phys: integer;
|
|
C2SelPhys: LongInt;
|
|
begin
|
|
// Compute some helper variables.
|
|
nC1 := Max(FirstColLogical, TokenAccu.CharsBefore + 1);
|
|
nC2 := Min(LastColLogical, TokenAccu.CharsBefore + TokenAccu.Len);
|
|
if bComplexLine then begin
|
|
bU1 := (nC1 < SelStartLogical);
|
|
bSel := (nC1 < SelEndLogical) and (nC2 >= SelStartLogical);
|
|
bU2 := (nC2 >= SelEndLogical);
|
|
bComplexToken := bSel and (bU1 or bU2);
|
|
end else begin
|
|
bU1 := False;
|
|
bSel := bLineSelected;
|
|
bU2 := False;
|
|
bComplexToken := FALSE;
|
|
end;
|
|
{debugln('PaintHighlightToken A TokenAccu: CharsBefore=',dbgs(TokenAccu.CharsBefore),
|
|
' Len=',dbgs(TokenAccu.Len),
|
|
' PhysicalStartPos=',dbgs(TokenAccu.PhysicalStartPos),
|
|
' PhysicalEndPos=',dbgs(TokenAccu.PhysicalEndPos),
|
|
' Complex=',dbgs(bComplexToken),
|
|
' "',copy(TokenAccu.s,1,TokenAccu.Len),'"');}
|
|
|
|
// Any token chars accumulated?
|
|
if (TokenAccu.Len > 0) then begin
|
|
// Initialize the colors and the font style.
|
|
if not bSpecialLine then begin
|
|
colBG := TokenAccu.BG;
|
|
colFG := TokenAccu.FG;
|
|
end;
|
|
fTextDrawer.SetStyle(TokenAccu.Style);
|
|
// Paint the chars
|
|
if bComplexToken then begin
|
|
// first unselected part of the token
|
|
C1Phys := Max(FirstCol, TokenAccu.PhysicalStartPos);
|
|
if bU1 then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := ScreenColumnToXValue(nSelStart);
|
|
with TokenAccu do
|
|
PaintToken(p,Len,CharsBefore,C1Phys,nC1,SelStartLogical-1);
|
|
end;
|
|
// selected part of the token
|
|
SetDrawingColors(TRUE);
|
|
nC1Sel := Max(SelStartLogical, nC1);
|
|
nC2Sel := Min(SelEndLogical, nC2+1);
|
|
C2Phys := Min(LastCol, TokenAccu.PhysicalEndPos+1);
|
|
C1SelPhys := Max(nSelStart, C1Phys);
|
|
C2SelPhys := Min(nSelEnd, C2Phys);
|
|
rcToken.Right := ScreenColumnToXValue(C2SelPhys);
|
|
with TokenAccu do PaintToken(p,Len,CharsBefore,C1SelPhys,nC1Sel,nC2Sel-1);
|
|
// second unselected part of the token
|
|
if bU2 then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := ScreenColumnToXValue(C2Phys);
|
|
with TokenAccu do
|
|
PaintToken(p,Len,CharsBefore,nSelEnd,SelEndLogical,nC2);
|
|
end;
|
|
end else begin
|
|
C1Phys := Max(FirstCol, TokenAccu.PhysicalStartPos);
|
|
C2Phys := Min(LastCol, TokenAccu.PhysicalEndPos+1);
|
|
SetDrawingColors(bSel);
|
|
rcToken.Right := ScreenColumnToXValue(C2Phys);
|
|
with TokenAccu do PaintToken(p, Len, CharsBefore, C1Phys, nC1, nC2);
|
|
end;
|
|
end;
|
|
|
|
// Fill the background to the end of this line if necessary.
|
|
if bFillToEOL and (rcToken.Left < rcLine.Right) then begin
|
|
if not bSpecialLine then colBG := colEditorBG;
|
|
if bComplexLine then begin
|
|
nX1 := ScreenColumnToXValue(nSelStart);
|
|
nX2 := ScreenColumnToXValue(nSelEnd);
|
|
if (rcToken.Left < nX1) then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := nX1;
|
|
InternalFillRect(dc, rcToken);
|
|
rcToken.Left := nX1;
|
|
end;
|
|
if (rcToken.Left < nX2) then begin
|
|
SetDrawingColors(TRUE);
|
|
rcToken.Right := nX2;
|
|
InternalFillRect(dc, rcToken);
|
|
rcToken.Left := nX2;
|
|
end;
|
|
if (rcToken.Left < rcLine.Right) then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := rcLine.Right;
|
|
InternalFillRect(dc, rcToken);
|
|
end;
|
|
end else begin
|
|
SetDrawingColors(bLineSelected);
|
|
rcToken.Right := rcLine.Right;
|
|
InternalFillRect(dc, rcToken);
|
|
end;
|
|
// Draw the right edge if necessary.
|
|
if bDoRightEdge and (not (eoHideRightMargin in Options))
|
|
and (nRightEdge>=rcToken.Left) then begin
|
|
LCLIntf.MoveToEx(dc, nRightEdge, rcToken.Top, nil);
|
|
LCLIntf.LineTo(dc, nRightEdge, rcToken.Bottom + 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure AddHighlightToken(
|
|
Token: PChar;
|
|
CharsBefore, TokenLen, PhysicalStartPos, PhysicalEndPos: integer;
|
|
Foreground, Background: TColor;
|
|
Style: TFontStyles);
|
|
var
|
|
bCanAppend: boolean;
|
|
bSpacesTest, bIsSpaces: boolean;
|
|
i: integer;
|
|
|
|
function TokenIsSpaces: boolean;
|
|
var
|
|
pTok: PChar;
|
|
Cnt: Integer;
|
|
begin
|
|
if not bSpacesTest then begin
|
|
bSpacesTest := TRUE;
|
|
bIsSpaces := TRUE;
|
|
pTok := PChar(Pointer(Token));
|
|
Cnt := TokenLen;
|
|
while bIsSpaces and (Cnt > 0) do begin
|
|
if not (pTok^ in [' ',#9])
|
|
then bIsSpaces := False;
|
|
Inc(pTok);
|
|
dec(Cnt);
|
|
end;
|
|
end;
|
|
Result := bIsSpaces;
|
|
end;
|
|
|
|
begin
|
|
{DebugLn('AddHighlightToken A CharsBefore=',dbgs(CharsBefore),
|
|
' TokenLen=',dbgs(TokenLen),
|
|
' PhysicalStartPos=',dbgs(PhysicalStartPos),' PhysicalEndPos=',dbgs(PhysicalEndPos),
|
|
' Tok="',copy(Token,1,TokenLen),'"');}
|
|
if Background = clNone then Background := colEditorBG;
|
|
if Foreground = clNone then Foreground := Font.Color;
|
|
// Do we have to paint the old chars first, or can we just append?
|
|
bCanAppend := FALSE;
|
|
bSpacesTest := FALSE;
|
|
if (TokenAccu.Len > 0) then begin
|
|
// font style must be the same or token is only spaces
|
|
if (TokenAccu.Style = Style)
|
|
or (not (fsUnderline in Style) and not (fsUnderline in TokenAccu.Style)
|
|
and TokenIsSpaces)
|
|
then
|
|
// either special colors or same colors
|
|
if bSpecialLine or bLineSelected or
|
|
// background color must be the same and
|
|
((TokenAccu.BG = Background) and
|
|
// foreground color must be the same or token is only spaces
|
|
((TokenAccu.FG = Foreground) or TokenIsSpaces))
|
|
then
|
|
bCanAppend := TRUE;
|
|
// If we can't append it, then we have to paint the old token chars first.
|
|
if not bCanAppend then
|
|
PaintHighlightToken(FALSE);
|
|
end;
|
|
// Don't use AppendStr because it's more expensive.
|
|
if bCanAppend then begin
|
|
if (TokenAccu.Len + TokenLen > TokenAccu.MaxLen) then begin
|
|
TokenAccu.MaxLen := TokenAccu.Len + TokenLen + 32;
|
|
SetTokenAccuLength;
|
|
end;
|
|
for i := 0 to TokenLen-1 do begin
|
|
TokenAccu.p[TokenAccu.Len + i] := Token[i];
|
|
end;
|
|
Inc(TokenAccu.Len, TokenLen);
|
|
TokenAccu.PhysicalEndPos := PhysicalEndPos;
|
|
end else begin
|
|
TokenAccu.Len := TokenLen;
|
|
if (TokenAccu.Len > TokenAccu.MaxLen) then begin
|
|
TokenAccu.MaxLen := TokenAccu.Len + 32;
|
|
SetTokenAccuLength;
|
|
end;
|
|
for i := 0 to TokenLen-1 do begin
|
|
TokenAccu.p[i] := Token[i];
|
|
end;
|
|
TokenAccu.CharsBefore := CharsBefore;
|
|
TokenAccu.PhysicalStartPos := PhysicalStartPos;
|
|
TokenAccu.PhysicalEndPos := PhysicalEndPos;
|
|
TokenAccu.FG := Foreground;
|
|
TokenAccu.BG := Background;
|
|
TokenAccu.Style := Style;
|
|
end;
|
|
{debugln('AddHighlightToken END bCanAppend=',dbgs(bCanAppend),
|
|
' TokenAccu: CharsBefore=',dbgs(TokenAccu.CharsBefore),
|
|
' Len=',dbgs(TokenAccu.Len),
|
|
' PhysicalStartPos=',dbgs(TokenAccu.PhysicalStartPos),
|
|
' PhysicalEndPos=',dbgs(TokenAccu.PhysicalEndPos),
|
|
' "',copy(TokenAccu.s,1,TokenAccu.Len),'"');}
|
|
end;
|
|
|
|
procedure DrawHilightMarkupToken(attr: TSynHighlighterAttributes;
|
|
sToken: PChar; nLine, nTokenPos, nTokenLen,
|
|
PhysicalStartPos: integer);
|
|
var
|
|
DefaultFGCol, DefaultBGCol: TColor;
|
|
DefaultStyle: TFontStyles;
|
|
|
|
procedure PaintSubToken(SubTokenLen: integer; Hilight: TSynSelectedColor);
|
|
var
|
|
PhysicalEndPos: integer;
|
|
Style: TFontStyles;
|
|
BG, FG : TColor;
|
|
begin
|
|
if SubTokenLen=0 then exit;
|
|
|
|
BG := DefaultBGCol;
|
|
fG := DefaultFGCol;
|
|
Style := DefaultStyle;
|
|
if assigned(Hilight) then begin
|
|
if Hilight.Foreground <> clNone then FG := Hilight.Foreground;
|
|
if Hilight.Background <> clNone then BG := Hilight.Background;
|
|
Style := Hilight.GetModifiedStyle(Style);
|
|
end;
|
|
|
|
PhysicalEndPos:=LogicalToPhysicalCol(sToken,nTokenLen,
|
|
SubTokenLen+1,1,PhysicalStartPos)-1;
|
|
|
|
AddHighlightToken(sToken, nTokenPos, SubTokenLen,
|
|
PhysicalStartPos, PhysicalEndPos,
|
|
FG, BG, Style
|
|
);
|
|
|
|
PhysicalStartPos:=PhysicalEndPos+1;
|
|
inc(nTokenPos,SubTokenLen);
|
|
dec(nTokenLen,SubTokenLen);
|
|
inc(sToken,SubTokenLen);
|
|
end;
|
|
|
|
var
|
|
NextPos : Integer;
|
|
MarkupInfo : TSynSelectedColor;
|
|
begin
|
|
if Assigned(attr) then begin
|
|
DefaultFGCol:=attr.Foreground;
|
|
DefaultBGCol:=attr.Background;
|
|
DefaultStyle:=attr.Style;
|
|
end else begin
|
|
DefaultFGCol:=colFG;
|
|
DefaultBGCol:=colBG;
|
|
DefaultStyle:=Font.Style;
|
|
end;
|
|
|
|
while (nTokenLen > 0) do begin
|
|
NextPos := fMarkupManager.GetNextMarkupColAfterRowCol(CurLine, nTokenPos+1); // ntokenPos is zero base
|
|
if (NextPos < 1) or (NextPos - nTokenPos - 1 > nTokenLen)
|
|
then NextPos := nTokenPos + nTokenLen + 1; // paint remainder
|
|
MarkupInfo := fMarkupManager.GetMarkupAttributeAtRowCol(CurLine, nTokenPos+1);
|
|
PaintSubToken(NextPos - nTokenPos - 1, MarkupInfo);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawCtrlMouseToken(attr: TSynHighlighterAttributes;
|
|
sToken: PChar; nLine, nTokenPos, nTokenLen,
|
|
PhysicalStartPos, PhysicalEndPos: integer);
|
|
var
|
|
LinkBGCol: TColor;
|
|
LinkStyle: TFontStyles;
|
|
fRed, fGreen, fBlue: integer;
|
|
{bRed, bGreen,} bBlue: integer;
|
|
NewRed, NewGreen, NewBlue: integer;
|
|
begin
|
|
if Assigned(attr) then begin
|
|
LinkFGCol:=attr.Foreground;
|
|
LinkBGCol:=attr.Background;
|
|
LinkStyle:=attr.Style;
|
|
end else begin
|
|
LinkFGCol:=colFG;
|
|
LinkBGCol:=colBG;
|
|
LinkStyle:=Font.Style;
|
|
end;
|
|
if LinkBGCol = clNone then LinkBGCol := colEditorBG;
|
|
if LinkFGCol = clNone then LinkFGCol := Font.Color;
|
|
|
|
// change FG color
|
|
fRed :=(LinkFGCol and $ff);
|
|
fGreen:=(LinkFGCol shr 8) and $ff;
|
|
fBlue :=(LinkFGCol shr 16) and $ff;
|
|
//bRed :=(LinkBGCol and $ff);
|
|
//bGreen:=(LinkBGCol shr 8) and $ff;
|
|
bBlue :=(LinkBGCol shr 16) and $ff;
|
|
NewRed :=fRed;
|
|
NewGreen:=fGreen;
|
|
NewBlue :=bBlue;
|
|
if Abs(NewBlue-fBlue)<128 then
|
|
NewBlue:=(255-fBlue) and $ff;
|
|
LinkFGCol:=NewRed+(NewGreen shl 8)+(NewBlue shl 16);
|
|
|
|
AddHighlightToken(sToken, nTokenPos, nTokenLen,
|
|
PhysicalStartPos, PhysicalEndPos,
|
|
LinkFGCol, LinkBGCol, LinkStyle);
|
|
end;
|
|
|
|
procedure PaintLines;
|
|
var
|
|
sLine: string; // the current line
|
|
sToken: PChar; // highlighter token info
|
|
nTokenPos, nTokenLen: integer;
|
|
TokenPhysStart: integer; // nTokenPos converted to physical (screen)
|
|
TokenPhysEnd: integer; // nTokenPos+nTokenLen converted to physical (screen)
|
|
attr: TSynHighlighterAttributes;
|
|
LastTokenPosLogical: Integer;
|
|
LastTokenPosPhyscial: Integer;
|
|
ypos: Integer;
|
|
begin
|
|
// Initialize rcLine for drawing. Note that Top and Bottom are updated
|
|
// inside the loop. Get only the starting point for this.
|
|
rcLine := AClip;
|
|
rcLine.Bottom := RowToScreenRow(FirstLine) * fTextHeight;
|
|
// Make sure the token accumulator string doesn't get reassigned to often.
|
|
if Assigned(fHighlighter) then begin
|
|
TokenAccu.MaxLen := Max(128, fCharsInWindow * 4);
|
|
SetTokenAccuLength;
|
|
end;
|
|
|
|
// Now loop through all the lines. The indices are valid for Lines.
|
|
CurLine := FirstLine-1;
|
|
while CurLine<LastLine do begin
|
|
inc(CurLine);
|
|
|
|
if TSynEditStringList(fLines).Folded[CurLine-1] then begin
|
|
// this line is folded -> skip
|
|
//debugln('line folded ',dbgs(CurLine));
|
|
continue;
|
|
end;
|
|
|
|
// Get the line.
|
|
sLine := Lines[CurLine - 1];
|
|
// Get the information about the line selection. Three different parts
|
|
// are possible (unselected before, selected, unselected after), only
|
|
// unselected or only selected means bComplexLine will be FALSE. Start
|
|
// with no selection, compute based on the visible columns.
|
|
bComplexLine := FALSE;
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
SelStartLogical:= 0;
|
|
SelEndLogical:= 0;
|
|
// Does the selection intersect the visible area?
|
|
if bSelectionVisible and (CurLine >= nSelL1) and (CurLine <= nSelL2) then begin
|
|
// Default to a fully selected line. This is correct for the smLine
|
|
// selection mode and a good start for the smNormal mode.
|
|
nSelStart := FirstCol;
|
|
nSelEnd := LastCol + 1;
|
|
if (SelectionMode = smColumn) or
|
|
((SelectionMode = smNormal) and (CurLine = nSelL1))
|
|
then
|
|
if (nSelCol1 > LastCol) then begin
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
end else if (nSelCol1 > FirstCol) then begin
|
|
nSelStart := nSelCol1;
|
|
bComplexLine := TRUE;
|
|
end;
|
|
if (SelectionMode = smColumn) or
|
|
((SelectionMode = smNormal) and (CurLine = nSelL2))
|
|
then
|
|
if (nSelCol2 < FirstCol) then begin
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
end else if (nSelCol2 < LastCol) then begin
|
|
nSelEnd := nSelCol2;
|
|
bComplexLine := TRUE;
|
|
end;
|
|
end;
|
|
//debugln('PaintLines A nSelStart=',dbgs(nSelStart),' nSelEnd=',dbgs(nSelEnd));
|
|
|
|
// Update the rcLine rect to this line.
|
|
rcLine.Top := rcLine.Bottom;
|
|
Inc(rcLine.Bottom, fTextHeight);
|
|
// Initialize the text and background colors, maybe the line should
|
|
// use special values for them.
|
|
colFG := Font.Color;
|
|
colBG := colEditorBG;
|
|
bSpecialLine := DoOnSpecialLineColors(CurLine, colFG, colBG);
|
|
if bSpecialLine then begin
|
|
// The selection colors are just swapped, like seen in Delphi.
|
|
colSelFG := colBG;
|
|
colSelBG := colFG;
|
|
end else begin
|
|
colSelFG := fSelectedColor.Foreground;
|
|
colSelBG := fSelectedColor.Background;
|
|
end;
|
|
// Paint the lines depending on the assigned highlighter.
|
|
bLineSelected := not bComplexLine and (nSelStart > 0);
|
|
rcToken := rcLine;
|
|
FirstColLogical:=PhysicalToLogicalCol(sLine,FirstCol);
|
|
LastColLogical:=PhysicalToLogicalCol(sLine,LastCol,
|
|
FirstColLogical,FirstCol);
|
|
if nSelStart>0 then begin
|
|
SelStartLogical:=PhysicalToLogicalCol(sLine,nSelStart,
|
|
FirstColLogical,FirstCol);
|
|
SelEndLogical:=PhysicalToLogicalCol(sLine,nSelEnd,
|
|
SelStartLogical,nSelStart);
|
|
end;
|
|
if not Assigned(fHighlighter) then begin
|
|
// Note: The PaintToken procedure will take care of invalid parameters
|
|
// like empty token rect or invalid indices into sLine.
|
|
nTokenLen := Length(sLine);
|
|
if bComplexLine then begin
|
|
SetDrawingColors(FALSE);
|
|
// paint unselected text in front of selection
|
|
rcToken.Left := Max(rcLine.Left, ScreenColumnToXValue(FirstCol));
|
|
rcToken.Right := Min(rcLine.Right, ScreenColumnToXValue(nSelStart));
|
|
PaintToken(PChar(Pointer(sLine)), nTokenLen, 0, FirstCol,
|
|
FirstColLogical, SelStartLogical-1);
|
|
// paint unselected text behind selection
|
|
rcToken.Left := Max(rcLine.Left, ScreenColumnToXValue(nSelEnd));
|
|
rcToken.Right := Min(rcLine.Right, ScreenColumnToXValue(LastCol));
|
|
PaintToken(PChar(Pointer(sLine)), nTokenLen, 0, nSelEnd,
|
|
SelEndLogical, LastColLogical);
|
|
// paint selection
|
|
SetDrawingColors(TRUE);
|
|
rcToken.Left := Max(rcLine.Left, ScreenColumnToXValue(nSelStart));
|
|
rcToken.Right := Min(rcLine.Right, ScreenColumnToXValue(nSelEnd));
|
|
PaintToken(PChar(Pointer(sLine)), nTokenLen, 0, nSelStart,
|
|
SelStartLogical, SelEndLogical-1);
|
|
end else begin
|
|
SetDrawingColors(bLineSelected);
|
|
PaintToken(PChar(Pointer(sLine)), nTokenLen, 0, FirstCol,
|
|
FirstColLogical, LastColLogical);
|
|
end;
|
|
end else begin
|
|
// Initialize highlighter with line text and range info. It is
|
|
// necessary because we probably did not scan to the end of the last
|
|
// line - the internal highlighter range might be wrong.
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[CurLine - 1]); //mh 2000-10-10
|
|
fHighlighter.SetLine(sLine, CurLine - 1);
|
|
// Try to concatenate as many tokens as possible to minimize the count
|
|
// of ExtTextOut calls necessary. This depends on the selection state
|
|
// or the line having special colors. For spaces the foreground color
|
|
// is ignored as well.
|
|
TokenAccu.Len := 0;
|
|
LastTokenPosLogical:=1;
|
|
LastTokenPosPhyscial:=1;
|
|
//debugln('PaintLines A FirstColLogical=',dbgs(FirstColLogical));
|
|
while not fHighlighter.GetEol do begin
|
|
// Test first whether anything of this token is visible.
|
|
nTokenPos := fHighlighter.GetTokenPos; // zero-based
|
|
fHighlighter.GetTokenEx(sToken,nTokenLen);
|
|
//debugln('Paintlines B nTokenPos=',dbgs(nTokenPos),' nTokenLen=',dbgs(nTokenLen),' "',copy(sLine,nTokenPos+1,ntokenLen),'"');
|
|
if (nTokenPos + nTokenLen + 1>= FirstColLogical) then begin
|
|
// It's at least partially visible.
|
|
// convert nTokenPos to physical (screen)
|
|
TokenPhysStart:=LogicalToPhysicalCol(PChar(sLine),length(sLine),
|
|
nTokenPos+1,
|
|
LastTokenPosLogical,LastTokenPosPhyscial);
|
|
LastTokenPosLogical:=nTokenPos+nTokenLen+1;
|
|
LastTokenPosPhyscial:=LogicalToPhysicalCol(
|
|
PChar(sLine),length(sLine),
|
|
LastTokenPosLogical,nTokenPos+1,TokenPhysStart);
|
|
TokenPhysEnd:=LastTokenPosPhyscial-1;
|
|
{debugln('Paintlines C nTokenPos=',dbgs(nTokenPos),' nTokenLen=',dbgs(nTokenLen),' "',copy(sLine,nTokenPos+1,ntokenLen),'"',
|
|
' TokenPhysStart=',dbgs(TokenPhysStart),' TokenPhysEnd=',dbgs(TokenPhysEnd));}
|
|
// Get the token attributes now.
|
|
attr := fHighlighter.GetTokenAttribute;
|
|
// Store the token chars with the attributes in the TokenAccu
|
|
// record. This will paint any chars already stored if there is
|
|
// a (visible) change in the attributes.
|
|
if (fLastCtrlMouseLinkY<>CurLine)
|
|
or (nTokenPos+1<>fLastCtrlMouseLinkX1)
|
|
then begin
|
|
DrawHilightMarkupToken(attr,sToken,CurLine,
|
|
nTokenPos,nTokenLen,TokenPhysStart);
|
|
end else begin
|
|
// token is link
|
|
DrawCtrlMouseToken(attr,sToken,CurLine,nTokenPos,nTokenLen,
|
|
TokenPhysStart,TokenPhysEnd);
|
|
end;
|
|
end;
|
|
// Let the highlighter scan the next token.
|
|
fHighlighter.Next;
|
|
end;
|
|
// Draw anything that's left in the TokenAccu record. Fill to the end
|
|
// of the invalid area with the correct colors.
|
|
PaintHighlightToken(TRUE);
|
|
end;
|
|
|
|
// codefold draw splitter line
|
|
if Gutter.ShowCodeFolding and (CurLine>=0)
|
|
and (TSynEditStringList(Lines).FoldType[CurLine-1] in [cfEnd])
|
|
and (TSynEditStringList(Lines).FoldEndLevel[CurLine-1] < CFDividerDrawLevel) then
|
|
begin
|
|
ypos := rcToken.Bottom - 1;
|
|
LCLIntf.MoveToEx(dc, nRightEdge, ypos, nil);
|
|
LCLIntf.LineTo(dc, fGutterWidth, ypos);
|
|
end;
|
|
end;
|
|
CurLine:=-1;
|
|
end;
|
|
|
|
procedure CalculateCtrlMouseLink;
|
|
begin
|
|
fLastCtrlMouseLinkY:=-1;
|
|
if (not (eoShowCtrlMouseLinks in Options))
|
|
or (fLastMouseCaret.X<1) or (fLastMouseCaret.Y<1)
|
|
or (not fLastControlIsPressed) then
|
|
exit;
|
|
GetWordBoundsAtRowCol(PhysicalToLogicalPos(fLastMouseCaret),
|
|
fLastCtrlMouseLinkX1,fLastCtrlMouseLinkX2);
|
|
if fLastCtrlMouseLinkX1=fLastCtrlMouseLinkX2 then
|
|
exit;
|
|
fLastCtrlMouseLinkY:=fLastMouseCaret.Y;
|
|
LinkFGCol:=clBlue;
|
|
end;
|
|
|
|
procedure PaintCtrlMouseLinkLine;
|
|
var
|
|
LineLeft, LineTop, LineRight: integer;
|
|
s: string;
|
|
PhysLinkStart: LongInt;
|
|
PhysLinkEnd: LongInt;
|
|
begin
|
|
if fLastCtrlMouseLinkY<1 then exit;
|
|
LineTop:= (RowToScreenRow(fLastCtrlMouseLinkY)+1)*fTextHeight-1;
|
|
s:=Lines[fLastCtrlMouseLinkY-1];
|
|
PhysLinkStart:=Max(FirstCol,LogicalToPhysicalCol(s,fLastCtrlMouseLinkX1));
|
|
PhysLinkEnd:=Min(LastCol,LogicalToPhysicalCol(s,fLastCtrlMouseLinkX2));
|
|
LineLeft:=ScreenColumnToXValue(PhysLinkStart);
|
|
LineRight:=ScreenColumnToXValue(PhysLinkEnd);
|
|
Canvas.Pen.Color:=LinkFGCol;
|
|
Canvas.MoveTo(LineLeft,LineTop);
|
|
Canvas.LineTo(LineRight,LineTop);
|
|
end;
|
|
|
|
{ end local procedures }
|
|
|
|
var
|
|
ypos : integer;
|
|
begin
|
|
CurLine:=-1;
|
|
FillChar(TokenAccu,SizeOf(TokenAccu),0);
|
|
//DebugLn('TCustomSynEdit.PaintTextLines ',DbgSName(Self),' TopLine=',dbgs(TopLine));
|
|
colEditorBG := Color;
|
|
if Assigned(Highlighter) and Assigned(Highlighter.WhitespaceAttribute) then
|
|
begin
|
|
colBG := Highlighter.WhitespaceAttribute.Background;
|
|
if colBG <> clNone then
|
|
colEditorBG := colBG;
|
|
end;
|
|
// If the right edge is visible and in the invalid area, prepare to paint it.
|
|
// Do this first to realize the pen when getting the dc variable.
|
|
bDoRightEdge := FALSE;
|
|
if (fRightEdge > 0) then begin // column value
|
|
nRightEdge := fTextOffset + fRightEdge * fCharWidth; // pixel value
|
|
if (nRightEdge >= AClip.Left) and (nRightEdge <= AClip.Right) then begin
|
|
bDoRightEdge := TRUE;
|
|
end;
|
|
Canvas.Pen.Color := fRightEdgeColor;
|
|
Canvas.Pen.Width := 1;
|
|
end;
|
|
// Do everything else with API calls. This (maybe) realizes the new pen color.
|
|
dc := Canvas.Handle;
|
|
|
|
// If anything of the two pixel space before the text area is visible, then
|
|
// fill it with the component background color.
|
|
if (AClip.Left < fGutterWidth + 2) then begin
|
|
rcToken := AClip;
|
|
rcToken.Left := Max(AClip.Left, fGutterWidth);
|
|
rcToken.Right := fGutterWidth + 2;
|
|
SetBkColor(dc,colEditorBG);
|
|
InternalFillRect(dc, rcToken);
|
|
// Adjust the invalid area to not include this area.
|
|
AClip.Left := rcToken.Right;
|
|
end;
|
|
if (LastLine >= FirstLine) then begin
|
|
CalculateCtrlMouseLink;
|
|
// Paint the visible text lines. To make this easier, compute first the
|
|
// necessary information about the selected area: is there any visible
|
|
// selected area, and what are its lines / columns?
|
|
// Moved to two local procedures to make it easier to read.
|
|
ComputeSelectionInfo;
|
|
fTextDrawer.Style := Font.Style;
|
|
fTextDrawer.BeginDrawing(dc);
|
|
try
|
|
PaintLines;
|
|
finally
|
|
fTextDrawer.EndDrawing;
|
|
end;
|
|
end;
|
|
|
|
// If there is anything visible below the last line, then fill this as well.
|
|
rcToken := AClip;
|
|
rcToken.Top := (RowToScreenRow(LastLine)+1) * fTextHeight;
|
|
if (rcToken.Top < rcToken.Bottom) then begin
|
|
SetBkColor(dc, ColorToRGB(colEditorBG));
|
|
InternalFillRect(dc, rcToken);
|
|
// Draw the right edge if necessary.
|
|
if bDoRightEdge and (not (eoHideRightMargin in Options)) then begin
|
|
LCLIntf.MoveToEx(dc, nRightEdge, rcToken.Top, nil);
|
|
LCLIntf.LineTo(dc, nRightEdge, rcToken.Bottom + 1);
|
|
end;
|
|
|
|
// codefold draw splitter line
|
|
if Gutter.ShowCodeFolding and (LastLine<Lines.Count)
|
|
and (TSynEditStringList(Lines).FoldType[LastLine-1] in [cfEnd])
|
|
and (TSynEditStringList(Lines).FoldEndLevel[LastLine-1] < CFDividerDrawLevel) then
|
|
begin
|
|
ypos := rcToken.Bottom - 1;
|
|
LCLIntf.MoveToEx(dc, nRightEdge, ypos, nil);
|
|
LCLIntf.LineTo(dc, fGutterWidth, ypos);
|
|
end;
|
|
end;
|
|
|
|
PaintCtrlMouseLinkLine;
|
|
ReAllocMem(TokenAccu.p,0);
|
|
end;
|
|
{$ELSE below for NOT SYN_LAZARUS ----------------------------------------------}
|
|
var
|
|
bDoRightEdge: boolean; // right edge
|
|
nRightEdge: integer;
|
|
// selection info
|
|
bAnySelection: boolean; // any selection visible?
|
|
nSelL1, nSelCol1: integer; // start of selected area
|
|
nSelL2, nSelCol2: integer; // end of selected area
|
|
// info about normal and selected text and background colors
|
|
bSpecialLine, bLineSelected: boolean;
|
|
colFG, colBG: TColor;
|
|
colSelFG, colSelBG: TColor;
|
|
colEditorBG: TColor;
|
|
// info about selection of the current line
|
|
nSelStart, nSelEnd: integer;
|
|
bComplexLine: boolean;
|
|
// painting the background and the text
|
|
rcLine, rcToken: TRect;
|
|
TokenAccu: record
|
|
// Note: s is not managed as a string, it will only grow!!!
|
|
// Never use AppendStr or "+", use Len and MaxLen instead and
|
|
// copy the string chars directly. This is for efficiency.
|
|
Len, MaxLen, CharsBefore: integer;
|
|
s: string;
|
|
FG, BG: TColor;
|
|
Style: TFontStyles;
|
|
end;
|
|
dc: HDC;
|
|
|
|
{ local procedures }
|
|
|
|
procedure ComputeSelectionInfo;
|
|
var
|
|
p: TPoint;
|
|
begin
|
|
bAnySelection := FALSE;
|
|
// Only if selection is visible anyway.
|
|
if (not HideSelection or Self.Focused) then begin
|
|
bAnySelection := TRUE;
|
|
// Get the *real* start of the selected area.
|
|
if (fBlockBegin.Y < fBlockEnd.Y) then begin
|
|
nSelL1 := fBlockBegin.Y;
|
|
nSelCol1 := fBlockBegin.X;
|
|
nSelL2 := fBlockEnd.Y;
|
|
nSelCol2 := fBlockEnd.X;
|
|
end else if (fBlockBegin.Y > fBlockEnd.Y) then begin
|
|
nSelL2 := fBlockBegin.Y;
|
|
nSelCol2 := fBlockBegin.X;
|
|
nSelL1 := fBlockEnd.Y;
|
|
nSelCol1 := fBlockEnd.X;
|
|
end else if (fBlockBegin.X <> fBlockEnd.X) then begin
|
|
// No selection at all, or it is only on this line.
|
|
nSelL1 := fBlockBegin.Y;
|
|
nSelL2 := nSelL1;
|
|
if (fBlockBegin.X < fBlockEnd.X) then begin
|
|
nSelCol1 := fBlockBegin.X;
|
|
nSelCol2 := fBlockEnd.X;
|
|
end else begin
|
|
nSelCol2 := fBlockBegin.X;
|
|
nSelCol1 := fBlockEnd.X;
|
|
end;
|
|
end else
|
|
bAnySelection := FALSE;
|
|
// If there is any visible selection so far, then test if there is an
|
|
// intersection with the area to be painted.
|
|
if bAnySelection then begin
|
|
// Don't care if the selection is not visible.
|
|
bAnySelection := (nSelL2 >= FirstLine) and (nSelL1 <= LastLine);
|
|
// In the column selection mode sort the begin and end of the selection,
|
|
// this makes the painting code simpler.
|
|
if (SelectionMode = smColumn) and (nSelCol1 > nSelCol2) then
|
|
SwapInt(nSelCol1, nSelCol2);
|
|
if bAnySelection then begin
|
|
// Transform the selection from text space into screen space
|
|
p := LogicalToPhysicalPos(Point(nSelCol1, nSelL1));
|
|
nSelCol1 := p.x;
|
|
nSelL1 := p.y;
|
|
p := LogicalToPhysicalPos(point(nSelCol2, nSelL2));
|
|
nSelCol2 := p.x;
|
|
nSelL2 := p.y;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetDrawingColors(Selected: boolean);
|
|
begin
|
|
with fTextDrawer do
|
|
if Selected then begin
|
|
SetBackColor(colSelBG);
|
|
SetForeColor(colSelFG);
|
|
end else begin
|
|
SetBackColor(colBG);
|
|
SetForeColor(colFG);
|
|
end;
|
|
end;
|
|
|
|
function ColumnToXValue(Col: integer): integer;
|
|
// map screen column to screen pixel
|
|
begin
|
|
Result := fTextOffset + Pred(Col) * fCharWidth;
|
|
end;
|
|
|
|
procedure PaintToken(const Token: string;
|
|
TokenLen, CharsBefore, First, Last: integer);
|
|
// CharsBefore tells if Token starts at column one or not
|
|
var
|
|
pszText: PChar;
|
|
nCharsToPaint: integer;
|
|
nX: integer;
|
|
const
|
|
ETOOptions = ETO_CLIPPED or ETO_OPAQUE;
|
|
begin
|
|
if (Last >= First) and (rcToken.Right > rcToken.Left) then begin
|
|
nX := ColumnToXValue(First);
|
|
Dec(First, CharsBefore);
|
|
Dec(Last, CharsBefore);
|
|
if (First > TokenLen) then begin
|
|
pszText := nil;
|
|
nCharsToPaint := 0;
|
|
end else begin
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (First > 1) and (ByteType(Token, First) = mbTrailByte) then begin
|
|
Dec(First);
|
|
Dec(nX, fCharWidth);
|
|
end;
|
|
{$ENDIF}
|
|
pszText := PChar(@Token[First]);
|
|
nCharsToPaint := Min(Last - First + 1, TokenLen - First + 1);
|
|
end;
|
|
fTextDrawer.ExtTextOut(nX, rcToken.Top, ETOOptions, rcToken,
|
|
pszText, nCharsToPaint);
|
|
rcToken.Left := rcToken.Right;
|
|
end;
|
|
end;
|
|
|
|
procedure PaintHighlightToken(bFillToEOL: boolean);
|
|
var
|
|
bComplexToken: boolean;
|
|
nC1, nC2, nC1Sel, nC2Sel: integer;
|
|
bU1, bSel, bU2: boolean;
|
|
nX1, nX2: integer;
|
|
begin
|
|
// Compute some helper variables.
|
|
nC1 := Max(FirstCol, TokenAccu.CharsBefore + 1);
|
|
nC2 := Min(LastCol, TokenAccu.CharsBefore + TokenAccu.Len + 1);
|
|
if bComplexLine then begin
|
|
bU1 := (nC1 < nSelStart);
|
|
bSel := (nC1 < nSelEnd) and (nC2 >= nSelStart);
|
|
bU2 := (nC2 >= nSelEnd);
|
|
bComplexToken := bSel and (bU1 or bU2);
|
|
end else begin
|
|
bU1 := FALSE; // to shut up Compiler warning Delphi 2
|
|
bSel := bLineSelected;
|
|
bU2 := FALSE; // to shut up Compiler warning Delphi 2
|
|
bComplexToken := FALSE;
|
|
end;
|
|
// Any token chars accumulated?
|
|
if (TokenAccu.Len > 0) then begin
|
|
// Initialize the colors and the font style.
|
|
if not bSpecialLine then begin
|
|
colBG := TokenAccu.BG;
|
|
colFG := TokenAccu.FG;
|
|
end;
|
|
fTextDrawer.SetStyle(TokenAccu.Style);
|
|
// Paint the chars
|
|
if bComplexToken then begin
|
|
// first unselected part of the token
|
|
if bU1 then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := ColumnToXValue(nSelStart);
|
|
with TokenAccu do PaintToken(s, Len, CharsBefore, nC1, nSelStart);
|
|
end;
|
|
// selected part of the token
|
|
SetDrawingColors(TRUE);
|
|
nC1Sel := Max(nSelStart, nC1);
|
|
nC2Sel := Min(nSelEnd, nC2);
|
|
rcToken.Right := ColumnToXValue(nC2Sel);
|
|
with TokenAccu do PaintToken(s, Len, CharsBefore, nC1Sel, nC2Sel);
|
|
// second unselected part of the token
|
|
if bU2 then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := ColumnToXValue(nC2);
|
|
with TokenAccu do PaintToken(s, Len, CharsBefore, nSelEnd, nC2);
|
|
end;
|
|
end else begin
|
|
SetDrawingColors(bSel);
|
|
rcToken.Right := ColumnToXValue(nC2);
|
|
with TokenAccu do PaintToken(s, Len, CharsBefore, nC1, nC2);
|
|
end;
|
|
end;
|
|
// Fill the background to the end of this line if necessary.
|
|
if bFillToEOL and (rcToken.Left < rcLine.Right) then begin
|
|
if not bSpecialLine then colBG := colEditorBG;
|
|
if bComplexLine then begin
|
|
nX1 := ColumnToXValue(nSelStart);
|
|
nX2 := ColumnToXValue(nSelEnd);
|
|
if (rcToken.Left < nX1) then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := nX1;
|
|
InternalFillRect(dc, rcToken);
|
|
rcToken.Left := nX1;
|
|
end;
|
|
if (rcToken.Left < nX2) then begin
|
|
SetDrawingColors(TRUE);
|
|
rcToken.Right := nX2;
|
|
InternalFillRect(dc, rcToken);
|
|
rcToken.Left := nX2;
|
|
end;
|
|
if (rcToken.Left < rcLine.Right) then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Right := rcLine.Right;
|
|
InternalFillRect(dc, rcToken);
|
|
end;
|
|
end else begin
|
|
SetDrawingColors(bLineSelected);
|
|
rcToken.Right := rcLine.Right;
|
|
InternalFillRect(dc, rcToken);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure AddHighlightToken(
|
|
const Token: AnsiString;
|
|
CharsBefore, TokenLen: integer;
|
|
Foreground, Background: TColor;
|
|
Style: TFontStyles);
|
|
var
|
|
bCanAppend: boolean;
|
|
bSpacesTest, bIsSpaces: boolean;
|
|
i: integer;
|
|
|
|
function TokenIsSpaces: boolean;
|
|
var
|
|
pTok: PChar;
|
|
begin
|
|
if not bSpacesTest then begin
|
|
bSpacesTest := TRUE;
|
|
pTok := PChar(Token);
|
|
while (pTok^ <> #0) do begin
|
|
if (pTok^ <> ' ') then break;
|
|
Inc(pTok);
|
|
end;
|
|
bIsSpaces := (pTok^ = #0);
|
|
end;
|
|
Result := bIsSpaces;
|
|
end;
|
|
|
|
begin
|
|
if Background = clNone then Background := colEditorBG;
|
|
if Foreground = clNone then Foreground := Font.Color;
|
|
// Do we have to paint the old chars first, or can we just append?
|
|
bCanAppend := FALSE;
|
|
bSpacesTest := FALSE;
|
|
if (TokenAccu.Len > 0) then begin
|
|
// font style must be the same or token is only spaces
|
|
if (TokenAccu.Style = Style)
|
|
or (not (fsUnderline in Style) and not (fsUnderline in TokenAccu.Style)
|
|
and TokenIsSpaces)
|
|
then
|
|
// either special colors or same colors
|
|
if bSpecialLine or bLineSelected or
|
|
// background color must be the same and
|
|
((TokenAccu.BG = Background) and
|
|
// foreground color must be the same or token is only spaces
|
|
((TokenAccu.FG = Foreground) or TokenIsSpaces))
|
|
then
|
|
bCanAppend := TRUE;
|
|
// If we can't append it, then we have to paint the old token chars first.
|
|
if not bCanAppend then
|
|
PaintHighlightToken(FALSE);
|
|
end;
|
|
// Don't use AppendStr because it's more expensive.
|
|
if bCanAppend then begin
|
|
if (TokenAccu.Len + TokenLen > TokenAccu.MaxLen) then begin
|
|
TokenAccu.MaxLen := TokenAccu.Len + TokenLen + 32;
|
|
SetLength(TokenAccu.s, TokenAccu.MaxLen);
|
|
end;
|
|
for i := 1 to TokenLen do begin
|
|
TokenAccu.s[TokenAccu.Len + i] := Token[i];
|
|
end;
|
|
Inc(TokenAccu.Len, TokenLen);
|
|
end else begin
|
|
TokenAccu.Len := TokenLen;
|
|
if (TokenAccu.Len > TokenAccu.MaxLen) then begin
|
|
TokenAccu.MaxLen := TokenAccu.Len + 32;
|
|
SetLength(TokenAccu.s, TokenAccu.MaxLen);
|
|
end;
|
|
for i := 1 to TokenLen do begin
|
|
TokenAccu.s[i] := Token[i];
|
|
end;
|
|
TokenAccu.CharsBefore := CharsBefore;
|
|
TokenAccu.FG := Foreground;
|
|
TokenAccu.BG := Background;
|
|
TokenAccu.Style := Style;
|
|
end;
|
|
end;
|
|
|
|
procedure PaintLines;
|
|
var
|
|
nLine: integer; // line index for the loop
|
|
sLine: string; // the current line (expanded)
|
|
// pConvert: TConvertTabsProc; //mh 2000-10-19
|
|
sToken: string; // highlighter token info
|
|
nTokenPos, nTokenLen: integer;
|
|
attr: TSynHighlighterAttributes;
|
|
begin
|
|
// Initialize rcLine for drawing. Note that Top and Bottom are updated
|
|
// inside the loop. Get only the starting point for this.
|
|
rcLine := AClip;
|
|
rcLine.Bottom := (FirstLine - TopLine) * fTextHeight;
|
|
// Make sure the token accumulator string doesn't get reassigned to often.
|
|
if Assigned(fHighlighter) then begin
|
|
TokenAccu.MaxLen := Max(128, fCharsInWindow);
|
|
SetLength(TokenAccu.s, TokenAccu.MaxLen);
|
|
end;
|
|
{begin} //mh 2000-10-19
|
|
// Find the fastest function for the tab expansion.
|
|
// pConvert := GetBestConvertTabsProc(fTabWidth);
|
|
// Now loop through all the lines. The indices are valid for Lines.
|
|
for nLine := FirstLine to LastLine do begin
|
|
// Get the expanded line.
|
|
// sLine := pConvert(Lines[nLine - 1], fTabWidth);
|
|
sLine := TSynEditStringList(Lines).ExpandedStrings[nLine - 1];
|
|
{end} //mh 2000-10-19
|
|
// Get the information about the line selection. Three different parts
|
|
// are possible (unselected before, selected, unselected after), only
|
|
// unselected or only selected means bComplexLine will be FALSE. Start
|
|
// with no selection, compute based on the visible columns.
|
|
bComplexLine := FALSE;
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
// Does the selection intersect the visible area?
|
|
if bAnySelection and (nLine >= nSelL1) and (nLine <= nSelL2) then begin
|
|
// Default to a fully selected line. This is correct for the smLine
|
|
// selection mode and a good start for the smNormal mode.
|
|
nSelStart := FirstCol;
|
|
nSelEnd := LastCol + 1;
|
|
if (SelectionMode = smColumn) or
|
|
((SelectionMode = smNormal) and (nLine = nSelL1))
|
|
then
|
|
if (nSelCol1 > LastCol) then begin
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
end else if (nSelCol1 > FirstCol) then begin
|
|
nSelStart := nSelCol1;
|
|
bComplexLine := TRUE;
|
|
end;
|
|
if (SelectionMode = smColumn) or
|
|
((SelectionMode = smNormal) and (nLine = nSelL2))
|
|
then
|
|
if (nSelCol2 < FirstCol) then begin
|
|
nSelStart := 0;
|
|
nSelEnd := 0;
|
|
end else if (nSelCol2 < LastCol) then begin
|
|
nSelEnd := nSelCol2;
|
|
bComplexLine := TRUE;
|
|
end;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (SelectionMode = smColumn) then
|
|
MBCSGetSelRangeInLineWhenColumnSelectionMode(sLine, nSelStart,
|
|
nSelEnd);
|
|
{$ENDIF}
|
|
end;
|
|
// Update the rcLine rect to this line.
|
|
rcLine.Top := rcLine.Bottom;
|
|
Inc(rcLine.Bottom, fTextHeight);
|
|
// Initialize the text and background colors, maybe the line should
|
|
// use special values for them.
|
|
colFG := Font.Color;
|
|
colBG := colEditorBG;
|
|
bSpecialLine := DoOnSpecialLineColors(nLine, colFG, colBG);
|
|
if bSpecialLine then begin
|
|
// The selection colors are just swapped, like seen in Delphi.
|
|
colSelFG := colBG;
|
|
colSelBG := colFG;
|
|
end else begin
|
|
colSelFG := fSelectedColor.Foreground;
|
|
colSelBG := fSelectedColor.Background;
|
|
end;
|
|
// Paint the lines depending on the assigned highlighter.
|
|
bLineSelected := not bComplexLine and (nSelStart > 0);
|
|
rcToken := rcLine;
|
|
if not Assigned(fHighlighter) then begin
|
|
// Note: The PaintToken procedure will take care of invalid parameters
|
|
// like empty token rect or invalid indices into sLine.
|
|
nTokenLen := Length(sLine);
|
|
if bComplexLine then begin
|
|
SetDrawingColors(FALSE);
|
|
rcToken.Left := Max(rcLine.Left, ColumnToXValue(FirstCol));
|
|
rcToken.Right := Min(rcLine.Right, ColumnToXValue(nSelStart));
|
|
PaintToken(sLine, nTokenLen, 0, FirstCol, nSelStart);
|
|
rcToken.Left := Max(rcLine.Left, ColumnToXValue(nSelEnd));
|
|
rcToken.Right := Min(rcLine.Right, ColumnToXValue(LastCol));
|
|
PaintToken(sLine, nTokenLen, 0, nSelEnd, LastCol);
|
|
SetDrawingColors(TRUE);
|
|
rcToken.Left := Max(rcLine.Left, ColumnToXValue(nSelStart));
|
|
rcToken.Right := Min(rcLine.Right, ColumnToXValue(nSelEnd));
|
|
PaintToken(sLine, nTokenLen, 0, nSelStart, nSelEnd);
|
|
end else begin
|
|
SetDrawingColors(bLineSelected);
|
|
PaintToken(sLine, nTokenLen, 0, FirstCol, LastCol);
|
|
end;
|
|
end else begin
|
|
// Initialize highlighter with line text and range info. It is
|
|
// necessary because we probably did not scan to the end of the last
|
|
// line - the internal highlighter range might be wrong.
|
|
// fHighlighter.SetRange(Lines.Objects[nLine - 1]);
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[nLine - 1]); //mh 2000-10-10
|
|
fHighlighter.SetLine(sLine, nLine - 1);
|
|
// Try to concatenate as many tokens as possible to minimize the count
|
|
// of ExtTextOut calls necessary. This depends on the selection state
|
|
// or the line having special colors. For spaces the foreground color
|
|
// is ignored as well.
|
|
TokenAccu.Len := 0;
|
|
while not fHighlighter.GetEol do begin
|
|
// Test first whether anything of this token is visible.
|
|
nTokenPos := fHighlighter.GetTokenPos; // zero-based
|
|
sToken := fHighlighter.GetToken;
|
|
nTokenLen := Length(sToken);
|
|
if (nTokenPos + nTokenLen >= FirstCol) then begin
|
|
// It's at least partially visible. Get the token attributes now.
|
|
attr := fHighlighter.GetTokenAttribute;
|
|
// Store the token chars with the attributes in the TokenAccu
|
|
// record. This will paint any chars already stored if there is
|
|
// a (visible) change in the attributes.
|
|
if Assigned(attr) then
|
|
AddHighlightToken(sToken, nTokenPos, nTokenLen, attr.Foreground,
|
|
attr.Background, attr.Style)
|
|
else
|
|
AddHighlightToken(sToken, nTokenPos, nTokenLen, colFG, colBG,
|
|
Font.Style);
|
|
end;
|
|
// Let the highlighter scan the next token.
|
|
fHighlighter.Next;
|
|
end;
|
|
// Draw anything that's left in the TokenAccu record. Fill to the end
|
|
// of the invalid area with the correct colors.
|
|
PaintHighlightToken(TRUE);
|
|
end;
|
|
// Now paint the right edge if necessary. We do it line by line to reduce
|
|
// the flicker. Should not cost very much anyway, compared to the many
|
|
// calls to ExtTextOut.
|
|
if bDoRightEdge then begin
|
|
Windows.MoveToEx(dc, nRightEdge, rcLine.Top, nil);
|
|
Windows.LineTo(dc, nRightEdge, rcLine.Bottom + 1);
|
|
//codefold draw splitter line
|
|
ypos := rcToken.Bottom - 1;
|
|
nLine := PixelsToRowColumn(Point(0, ypos)).Y;
|
|
if TSynEditStringList(Lines).FoldType[nLine] in [cfEnd] then
|
|
begin
|
|
Windows.MoveToEx(dc, nRightEdge, ypos, nil);
|
|
Windows.LineTo(dc, fGutterWidth, ypos);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ end local procedures }
|
|
|
|
begin
|
|
colEditorBG := Color;
|
|
if Assigned(Highlighter) and Assigned(Highlighter.WhitespaceAttribute) then
|
|
begin
|
|
colBG := Highlighter.WhitespaceAttribute.Background;
|
|
if colBG <> clNone then
|
|
colEditorBG := colBG;
|
|
end;
|
|
// If the right edge is visible and in the invalid area, prepare to paint it.
|
|
// Do this first to realize the pen when getting the dc variable.
|
|
bDoRightEdge := FALSE;
|
|
if (fRightEdge > 0) then begin // column value
|
|
nRightEdge := fTextOffset + fRightEdge * fCharWidth; // pixel value
|
|
if (nRightEdge >= AClip.Left) and (nRightEdge <= AClip.Right) then begin
|
|
bDoRightEdge := TRUE;
|
|
Canvas.Pen.Color := fRightEdgeColor;
|
|
Canvas.Pen.Width := 1;
|
|
end;
|
|
end;
|
|
// Do everything else with API calls. This (maybe) realizes the new pen color.
|
|
dc := Canvas.Handle;
|
|
|
|
// If anything of the two pixel space before the text area is visible, then
|
|
// fill it with the component background color.
|
|
if (AClip.Left < fGutterWidth + 2) then begin
|
|
rcToken := AClip;
|
|
rcToken.Left := Max(AClip.Left, fGutterWidth);
|
|
rcToken.Right := fGutterWidth + 2;
|
|
SetBkColor(dc,ColorToRGB(colEditorBG));
|
|
InternalFillRect(dc, rcToken);
|
|
// Adjust the invalid area to not include this area.
|
|
AClip.Left := rcToken.Right;
|
|
end;
|
|
if (LastLine >= FirstLine) then begin
|
|
// Paint the visible text lines. To make this easier, compute first the
|
|
// necessary information about the selected area: is there any visible
|
|
// selected area, and what are its lines / columns?
|
|
// Moved to two local procedures to make it easier to read.
|
|
ComputeSelectionInfo;
|
|
fTextDrawer.Style := Font.Style;
|
|
fTextDrawer.BeginDrawing(dc);
|
|
try
|
|
PaintLines;
|
|
finally
|
|
fTextDrawer.EndDrawing;
|
|
end;
|
|
end;
|
|
|
|
// If there is anything visible below the last line, then fill this as well.
|
|
rcToken := AClip;
|
|
rcToken.Top := (LastLine - TopLine + 1) * fTextHeight;
|
|
if (rcToken.Top < rcToken.Bottom) then begin
|
|
SetBkColor(dc, ColorToRGB(colEditorBG));
|
|
InternalFillRect(dc, rcToken);
|
|
// Draw the right edge if necessary.
|
|
if bDoRightEdge and (not (eoHideRightMargin in Options)) then begin
|
|
Windows.MoveToEx(dc, nRightEdge, rcToken.Top, nil);
|
|
Windows.LineTo(dc, nRightEdge, rcToken.Bottom + 1);
|
|
|
|
//codefold draw splitter line
|
|
ypos := rcToken.Bottom - 1;
|
|
nLine := PixelsToRowColumn(Point(0, ypos)).Y;
|
|
if TSynEditStringList(Lines).FoldType[nLine] in [cfEnd] then
|
|
begin
|
|
Windows.MoveToEx(dc, nRightEdge, ypos, nil);
|
|
Windows.LineTo(dc, fGutterWidth, ypos);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF not SYN_LAZARUS}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.StartPaintBuffer(const ClipRect: TRect);
|
|
{$IFDEF EnableDoubleBuf}
|
|
var
|
|
NewBufferWidth: Integer;
|
|
NewBufferHeight: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
if (SavedCanvas<>nil) then RaiseGDBException('');
|
|
{$IFDEF EnableDoubleBuf}
|
|
if BufferBitmap=nil then
|
|
BufferBitmap:=TBitmap.Create;
|
|
NewBufferWidth:=BufferBitmap.Width;
|
|
NewBufferHeight:=BufferBitmap.Height;
|
|
if NewBufferWidth<ClipRect.Right then
|
|
NewBufferWidth:=ClipRect.Right;
|
|
if NewBufferHeight<ClipRect.Bottom then
|
|
NewBufferHeight:=ClipRect.Bottom;
|
|
BufferBitmap.Width:=NewBufferWidth;
|
|
BufferBitmap.Height:=NewBufferHeight;
|
|
SavedCanvas:=Canvas;
|
|
Canvas:=BufferBitmap.Canvas;
|
|
{$ENDIF}
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.EndPaintBuffer(const ClipRect: TRect);
|
|
begin
|
|
{$IFDEF EnableDoubleBuf}
|
|
if (SavedCanvas=nil) then RaiseGDBException('');
|
|
if not (SavedCanvas is TControlCanvas) then RaiseGDBException('');
|
|
Canvas:=SavedCanvas;
|
|
SavedCanvas:=nil;
|
|
Canvas.CopyRect(ClipRect,BufferBitmap.Canvas,ClipRect);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.EraseBackground(DC: HDC);
|
|
begin
|
|
// we are painting everything ourselves, so not need to erase background
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.Update;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Invalidate;
|
|
{$ELSE}
|
|
Paint;
|
|
inherited Update;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.Invalidate;
|
|
begin
|
|
//DebugLn('TCustomSynEdit.Invalidate A');
|
|
//RaiseGDBException('');
|
|
{$IFDEF SYN_LAZARUS}
|
|
fMarkupHighAll.InvalidateScreenLines(0, LinesInWindow+1);
|
|
{$ENDIF}
|
|
inherited Invalidate;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.PasteFromClipboard;
|
|
var
|
|
StartOfBlock: TPoint;
|
|
EndOfBlock: TPoint;
|
|
{$IFDEF SYN_LAZARUS}
|
|
MemStream: TMemoryStream;
|
|
Buf: Pointer;
|
|
BufSize: integer;
|
|
{$ELSE}
|
|
Mem: HGLOBAL;
|
|
{$ENDIF}
|
|
PasteMode: TSynSelectionMode;
|
|
P: PChar;
|
|
DummyTag: Integer;
|
|
begin
|
|
BeginUndoBlock; //mh 2000-11-20
|
|
try
|
|
// Check for our special format first.
|
|
if Clipboard.HasFormat(SynEditClipboardFormat) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
MemStream:=TMemoryStream.Create;
|
|
Buf:=nil;
|
|
try
|
|
Clipboard.GetFormat(SynEditClipboardFormat,MemStream);
|
|
BufSize:=integer(MemStream.Size);
|
|
if BufSize>=SizeOf(TSynSelectionMode)+1 then begin
|
|
GetMem(Buf,BufSize+1);
|
|
MemStream.Position:=0;
|
|
MemStream.Read(Buf^,BufSize);
|
|
P:=PChar(Buf);
|
|
P[BufSize]:=#0;
|
|
{$ELSE}
|
|
Clipboard.Open;
|
|
try
|
|
Mem := Clipboard.GetAsHandle(SynEditClipboardFormat);
|
|
P := GlobalLock(Mem);
|
|
if P <> nil then begin
|
|
{$ENDIF}
|
|
if SelAvail then begin
|
|
// fUndoList.AddChange(crSelDelete, fBlockBegin, fBlockEnd, SelText,
|
|
// SelectionMode);
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText, //mh 2000-11-20
|
|
SelectionMode);
|
|
end;
|
|
// Our format: SelectionMode value followed by text.
|
|
// See CopyToClipboard
|
|
PasteMode := PSynSelectionMode(P)^;
|
|
inc(P, SizeOf(TSynSelectionMode));
|
|
if SelAvail then begin
|
|
StartOfBlock := minPoint(fBlockBegin, fBlockEnd);
|
|
EndOfBlock := maxPoint(fBlockBegin, fBlockEnd);
|
|
fBlockBegin := StartOfBlock;
|
|
fBlockEnd := EndOfBlock;
|
|
if SelectionMode = smLine then
|
|
// Pasting always occurs at column 0 when current selection is
|
|
// smLine type
|
|
StartOfBlock.X := 1;
|
|
end else
|
|
StartOfBlock := {$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(CaretXY);
|
|
{$ELSE}
|
|
Point(CaretX, CaretY);
|
|
{$ENDIF}
|
|
DummyTag := 0;
|
|
SetSelTextPrimitive(PasteMode, P, @DummyTag);
|
|
EndOfBlock := BlockEnd;
|
|
if PasteMode <> smLine then
|
|
fUndoList.AddChange(crPaste, StartOfBlock, EndOfBlock, SelText,
|
|
PasteMode)
|
|
else
|
|
if CaretX = 1 then
|
|
fUndoList.AddChange(crPaste, Point(1, StartOfBlock.y),
|
|
Point(CharsInWindow, EndOfBlock.y - 1), SelText, smLine)
|
|
else
|
|
fUndoList.AddChange(crPaste, Point(1, StartOfBlock.y),
|
|
EndOfBlock, SelText, smNormal);
|
|
if PasteMode = smColumn then
|
|
CaretXY := Point(Min(StartOfBlock.X, EndOfBlock.X),
|
|
Max(StartOfBlock.Y, EndOfBlock.Y) + 1);
|
|
end else
|
|
raise ESynEditError.Create('Clipboard paste operation failed.');
|
|
finally
|
|
{$IFDEF SYN_LAZARUS}
|
|
MemStream.Free;
|
|
if Buf<>nil then FreeMem(Buf);
|
|
{$ELSE}
|
|
Clipboard.Close;
|
|
{$ENDIF}
|
|
end;
|
|
// If our special format isn't there, check for regular text format.
|
|
end else if Clipboard.HasFormat(CF_TEXT) then begin
|
|
// Normal text is much easier...
|
|
if SelAvail then begin
|
|
// fUndoList.AddChange(crSelDelete, fBlockBegin, fBlockEnd, SelText,
|
|
// SelectionMode);
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText, //mh 2000-11-20
|
|
SelectionMode);
|
|
end;
|
|
StartOfBlock := minPoint(fBlockBegin, fBlockEnd);
|
|
EndOfBlock := maxPoint(fBlockBegin, fBlockEnd);
|
|
fBlockBegin := StartOfBlock;
|
|
fBlockEnd := EndOfBlock;
|
|
LockUndo;
|
|
SelText := Clipboard.AsText;
|
|
UnlockUndo;
|
|
fUndoList.AddChange(crPaste, StartOfBlock, BlockEnd, SelText, smNormal);
|
|
end;
|
|
finally
|
|
EndUndoBlock; //mh 2000-11-20
|
|
end;
|
|
EnsureCursorPosVisible;
|
|
// Selection should have changed...
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SelectAll;
|
|
var
|
|
LastPt: TPoint;
|
|
begin
|
|
LastPt := Point(1, Lines.Count);
|
|
if LastPt.y > 0 then
|
|
Inc(LastPt.x, Length(Lines[LastPt.y - 1]))
|
|
else
|
|
LastPt.y := 1;
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(LastPt),
|
|
{$ELSE}
|
|
LastPt,
|
|
{$ENDIF}
|
|
Point(1, 1), LastPt);
|
|
// Selection should have changed...
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetHighlightSearch(const ASearch : String; AOptions : TSynSearchOptions);
|
|
begin
|
|
fMarkupHighAll.SearchOptions := AOptions;
|
|
fMarkupHighAll.SearchString := ASearch;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SelectToBrace;
|
|
begin
|
|
FindMatchingBracket(CaretXY,true,true,true,false);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SelectLine;
|
|
begin
|
|
SetLineBlock(CaretXY);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SelectParagraph;
|
|
begin
|
|
SetParagraphBlock(CaretXY);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetBlockBegin(Value: TPoint);
|
|
// logical position (byte)
|
|
var
|
|
nInval1, nInval2: integer;
|
|
SelChanged: boolean;
|
|
begin
|
|
Value.x := MinMax(Value.x, 1, fMaxLeftChar);
|
|
Value.y := MinMax(Value.y, 1, Lines.Count);
|
|
if (SelectionMode = smNormal) then
|
|
if (Value.y >= 1) and (Value.y <= Lines.Count) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Value.x := AdjustBytePosToCharacterStart(Value.y,Value.x);
|
|
{$ELSE}
|
|
Value.x := Min(Value.x, Length(Lines[Value.y - 1]) + 1);
|
|
{$ENDIF}
|
|
end else
|
|
Value.x := 1;
|
|
if SelAvail then begin
|
|
if fBlockBegin.Y < fBlockEnd.Y then begin
|
|
nInval1 := Min(Value.Y, fBlockBegin.Y);
|
|
nInval2 := Max(Value.Y, fBlockEnd.Y);
|
|
end else begin
|
|
nInval1 := Min(Value.Y, fBlockEnd.Y);
|
|
nInval2 := Max(Value.Y, fBlockBegin.Y);
|
|
end;
|
|
fBlockBegin := Value;
|
|
fBlockEnd := Value;
|
|
InvalidateLines(nInval1, nInval2);
|
|
SelChanged := TRUE;
|
|
end else begin
|
|
SelChanged := (fBlockBegin.X <> Value.X) or (fBlockBegin.Y <> Value.Y) or
|
|
(fBlockEnd.X <> Value.X) or (fBlockEnd.Y <> Value.Y);
|
|
fBlockBegin := Value;
|
|
fBlockEnd := Value;
|
|
end;
|
|
if SelChanged then
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetBlockEnd(Value: TPoint);
|
|
// logical position (byte)
|
|
var
|
|
nLine: integer;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
s: string;
|
|
{$ENDIF}
|
|
begin
|
|
if not (eoNoSelection in Options) then begin
|
|
Value.x := MinMax(Value.x, 1, fMaxLeftChar);
|
|
Value.y := MinMax(Value.y, 1, Lines.Count);
|
|
if (SelectionMode = smNormal) then
|
|
if (Value.y >= 1) and (Value.y <= Lines.Count) then
|
|
{$IFDEF SYN_LAZARUS}
|
|
Value.x := AdjustBytePosToCharacterStart(Value.y,Value.x)
|
|
{$ELSE}
|
|
Value.x := Min(Value.x, Length(Lines[Value.y - 1]) + 1)
|
|
{$ENDIF}
|
|
else
|
|
Value.x := 1;
|
|
if (Value.X <> fBlockEnd.X) or (Value.Y <> fBlockEnd.Y) then begin
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if Value.Y <= Lines.Count then begin
|
|
s := Lines[Value.Y - 1];
|
|
if (Length(s) >= Value.X) and (mbTrailByte = ByteType(s, Value.X)) then
|
|
Dec(Value.X);
|
|
end;
|
|
{$ENDIF}
|
|
if (Value.X <> fBlockEnd.X) or (Value.Y <> fBlockEnd.Y) then begin
|
|
if (SelectionMode = smColumn) and (Value.X <> fBlockEnd.X) then begin
|
|
InvalidateLines(
|
|
Min(fBlockBegin.Y, Min(fBlockEnd.Y, Value.Y)),
|
|
Max(fBlockBegin.Y, Max(fBlockEnd.Y, Value.Y)));
|
|
fBlockEnd := Value;
|
|
end else begin
|
|
nLine := fBlockEnd.Y;
|
|
fBlockEnd := Value;
|
|
if (SelectionMode <> smColumn) or (fBlockBegin.X <> fBlockEnd.X) then
|
|
InvalidateLines(nLine, fBlockEnd.Y);
|
|
end;
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetBlockIndent(const AValue: integer);
|
|
begin
|
|
if fBlockIndent=AValue then exit;
|
|
fBlockIndent:=AValue;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetCaretX(Value: Integer);
|
|
begin
|
|
SetCaretXY(Point(Value, CaretY));
|
|
fLastCaretX := CaretX; //mh 2000-10-19
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetCaretY(Value: Integer);
|
|
begin
|
|
if not (eoKeepCaretX in Options) then begin //mh 2000-11-08
|
|
fLastCaretX := fCaretX;
|
|
end;
|
|
SetCaretXY(Point(fLastCaretX{CaretX}, Value)); //mh 2000-10-19
|
|
end;
|
|
|
|
function TCustomSynEdit.GetCaretXY: TPoint;
|
|
begin
|
|
Result := Point(CaretX, CaretY);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetCaretXY(Value: TPoint);
|
|
// physical position (screen)
|
|
var
|
|
nMaxX: integer;
|
|
{$IFDEF SYN_LAZARUS}
|
|
Line: string;
|
|
{$ENDIF}
|
|
begin
|
|
nMaxX := fMaxLeftChar;
|
|
if Value.Y > Lines.Count then
|
|
Value.Y := Lines.Count;
|
|
if Value.Y < 1 then begin
|
|
// this is just to make sure if Lines stringlist should be empty
|
|
Value.Y := 1;
|
|
if not (eoScrollPastEol in fOptions) then
|
|
nMaxX := 1;
|
|
end else begin
|
|
if not (eoScrollPastEol in fOptions) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Line:=Lines[Value.Y-1];
|
|
nMaxX := PhysicalLineLength(PChar(Line),length(Line),true)+1;
|
|
{$ELSE}
|
|
nMaxX := Length(Lines[Value.Y - 1]) + 1; //abc 2000-09-30
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
if Value.X > nMaxX then
|
|
Value.X := nMaxX;
|
|
if Value.X < 1 then
|
|
Value.X := 1;
|
|
if (Value.X <> fCaretX) or (Value.Y <> fCaretY) then begin
|
|
IncPaintLock;
|
|
try
|
|
// simply include the flags, fPaintLock is > 0
|
|
if fCaretX <> Value.X then begin
|
|
fCaretX := Value.X;
|
|
Include(fStatusChanges, scCaretX);
|
|
end;
|
|
if fCaretY <> Value.Y then begin
|
|
fCaretY := Value.Y;
|
|
Include(fStatusChanges, scCaretY);
|
|
end;
|
|
EnsureCursorPosVisible;
|
|
Include(fStateFlags, sfCaretChanged);
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$ELSE}
|
|
Include(fStateFlags, sfScrollbarChanged);
|
|
{$ENDIF}
|
|
finally
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fLastCaretX:=fCaretX;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetFont(const Value: TFont);
|
|
var
|
|
DC: HDC;
|
|
Save: THandle;
|
|
Metrics: TTextMetric;
|
|
AveCW, MaxCW: Integer;
|
|
begin
|
|
DebugLn('TCustomSynEdit.SetFont--------------------------------------------');
|
|
DebugLn(' TCustomSynEdit.SetFont A1',Value.Name);
|
|
DC := GetDC(0);
|
|
Save := SelectObject(DC, Value.Handle);
|
|
DebugLn(' TCustomSynEdit.SetFont A2',Value.Name);
|
|
GetTextMetrics(DC, Metrics);
|
|
SelectObject(DC, Save);
|
|
ReleaseDC(0, DC);
|
|
with Metrics do begin
|
|
AveCW := tmAveCharWidth;
|
|
MaxCW := tmMaxCharWidth;
|
|
end;
|
|
DebugLn(Format(' TCustomSynEdit.SetFont B %d,%d,%s', [AveCW,MaxCW, Value.Name]));
|
|
case AveCW = MaxCW of
|
|
True: inherited Font := Value;
|
|
False:
|
|
begin
|
|
with fFontDummy do begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
BeginUpdate;
|
|
{$ENDIF}
|
|
DebugLn(' TCustomSynEdit.SetFont C fFontDummy="',fFontDummy.Name,'"');
|
|
Color := Value.Color;
|
|
Pitch := fpFixed;
|
|
Size := Value.Size;
|
|
Style := Value.Style;
|
|
{$IFDEF SYN_LAZARUS}
|
|
EndUpdate;
|
|
{$ENDIF}
|
|
end;
|
|
DebugLn(Format(' TCustomSynEdit.SetFont D AveCW=%d MaxCW=%d Value="%s" Value.Size=%d Value.Height=%d DummyHeight=%d fFontDummy="%s"', [AveCW, MaxCW, Value.Name, Value.Size, Value.Height, fFontDummy.Height, fFontDummy.Name]));
|
|
inherited Font := fFontDummy;
|
|
end;
|
|
end;
|
|
DebugLn(Format(' TCustomSynEdit.SetFont E "%s" Height=%d AveCW=%d MaxCW=%d CharWidth=%d', [Font.Name, Font.Height, AveCW, MaxCW, CharWidth]));
|
|
if fGutter.ShowLineNumbers then GutterChanged(Self);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetGutterWidth(Value: Integer);
|
|
begin
|
|
Value := Max(Value, 0);
|
|
if fGutterWidth <> Value then begin
|
|
fGutterWidth := Value;
|
|
fTextOffset := fGutterWidth + 2 - (LeftChar - 1) * fCharWidth;
|
|
fBookmarkOpt.XOffset := Value - 18;
|
|
if HandleAllocated then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
fCharsInWindow := Max(1,(ClientWidth - fGutterWidth - 2 - ScrollBarWidth)
|
|
div fCharWidth);
|
|
//debugln('TCustomSynEdit.SetGutterWidth A ClientWidth=',dbgs(ClientWidth),' fGutterWidth=',dbgs(fGutterWidth),' ScrollBarWidth=',dbgs(ScrollBarWidth),' fCharWidth=',dbgs(fCharWidth));
|
|
{$ELSE}
|
|
fCharsInWindow := Max(1,Max(0,(ClientWidth - fGutterWidth - 2
|
|
- ScrollBarWidth) div Max(1,fCharWidth)));
|
|
{$ENDIF}
|
|
UpdateScrollBars;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetLeftChar(Value: Integer);
|
|
{begin} //mh 2000-10-19
|
|
var
|
|
MaxVal: integer;
|
|
begin
|
|
if eoScrollPastEol in Options then
|
|
MaxVal := fMaxLeftChar
|
|
else
|
|
MaxVal := TSynEditStringList(Lines).LengthOfLongestLine;
|
|
Value := Min(Value, MaxVal - fCharsInWindow + 1);
|
|
{end} //mh 2000-10-19
|
|
Value := Max(Value, 1);
|
|
if Value <> fLeftChar then begin
|
|
fLeftChar := Value;
|
|
fTextOffset := fGutterWidth + 2 - (LeftChar - 1) * fCharWidth;
|
|
UpdateScrollBars;
|
|
InvalidateLines(-1, -1);
|
|
StatusChanged([scLeftChar]);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetLines(Value: TStrings);
|
|
begin
|
|
if HandleAllocated then
|
|
Lines.Assign(Value);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetLineText(Value: string);
|
|
begin
|
|
if (CaretY >= 1) and (CaretY <= Max(1, Lines.Count)) then
|
|
Lines[CaretY - 1] := Value;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetName(const Value: TComponentName);
|
|
var
|
|
TextToName: boolean;
|
|
begin
|
|
TextToName := (ComponentState * [csDesigning, csLoading] = [csDesigning])
|
|
and (TrimRight(Text) = Name);
|
|
inherited SetName(Value);
|
|
if TextToName then
|
|
Text := Value;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetScrollBars(const Value: TScrollStyle);
|
|
begin
|
|
if (FScrollBars <> Value) then begin
|
|
FScrollBars := Value;
|
|
// TODO: MWE: check if there is a better solution in lazarus
|
|
// RecreateWnd is depriciated in Lazarus
|
|
RecreateWnd{$IFDEF SYN_LAZARUS}(Self){$ENDIF};
|
|
|
|
UpdateScrollBars;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetSelText(const Value: string);
|
|
begin
|
|
SetSelTextPrimitive(smNormal, PChar(Value), nil);
|
|
end;
|
|
|
|
// This is really a last minute change and I hope I did it right.
|
|
// Reason for this modification: next two lines will loose the CaretX position
|
|
// if eoScrollPastEol is not set in Options. That is not really a good idea
|
|
// as we would typically want the cursor to stay where it is.
|
|
// To fix this (in the absence of a better idea), I changed the code in
|
|
// DeleteSelection not to trim the string if eoScrollPastEol is not set.
|
|
procedure TCustomSynEdit.SetSelTextPrimitive(PasteMode: TSynSelectionMode;
|
|
Value: PChar; ATag: PInteger);
|
|
var
|
|
BB, BE: TPoint;
|
|
TempString: string;
|
|
|
|
procedure DeleteSelection;
|
|
var
|
|
x, MarkOffset: Integer;
|
|
UpdateMarks: boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
NewCaretXY: TPoint;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
l, r: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
UpdateMarks := FALSE;
|
|
MarkOffset := 0;
|
|
case SelectionMode of
|
|
smNormal:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
NewCaretXY:=LogicalToPhysicalPos(BB);
|
|
{$ENDIF}
|
|
if Lines.Count > 0 then begin
|
|
// Create a string that contains everything on the first line up
|
|
// to the selection mark, and everything on the last line after
|
|
// the selection mark.
|
|
TempString := Copy(Lines[BB.Y - 1], 1, BB.X - 1) +
|
|
Copy(Lines[BE.Y - 1], BE.X, MaxInt);
|
|
// Delete all lines in the selection range.
|
|
{begin} // djlp 2000-09-13
|
|
TSynEditStringList(Lines).DeleteLines(BB.Y-1, BE.Y - BB.Y);
|
|
// for x := BE.Y - 1 downto BB.Y do
|
|
// Lines.Delete(x);
|
|
{end} // djlp 2000-09-13
|
|
// Put the stuff that was outside of selection back in.
|
|
// if eoScrollPastEol in Options then //JGF 2000-09-23
|
|
if Options * [eoScrollPastEol, eoTrimTrailingSpaces]
|
|
= [eoScrollPastEol, eoTrimTrailingSpaces]
|
|
then
|
|
TempString := TrimRight(TempString);
|
|
Lines[BB.Y - 1] := TempString;
|
|
end;
|
|
UpdateMarks := TRUE;
|
|
CaretXY := {$IFDEF SYN_LAZARUS}NewCaretXY{$ELSE}BB{$ENDIF};
|
|
end;
|
|
smColumn:
|
|
begin
|
|
// swap X if needed
|
|
if BB.X > BE.X then
|
|
{$IFDEF SYN_COMPILER_3_UP}
|
|
SwapInt(BB.X, BE.X);
|
|
{$ELSE}
|
|
begin
|
|
x := BB.X;
|
|
BB.X := BE.X;
|
|
BE.X := x;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
NewCaretXY:=LogicalToPhysicalPos(Point(BB.X,fBlockEnd.Y));
|
|
{$ENDIF}
|
|
for x := BB.Y - 1 to BE.Y - 1 do begin
|
|
TempString := Lines[x];
|
|
{$IFNDEF SYN_MBCSSUPPORT}
|
|
Delete(TempString, BB.X, BE.X - BB.X);
|
|
{$ELSE}
|
|
l := BB.X;
|
|
r := BE.X;
|
|
MBCSGetSelRangeInLineWhenColumnSelectionMode(TempString, l, r);
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
VDelete(TempString, l, r - 1);
|
|
{$ELSE USE_UTF8BIDI_LCL}
|
|
Delete(TempString, l, r - l);
|
|
{$ENDIF USE_UTF8BIDI_LCL}
|
|
{$ENDIF}
|
|
TrimmedSetLine(x, TempString);
|
|
end;
|
|
// Lines never get deleted completely, so keep caret at end.
|
|
CaretXY := {$IFDEF SYN_LAZARUS}
|
|
NewCaretXY
|
|
{$ELSE}
|
|
Point(BB.X, fBlockEnd.Y)
|
|
{$ENDIF};
|
|
// Column deletion never removes a line entirely, so no mark
|
|
// updating is needed here.
|
|
end;
|
|
smLine:
|
|
begin
|
|
if BE.Y = Lines.Count then begin
|
|
Lines[BE.Y - 1] := '';
|
|
for x := BE.Y - 2 downto BB.Y - 1 do
|
|
Lines.Delete(x);
|
|
end else
|
|
for x := BE.Y - 1 downto BB.Y - 1 do
|
|
Lines.Delete(x);
|
|
// smLine deletion always resets to first column.
|
|
CaretXY := Point(1, BB.Y);
|
|
UpdateMarks := TRUE;
|
|
MarkOffset := 1;
|
|
end;
|
|
end;
|
|
// Update marks
|
|
if UpdateMarks then
|
|
DoLinesDeleted(BB.Y, BE.Y - BB.Y + MarkOffset);
|
|
end;
|
|
|
|
procedure InsertText;
|
|
|
|
{begin} // djlp 2000-09-07
|
|
function CountLines(p: PChar): integer;
|
|
begin
|
|
Result := 0;
|
|
while p^ <> #0 do begin
|
|
if p^ = #13 then
|
|
Inc(p);
|
|
if p^ = #10 then
|
|
Inc(p);
|
|
Inc(Result);
|
|
p := GetEOL(p);
|
|
end;
|
|
end;
|
|
{end}
|
|
|
|
function InsertNormal: Integer;
|
|
var
|
|
sLeftSide: string;
|
|
sRightSide: string;
|
|
Str: string;
|
|
Start: PChar;
|
|
P: PChar;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY: TPoint;
|
|
PhysicalLineEndPos: LongInt;
|
|
{$ENDIF}
|
|
begin
|
|
Result := 0;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
sLeftSide := Copy(LineText, 1, LogCaretXY.X - 1);
|
|
if LogCaretXY.X - 1 > Length(sLeftSide) then begin
|
|
PhysicalLineEndPos:=
|
|
LogicalToPhysicalPos(Point(Length(sLeftSide)+1,CaretY)).X-1;
|
|
sLeftSide := sLeftSide
|
|
+ CreateTabsAndSpaces(CaretX,
|
|
CaretX-1-PhysicalLineEndPos,TabWidth,
|
|
eoSpacesToTabs in Options);
|
|
end;
|
|
sRightSide := Copy(LineText, LogCaretXY.X,
|
|
Length(LineText) - (LogCaretXY.X - 1));
|
|
{$ELSE}
|
|
sLeftSide := Copy(LineText, 1, CaretX - 1);
|
|
if CaretX - 1 > Length(sLeftSide) then begin
|
|
sLeftSide := sLeftSide + StringOfChar(' ', CaretX-1-Length(sLeftSide));
|
|
end;
|
|
sRightSide := Copy(LineText, CaretX, Length(LineText) - (CaretX - 1));
|
|
{$ENDIF}
|
|
if eoTrimTrailingSpaces in Options then
|
|
sRightSide := TrimRight(sRightSide);
|
|
// step1: insert the first line of Value into current line
|
|
Start := PChar(Value);
|
|
P := GetEOL(Start);
|
|
if P^ <> #0 then begin
|
|
SetString(Str, Value, P - Start);
|
|
TrimmedSetLine(CaretY - 1, sLeftSide + Str);
|
|
TSynEditStringList(Lines).InsertLines(CaretY, CountLines(P)); // djlp 2000-09-07
|
|
end else begin
|
|
TrimmedSetLine(CaretY - 1, sLeftSide + Value + sRightSide);
|
|
fCaretX := LogicalToPhysicalPos(
|
|
Point(1 + Length(sLeftSide + Value),CaretY)).X;
|
|
end;
|
|
// step2: insert left lines of Value
|
|
while P^ <> #0 do begin
|
|
if P^ = #13 then
|
|
Inc(P);
|
|
if P^ = #10 then
|
|
Inc(P);
|
|
Inc(fCaretY);
|
|
Start := P;
|
|
P := GetEOL(Start);
|
|
if P = Start then begin
|
|
if p^ <> #0 then
|
|
Lines[CaretY - 1] := '' // djlp 2000-09-07
|
|
else
|
|
Lines[CaretY - 1] := sRightSide; // djlp 2000-09-07
|
|
end else begin
|
|
SetString(Str, Start, P - Start); //mh 2000-11-08
|
|
{$IFDEF SYN_LAZARUS}
|
|
if p^ <> #0 then
|
|
TrimmedSetLine(CaretY - 1, Str)
|
|
else begin
|
|
TrimmedSetLine(CaretY - 1, Str + sRightSide);
|
|
end;
|
|
{$ELSE}
|
|
if p^ <> #0 then
|
|
Lines[CaretY - 1] := Str // djlp 2000-09-07
|
|
else
|
|
Lines[CaretY - 1] := Str + sRightSide // djlp 2000-09-07
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if p^=#0 then
|
|
fCaretX := LogicalToPhysicalPos(
|
|
Point(1 + Length(Lines[CaretY - 1]) - Length(sRightSide),
|
|
CaretY)).X;
|
|
{$ELSE}
|
|
if eoTrimTrailingSpaces in Options then //JGF 2000-09-23
|
|
Lines[CaretY - 1] := TrimRight(Lines[CaretY - 1]);
|
|
{$ENDIF}
|
|
Inc(Result);
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
//DebugLn(['InsertNormal ',Length(Lines[CaretY - 1]),' ',Length(sRightSide),' ',fCaretX]);
|
|
{$ELSE}
|
|
fCaretX := 1 + Length(Lines[CaretY - 1]) - Length(sRightSide);
|
|
{$ENDIF}
|
|
StatusChanged([scCaretX]);
|
|
end;
|
|
|
|
function InsertColumn: Integer;
|
|
var
|
|
Str: string;
|
|
Start: PChar;
|
|
P: PChar;
|
|
Len: Integer;
|
|
InsertPos: Integer;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalInsertPos: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
// Insert string at current position
|
|
InsertPos := CaretX;
|
|
Start := PChar(Value);
|
|
repeat
|
|
P := GetEOL(Start);
|
|
if P <> Start then begin
|
|
SetLength(Str, P - Start);
|
|
Move(Start^, Str[1], P - Start);
|
|
if CaretY > Lines.Count then
|
|
Lines.Add(StringOfChar(' ', InsertPos - 1) + Str)
|
|
else begin
|
|
TempString := Lines[CaretY - 1];
|
|
Len := Length(TempString);
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalInsertPos:=PhysicalToLogicalCol(TempString,InsertPos);
|
|
{$ENDIF}
|
|
if Len<{$IFDEF SYN_LAZARUS}LogicalInsertPos{$ELSE}InsertPos{$ENDIF}
|
|
then begin
|
|
TempString :=
|
|
TempString + StringOfChar(' ',
|
|
{$IFDEF SYN_LAZARUS}LogicalInsertPos{$ELSE}InsertPos{$ENDIF}
|
|
- Len - 1)
|
|
+ Str
|
|
end else begin
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if mbTrailByte = ByteType(TempString, InsertPos) then
|
|
Insert(Str, TempString, InsertPos + 1)
|
|
else
|
|
{$ENDIF}
|
|
System.Insert(Str, TempString,
|
|
{$IFDEF SYN_LAZARUS}LogicalInsertPos{$ELSE}InsertPos{$ENDIF});
|
|
end;
|
|
TrimmedSetLine(CaretY - 1, TempString); //JGF 2000-09-23
|
|
end;
|
|
end;
|
|
if ATag <> nil then
|
|
ATag^ := P - Start;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if p^ in [#10,#13] then begin
|
|
if (p[1] in [#10,#13]) and (p[1]<>p^) then
|
|
inc(p,2)
|
|
else
|
|
Inc(P);
|
|
Inc(fCaretY);
|
|
end;
|
|
{$ELSE}
|
|
if P^ = #13 then begin
|
|
Inc(P);
|
|
if P^ = #10 then
|
|
Inc(P);
|
|
end;
|
|
{$ENDIF}
|
|
Start := P;
|
|
until P^ = #0;
|
|
Inc(fCaretX, Length(Str));
|
|
Result := 0;
|
|
end;
|
|
|
|
function InsertLine: Integer;
|
|
var
|
|
Start: PChar;
|
|
P: PChar;
|
|
Str: string;
|
|
n: Integer;
|
|
begin
|
|
Result := 0;
|
|
fCaretX := 1;
|
|
// Insert string before current line
|
|
Start := PChar(Value);
|
|
repeat
|
|
P := GetEOL(Start);
|
|
if P <> Start then begin
|
|
SetLength(Str, P - Start);
|
|
Move(Start^, Str[1], P - Start);
|
|
end else
|
|
Str := '';
|
|
if (P^ = #0) then begin
|
|
n := Lines.Count;
|
|
if (n >= CaretY) then
|
|
Lines[CaretY - 1] := Str + Lines[CaretY - 1]
|
|
else
|
|
Lines.Add(Str);
|
|
if eoTrimTrailingSpaces in Options then
|
|
Lines[CaretY - 1] := TrimRight(Lines[CaretY - 1]);
|
|
fCaretX := 1 + Length(Str);
|
|
end else begin
|
|
TrimmedSetLine(CaretY - 1, Str);
|
|
Inc(fCaretY);
|
|
Inc(Result);
|
|
if P^ = #13 then
|
|
Inc(P);
|
|
if P^ = #10 then
|
|
Inc(P);
|
|
Start := P;
|
|
end;
|
|
until P^ = #0;
|
|
StatusChanged([scCaretX]);
|
|
end;
|
|
|
|
var
|
|
StartLine: Integer;
|
|
InsertedLines: Integer;
|
|
begin
|
|
if Value = '' then
|
|
Exit;
|
|
|
|
// Using a TStringList to do this would be easier, but if we're dealing
|
|
// with a large block of text, it would be very inefficient. Consider:
|
|
// Assign Value parameter to TStringList.Text: that parses through it and
|
|
// creates a copy of the string for each line it finds. That copy is passed
|
|
// to the Add method, which in turn creates a copy. Then, when you actually
|
|
// use an item in the list, that creates a copy to return to you. That's
|
|
// 3 copies of every string vs. our one copy below. I'd prefer no copies,
|
|
// but we aren't set up to work with PChars that well.
|
|
|
|
StartLine := CaretY;
|
|
case PasteMode of
|
|
smNormal:
|
|
InsertedLines := InsertNormal;
|
|
smColumn:
|
|
InsertedLines := InsertColumn;
|
|
smLine:
|
|
InsertedLines := InsertLine;
|
|
else
|
|
InsertedLines := 0;
|
|
end;
|
|
// We delete selected based on the current selection mode, but paste
|
|
// what's on the clipboard according to what it was when copied.
|
|
// Update marks
|
|
if InsertedLines > 0 then
|
|
DoLinesInserted(StartLine, InsertedLines);
|
|
// Force caret reset
|
|
CaretXY := CaretXY;
|
|
end;
|
|
|
|
var
|
|
{$IFDEF SYN_LAZARUS}
|
|
BH: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
IncPaintLock;
|
|
Lines.BeginUpdate;
|
|
try
|
|
BB := BlockBegin;
|
|
BE := BlockEnd;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// make sure, BB is lower than BE
|
|
if CompareCarets(BB,BE)<0 then begin
|
|
BH:=BB;
|
|
BB:=BE;
|
|
BE:=BH;
|
|
end;
|
|
{$ENDIF}
|
|
if SelAvail then
|
|
DeleteSelection;
|
|
if (Value <> nil) and (Value[0] <> #0) then
|
|
InsertText;
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
if CaretY < 1 then
|
|
CaretY := 1;
|
|
{$IFDEF SYN_LAZARUS}
|
|
EnsureCursorPosVisible;
|
|
{$ENDIF}
|
|
finally
|
|
Lines.EndUpdate;
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SynSetText(const Value: string);
|
|
begin
|
|
Lines.Text := Value;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.RealSetText(const Value: TCaption);
|
|
begin
|
|
Lines.Text := Value;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetTopLine(Value: Integer);
|
|
var
|
|
Delta: Integer;
|
|
{$ifdef SYN_LAZARUS}
|
|
OldTopLine: LongInt;
|
|
{$ENDIF}
|
|
begin
|
|
// don't use MinMax here, it will fail in design mode (Lines.Count is zero,
|
|
// but the painting code relies on TopLine >= 1)
|
|
if (eoScrollPastEof in Options) then
|
|
Value := Min(Value, Lines.Count)
|
|
else
|
|
Value := Min(Value, Lines.Count + 1 - fLinesInWindow);
|
|
Value := Max(Value, 1);
|
|
if Value <> TopLine then begin
|
|
{$ifdef SYN_LAZARUS}
|
|
OldTopLine:=TopLine;
|
|
fTopLine := Value;
|
|
UpdateScrollBars;
|
|
Delta := OldTopLine - TopLine;
|
|
if (Abs(Delta) < fLinesInWindow) and not (sfPainting in fStateFlags) then
|
|
begin
|
|
// TODO: SW_SMOOTHSCROLL --> can't get it work
|
|
if not ScrollWindowEx(Handle, 0, fTextHeight * Delta, nil, nil, 0, nil,
|
|
SW_INVALIDATE) then
|
|
begin
|
|
// scrollwindow failed, invalidate all
|
|
Invalidate;
|
|
end;
|
|
end
|
|
{$else}
|
|
Delta := TopLine - Value;
|
|
fTopLine := Value;
|
|
UpdateScrollBars;
|
|
if Abs(Delta) < fLinesInWindow then
|
|
begin
|
|
ScrollWindow(Handle, 0, fTextHeight * Delta, nil, nil);
|
|
end
|
|
{$endif}
|
|
else
|
|
Invalidate;
|
|
StatusChanged([scTopLine]);
|
|
end;
|
|
{$ifdef SYN_LAZARUS}
|
|
fMarkupManager.TopLine:= fTopLine;
|
|
{$endif}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ShowCaret;
|
|
begin
|
|
//DebugLn(' [TCustomSynEdit.ShowCaret] ShowCaret ',Name,' ',sfCaretVisible in fStateFlags,' ',eoPersistentCaret in fOptions);
|
|
if not (eoNoCaret in Options) and not (sfCaretVisible in fStateFlags) then
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetCaretRespondToFocus(Handle,not (eoPersistentCaret in fOptions));
|
|
{$ENDIF}
|
|
if {$IFDEF SYN_LAZARUS}LCLIntf{$ELSE}Windows{$ENDIF}.ShowCaret(Handle) then
|
|
begin
|
|
//DebugLn('[TCustomSynEdit.ShowCaret] A ',Name);
|
|
Include(fStateFlags, sfCaretVisible);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.MoveCaretToVisibleArea;
|
|
// scroll to make the caret visible
|
|
var
|
|
NewCaretXY: TPoint;
|
|
MaxY: LongInt;
|
|
begin
|
|
NewCaretXY:=CaretXY;
|
|
if NewCaretXY.X < fLeftChar then
|
|
NewCaretXY.X := fLeftChar
|
|
else if NewCaretXY.X >= fLeftChar + fCharsInWindow then
|
|
NewCaretXY.X := fLeftChar + fCharsInWindow - 1;
|
|
if NewCaretXY.Y < fTopLine then
|
|
NewCaretXY.Y := fTopLine
|
|
else begin
|
|
MaxY:= ScreenRowToRow(Max(0,fLinesInWindow-1));
|
|
if NewCaretXY.Y > MaxY then
|
|
NewCaretXY.Y := MaxY;
|
|
end;
|
|
if CompareCarets(CaretXY,NewCaretXY)<>0 then
|
|
begin
|
|
//DebugLn(['TCustomSynEdit.MoveCaretToVisibleArea Old=',dbgs(CaretXY),' New=',dbgs(NewCaretXY)]);
|
|
CaretXY:=NewCaretXY;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MoveCaretIgnoreEOL(const NewCaret: TPoint);
|
|
var
|
|
NewX: LongInt;
|
|
begin
|
|
CaretXY:=NewCaret;
|
|
NewX:=Max(1,Min(fMaxLeftChar,NewCaret.X));
|
|
if CaretX<>NewX then begin
|
|
IncPaintLock;
|
|
fCaretX:=NewX;
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MoveLogicalCaretIgnoreEOL(const NewLogCaret: TPoint);
|
|
begin
|
|
MoveCaretIgnoreEOL(LogicalToPhysicalPos(NewLogCaret));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.UpdateCaret;
|
|
var
|
|
CX, CY: Integer;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
cf: TCompositionForm;
|
|
{$ENDIF}
|
|
begin
|
|
if (PaintLock <> 0)
|
|
{$IFDEF SYN_LAZARUS}
|
|
or ((not Focused) and (not (eoPersistentCaret in fOptions)))
|
|
{$ELSE}
|
|
or not Focused
|
|
{$ENDIF}
|
|
then
|
|
Include(fStateFlags, sfCaretChanged)
|
|
else begin
|
|
Exclude(fStateFlags, sfCaretChanged);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if eoAlwaysVisibleCaret in fOptions2 then
|
|
MoveCaretToVisibleArea;
|
|
{$ENDIF}
|
|
CX := CaretXPix + FCaretOffset.X;
|
|
CY := CaretYPix + FCaretOffset.Y;
|
|
if (CX >= fGutterWidth)
|
|
and (CX < ClientWidth{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF})
|
|
and (CY >= 0)
|
|
and (CY <= ClientHeight{$IFDEF SYN_LAZARUS}-ScrollBarWidth-fTextHeight{$ENDIF})
|
|
then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetCaretPosEx(Handle,CX,CY);
|
|
{$ELSE}
|
|
SetCaretPos(CX, CY);
|
|
{$ENDIF}
|
|
//DebugLn(' [TCustomSynEdit.UpdateCaret] ShowCaret ',Name);
|
|
ShowCaret;
|
|
end else begin
|
|
//DebugLn(' [TCustomSynEdit.UpdateCaret] HideCaret ',Name);
|
|
HideCaret;
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetCaretPosEx(Handle,CX, CY);
|
|
{$ELSE}
|
|
SetCaretPos(CX, CY);
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if assigned(fMarkupBracket) then fMarkupBracket.InvalidateBracketHighlight;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if HandleAllocated then begin
|
|
cf.dwStyle := CFS_POINT;
|
|
cf.ptCurrentPos := Point(CX, CY);
|
|
ImmSetCompositionWindow(ImmGetContext(Handle), @cf);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UpdateScrollBars;
|
|
var
|
|
ScrollInfo: TScrollInfo;
|
|
nMaxScroll: integer;
|
|
begin
|
|
if not HandleAllocated or (PaintLock <> 0) then
|
|
Include(fStateFlags, sfScrollbarChanged)
|
|
else begin
|
|
Exclude(fStateFlags, sfScrollbarChanged);
|
|
if fScrollBars <> ssNone then begin
|
|
ScrollInfo.cbSize := SizeOf(ScrollInfo);
|
|
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL and not SIF_TRACKPOS;
|
|
ScrollInfo.nMin := 1;
|
|
ScrollInfo.nTrackPos := 0;
|
|
if fScrollBars in [ssBoth, ssHorizontal] then begin
|
|
{begin} //mh 2000-10-19
|
|
// ScrollInfo.nMax := fMaxLeftChar;
|
|
if eoScrollPastEol in Options then
|
|
ScrollInfo.nMax := fMaxLeftChar
|
|
else
|
|
ScrollInfo.nMax := TSynEditStringList(Lines).LengthOfLongestLine;
|
|
{end} //mh 2000-10-19
|
|
ScrollInfo.nPage := CharsInWindow;
|
|
ScrollInfo.nPos := LeftChar;
|
|
{$IFDEF SYN_LAZARUS}
|
|
{ for win32 target, need to call showscrollbar before setscrollinfo }
|
|
ShowScrollBar(Handle, SB_HORZ, True);
|
|
{$ENDIF}
|
|
SetScrollInfo(Handle, SB_HORZ, ScrollInfo, True);
|
|
//DebugLn('>>>>>>>>>> [TCustomSynEdit.UpdateScrollbars] nMin=',ScrollInfo.nMin,
|
|
//' nMax=',ScrollInfo.nMax,' nPage=',ScrollInfo.nPage,
|
|
//' nPos=',ScrollInfo.nPos,
|
|
//' ClientW=',ClientWidth
|
|
//);
|
|
end else begin
|
|
|
|
// ToDo: tell interface to remove horizontal scrollbar
|
|
|
|
end;
|
|
if fScrollBars in [ssBoth, ssVertical] then begin
|
|
nMaxScroll := Lines.Count{$IFDEF SYN_LAZARUS}+1{$ENDIF};
|
|
if (eoScrollPastEof in Options) then
|
|
Inc(nMaxScroll, LinesInWindow - 1);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
if nMaxScroll <= MAX_SCROLL then begin
|
|
{$ENDIF}
|
|
ScrollInfo.nMax := Max(1, nMaxScroll);
|
|
ScrollInfo.nPage := LinesInWindow;
|
|
ScrollInfo.nPos := TopLine;
|
|
{$IFNDEF SYN_LAZARUS}
|
|
end else begin
|
|
ScrollInfo.nMin := 0;
|
|
ScrollInfo.nMax := MAX_SCROLL;
|
|
ScrollInfo.nPage := MulDiv(MAX_SCROLL, LinesInWindow, nMaxScroll);
|
|
ScrollInfo.nPos := MulDiv(MAX_SCROLL, TopLine, nMaxScroll);
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
{ for win32 target, need to call showscrollbar before setscrollinfo }
|
|
ShowScrollBar(Handle, SB_VERT, True);
|
|
{$ENDIF}
|
|
SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMDropFiles(var Msg: TMessage);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo DropFiles
|
|
var
|
|
i, iNumberDropped: integer;
|
|
szPathName: array[0..260] of char;
|
|
Point: TPoint;
|
|
FilesList: TStringList;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=Point(-1,-1);
|
|
{$ELSE}
|
|
try
|
|
if Assigned(fOnDropFiles) then begin
|
|
FilesList := TStringList.Create;
|
|
try
|
|
iNumberDropped := DragQueryFile(THandle(Msg.wParam), Cardinal(-1),
|
|
nil, 0);
|
|
DragQueryPoint(THandle(Msg.wParam), Point);
|
|
|
|
for i := 0 to iNumberDropped - 1 do begin
|
|
DragQueryFile(THandle(Msg.wParam), i, szPathName,
|
|
SizeOf(szPathName));
|
|
FilesList.Add(szPathName);
|
|
end;
|
|
fOnDropFiles(Self, Point.X, Point.Y, FilesList);
|
|
finally
|
|
FilesList.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
Msg.Result := 0;
|
|
DragFinish(THandle(Msg.wParam));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.WMExit(var Message: TLMExit);
|
|
begin
|
|
LastMouseCaret:=Point(-1,-1);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.WMEraseBkgnd(var Msg: TMessage);
|
|
begin
|
|
Msg.Result := 1;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMGetDlgCode(var Msg: TWMGetDlgCode);
|
|
begin
|
|
inherited;
|
|
Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
|
|
if fWantTabs and (GetKeyState(VK_CONTROL) >= 0) then
|
|
Msg.Result := Msg.Result or DLGC_WANTTAB;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMHScroll(var Msg: {$IFDEF SYN_LAZARUS}TLMScroll{$ELSE}TWMScroll{$ENDIF});
|
|
begin
|
|
case Msg.ScrollCode of
|
|
// Scrolls to start / end of the line
|
|
SB_TOP: LeftChar := 1;
|
|
SB_BOTTOM: LeftChar := MaxLeftChar;
|
|
// Scrolls one char left / right
|
|
SB_LINEDOWN: LeftChar := LeftChar + 1;
|
|
SB_LINEUP: LeftChar := LeftChar - 1;
|
|
// Scrolls one page of chars left / right
|
|
SB_PAGEDOWN: LeftChar := LeftChar
|
|
+ (fCharsInWindow - Ord(eoScrollByOneLess in fOptions));
|
|
SB_PAGEUP: LeftChar := LeftChar
|
|
- (fCharsInWindow - Ord(eoScrollByOneLess in fOptions));
|
|
// Scrolls to the current scroll bar position
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK: LeftChar := Msg.Pos;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMKillFocus(var Msg: TWMKillFocus);
|
|
begin
|
|
inherited;
|
|
{$IFDEF VerboseFocus}
|
|
DebugLn('[TCustomSynEdit.WMKillFocus] A ',Name);
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=Point(-1,-1);
|
|
if not (eoPersistentCaret in fOptions) then begin
|
|
HideCaret;
|
|
LCLIntf.DestroyCaret(Handle);
|
|
end;
|
|
{$ELSE}
|
|
HideCaret;
|
|
Windows.DestroyCaret;
|
|
{$ENDIF}
|
|
if FHideSelection and SelAvail then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WMSetFocus(var Msg: TWMSetFocus);
|
|
begin
|
|
LastMouseCaret:=Point(-1,-1);
|
|
{$IFDEF VerboseFocus}
|
|
DebugLn('[TCustomSynEdit.WMSetFocus] A ',Name,':',ClassName);
|
|
{$ENDIF}
|
|
InitializeCaret;
|
|
//if FHideSelection and SelAvail then
|
|
// Invalidate;
|
|
//DebugLn('[TCustomSynEdit.WMSetFocus] END');
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.Resize;
|
|
{$ELSE}
|
|
procedure TCustomSynEdit.WMSize(var Msg: TWMSize);
|
|
{$ENDIF}
|
|
begin
|
|
inherited;
|
|
SizeOrFontChanged(FALSE);
|
|
//debugln('TCustomSynEdit.Resize ',dbgs(Width),',',dbgs(Height),',',dbgs(ClientWidth),',',dbgs(ClientHeight));
|
|
// SetLeftChar(LeftChar); //mh 2000-10-19
|
|
end;
|
|
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo THintWindow
|
|
var
|
|
ScrollHintWnd: THintWindow;
|
|
|
|
function GetScrollHint: THintWindow;
|
|
begin
|
|
if ScrollHintWnd = nil then begin
|
|
ScrollHintWnd := HintWindowClass.Create(Application);
|
|
ScrollHintWnd.Visible := FALSE;
|
|
end;
|
|
Result := ScrollHintWnd;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.WMVScroll(var Msg: {$IFDEF SYN_LAZARUS}TLMScroll{$ELSE}TWMScroll{$ENDIF});
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo HintWindow
|
|
var
|
|
s: ShortString;
|
|
rc: TRect;
|
|
pt: TPoint;
|
|
ScrollHint: THintWindow;
|
|
{$ENDIF}
|
|
begin
|
|
//debugln('TCustomSynEdit.WMVScroll A ',DbgSName(Self),' Msg.ScrollCode=',dbgs(Msg.ScrollCode),' SB_PAGEDOWN=',dbgs(SB_PAGEDOWN),' SB_PAGEUP=',dbgs(SB_PAGEUP));
|
|
case Msg.ScrollCode of
|
|
// Scrolls to start / end of the text
|
|
SB_TOP: TopLine := 1;
|
|
SB_BOTTOM: TopLine := Lines.Count;
|
|
// Scrolls one line up / down
|
|
SB_LINEDOWN: TopLine := TopLine + 1;
|
|
SB_LINEUP: TopLine := TopLine - 1;
|
|
// Scrolls one page of lines up / down
|
|
SB_PAGEDOWN: TopLine := TopLine
|
|
+ (fLinesInWindow - Ord(eoScrollByOneLess in fOptions));
|
|
SB_PAGEUP: TopLine := TopLine
|
|
- (fLinesInWindow - Ord(eoScrollByOneLess in fOptions));
|
|
// Scrolls to the current scroll bar position
|
|
SB_THUMBPOSITION,
|
|
SB_THUMBTRACK:
|
|
begin
|
|
{$IFNDEF SYN_LAZARUS}
|
|
if Lines.Count > MAX_SCROLL then
|
|
TopLine := MulDiv(LinesInWindow + Lines.Count - 1, Msg.Pos,
|
|
MAX_SCROLL)
|
|
else
|
|
{$ENDIF}
|
|
TopLine := Msg.Pos;
|
|
|
|
if eoShowScrollHint in fOptions then begin
|
|
{$IFNDEF SYN_LAZARUS}
|
|
// ToDo HintWindow
|
|
ScrollHint := GetScrollHint;
|
|
if not ScrollHint.Visible then begin
|
|
ScrollHint.Color := Application.HintColor;
|
|
ScrollHint.Visible := TRUE;
|
|
end;
|
|
s := Format(SYNS_ScrollInfoFmt, [TopLine]);
|
|
{$IFDEF SYN_COMPILER_3_UP}
|
|
rc := ScrollHint.CalcHintRect(200, s, nil);
|
|
{$ELSE}
|
|
rc := Rect(0, 0, ScrollHint.Canvas.TextWidth(s) + 6,
|
|
ScrollHint.Canvas.TextHeight(s) + 4);
|
|
{$ENDIF}
|
|
pt := ClientToScreen(Point(
|
|
ClientWidth{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF}
|
|
- rc.Right - 4, 10));
|
|
OffsetRect(rc, pt.x, pt.y);
|
|
ScrollHint.ActivateHint(rc, s);
|
|
{$IFNDEF SYN_COMPILER_3_UP}
|
|
ScrollHint.Invalidate;
|
|
{$ENDIF}
|
|
ScrollHint.Update;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
// Ends scrolling
|
|
SB_ENDSCROLL:
|
|
{$IFNDEF SYN_LAZARUS}
|
|
ifSYN_LAZARUS eoShowScrollHint in fOptions then
|
|
with GetScrollHint do begin
|
|
Visible := FALSE;
|
|
ActivateHint(Rect(0, 0, 0, 0), '');
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
Update;
|
|
end;
|
|
|
|
function TCustomSynEdit.ScanFrom(Index: integer
|
|
{$IFDEF SYN_LAZARUS}; AtLeastTilIndex: integer{$ENDIF}): integer;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// Index and AtLeastTilIndex are 0 based
|
|
|
|
procedure SetCodeFoldAttributes;
|
|
var
|
|
CodeFoldMinLevel: LongInt;
|
|
CodeFoldEndLevel: LongInt;
|
|
CodeFoldType: TSynEditCodeFoldType;
|
|
LastCodeFoldEndLevel: LongInt;
|
|
begin
|
|
CodeFoldMinLevel:=fHighlighter.MinimumCodeFoldBlockLevel;
|
|
CodeFoldEndLevel:=fHighlighter.CurrentCodeFoldBlockLevel;
|
|
CodeFoldType:=cfNone;
|
|
if CodeFoldEndLevel>CodeFoldMinLevel then begin
|
|
// block started (and not closed in the same line)
|
|
CodeFoldType:=cfExpanded;
|
|
//debugln(['TCustomSynEdit.ScanFrom Block started Y=',Result,' MinLevel=',CodeFoldMinLevel,' EndLevel=',CodeFoldEndLevel,' CodeFoldType=',ord(CodeFoldType),' Line="',Lines[Result-1],'"']);
|
|
end else if (Result>1) then begin
|
|
LastCodeFoldEndLevel:=TSynEditStringList(Lines).FoldEndLevel[Result-2];
|
|
if LastCodeFoldEndLevel>CodeFoldMinLevel then begin
|
|
// block closed
|
|
CodeFoldType:=cfEnd;
|
|
end else if CodeFoldEndLevel>0 then begin
|
|
// block continuing
|
|
CodeFoldType:=cfContinue;
|
|
end;
|
|
end;
|
|
//DebugLn(['TCustomSynEdit.ScanFrom CodeFoldType=',SynEditCodeFoldTypeNames[CodeFoldType],' FoldMinLevel=',CodeFoldMinLevel,' FoldEndLevel=',CodeFoldEndLevel,' Folded=',false]);
|
|
TSynEditStringList(Lines).FoldMinLevel[Result-1] := CodeFoldMinLevel;
|
|
TSynEditStringList(Lines).FoldEndLevel[Result-1] := CodeFoldEndLevel;
|
|
TSynEditStringList(Lines).FoldType[Result-1] := CodeFoldType;
|
|
end;
|
|
|
|
procedure CheckFolded(FromIndex, ToIndex: integer);
|
|
{ Checks/Updates the Folded attributes of every scanned line
|
|
|
|
}
|
|
var
|
|
i: LongInt;
|
|
FoldStart: LongInt;
|
|
FoldLevel: LongInt;
|
|
SLines: TSynEditStringList;
|
|
begin
|
|
i:=FromIndex;
|
|
if i<0 then i:=0;
|
|
if i>ToIndex then exit;
|
|
SLines:=TSynEditStringList(Lines);
|
|
// find start and level of folded block at start of scan range
|
|
if SLines.Folded[i] then begin
|
|
FoldStart:=i;
|
|
while (FoldStart>0) and SLines.Folded[FoldStart] do
|
|
dec(FoldStart);
|
|
FoldLevel:=SLines.FoldEndLevel[FoldStart];
|
|
//DebugLn(['CheckFolded First FoldStart=',FoldStart,' FoldLevel=',FoldLevel,' Line="',Lines[FoldStart],'"']);
|
|
end else begin
|
|
FoldStart:=-1;
|
|
FoldLevel:=0;
|
|
end;
|
|
// check and fix 'folded' attributes of scanned range
|
|
while i<=ToIndex do begin
|
|
if FoldLevel<=0 then begin
|
|
// last line is not folded
|
|
if not SLines.Folded[i] then begin
|
|
// this line was not folded
|
|
// no change needed
|
|
end else begin
|
|
// this line was folded
|
|
if (i>0) and (SLines.FoldMinLevel[i-1]>=SLines.FoldEndLevel[i-1]) then
|
|
begin
|
|
// last line did not contain a block start
|
|
// => unfolded block must continue
|
|
SLines.Folded[i]:=false;
|
|
FoldLevel:=0;
|
|
//DebugLn(['CheckFolded Change A Folded of line ',i,' to FoldStart=',FoldStart,' FoldLevel=',FoldLevel,' Line="',Lines[i],'" SLines.Folded[i]=',SLines.Folded[i]]);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// last line is folded
|
|
if SLines.Folded[i] then begin
|
|
// this line was folded
|
|
if (i>0) and (SLines.FoldEndLevel[i-1]<FoldLevel) then begin
|
|
// last fold block ended with last line
|
|
FoldStart:=i;
|
|
FoldLevel:=SLines.FoldMinLevel[FoldStart];
|
|
SLines.Folded[i]:=false;
|
|
//DebugLn(['CheckFolded Change B Folded of line ',i,' to FoldStart=',FoldStart,' FoldLevel=',FoldLevel,' Line="',Lines[i],'" SLines.Folded[i]=',SLines.Folded[i]]);
|
|
end;
|
|
end else begin
|
|
// this line was not folded
|
|
if (i>0) and (SLines.FoldEndLevel[i-1]>=FoldLevel) then begin
|
|
// current folded block must be continued
|
|
SLines.Folded[i]:=true;
|
|
//DebugLn(['CheckFolded Change C Folded of line ',i,' to FoldStart=',FoldStart,' FoldLevel=',FoldLevel,' Line="',Lines[i],'" SLines.Folded[i]=',SLines.Folded[i]]);
|
|
end;
|
|
end;
|
|
end;
|
|
inc(i);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
Result := Index;
|
|
if Index >= Lines.Count - 1 then Exit;
|
|
//debugln('TCustomSynEdit.ScanFrom A Index=',dbgs(Index),' Line="',Lines[Index],'"');
|
|
fHighlighter.SetLine(Lines[Result], Result);
|
|
inc(Result);
|
|
fHighlighter.NextToEol;
|
|
while (fHighlighter.GetRange <> TSynEditStringList(Lines).Ranges[Result])
|
|
{$IFDEF SYN_LAZARUS}
|
|
or (Result<=AtLeastTilIndex)
|
|
{$ENDIF}
|
|
do begin
|
|
//debugln(['TSynCustomHighlighter.ScanFrom WHILE Y=',Result,' Level=',fHighlighter.CurrentCodeFoldBlockLevel,' ScannedLine="',Lines[Result-1],'"']);
|
|
TSynEditStringList(Lines).Ranges[Result{$IFNDEF SYN_LAZARUS}-1{$ENDIF}] :=
|
|
fHighlighter.GetRange;
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetCodeFoldAttributes;
|
|
//if (Result and $fff)=0 then
|
|
// debugln('TCustomSynEdit.ScanFrom A Line=', dbgs(Result),' Index=',dbgs(Index),' MinLevel=',dbgs(CodeFoldMinLevel),' EndLevel=',dbgs(CodeFoldEndLevel),' CodeFoldType=',dbgs(ord(CodeFoldType)),' ',dbgs(length(Lines[Result-1])));
|
|
{$ENDIF}
|
|
fHighlighter.SetLine(Lines[Result], Result);
|
|
//debugln(['TSynCustomHighlighter.ScanFrom SetLine Y=',Result,' Level=',fHighlighter.CurrentCodeFoldBlockLevel,' Line="',Lines[Result],'"']);
|
|
fHighlighter.NextToEol;
|
|
//debugln(['TSynCustomHighlighter.ScanFrom NextEOL Y=',Result,' Level=',fHighlighter.CurrentCodeFoldBlockLevel]);
|
|
inc(Result);
|
|
if Result = Lines.Count then
|
|
break;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (Result>Index+1) and (Result<=Lines.Count) then begin
|
|
// at least one line changed
|
|
// => update code fold attributes of last scanned line
|
|
SetCodeFoldAttributes;
|
|
end;
|
|
CheckFolded(Index,Result);
|
|
{$ENDIF}
|
|
Dec(Result);
|
|
end;
|
|
|
|
{begin} //mh 2000-10-10
|
|
(*
|
|
procedure TCustomSynEdit.ListAdded(Sender: TObject);
|
|
var
|
|
LastIndex: Integer;
|
|
begin
|
|
if Assigned(fHighlighter) then begin
|
|
if Lines.Count > 1 then begin
|
|
LastIndex := Lines.Count - 1;
|
|
fHighlighter.SetRange(Lines.Objects[LastIndex - 1]);
|
|
fHighlighter.SetLine(Lines[LastIndex - 1], LastIndex - 1);
|
|
fHighlighter.NextToEol;
|
|
Lines.Objects[LastIndex] := fHighlighter.GetRange;
|
|
end else begin
|
|
fHighlighter.ReSetRange;
|
|
Lines.Objects[0] := fHighlighter.GetRange;
|
|
end;
|
|
end;
|
|
LastIndex := Lines.Count;
|
|
InvalidateLine(LastIndex);
|
|
*)
|
|
procedure TCustomSynEdit.ListAdded(Index: integer);
|
|
begin
|
|
//debugln('TCustomSynEdit.ListAdded ',dbgs(Index),' ',dbgs(Assigned(fHighlighter)));
|
|
if Assigned(fHighlighter) then begin
|
|
if (Index > 0) then begin
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[Index - 1]);
|
|
ScanFrom(Index - 1);
|
|
end else begin
|
|
fHighlighter.ResetRange;
|
|
TSynEditStringList(Lines).Ranges[0] := fHighlighter.GetRange;
|
|
if (Lines.Count > 1) then
|
|
ScanFrom(0);
|
|
end;
|
|
end;
|
|
InvalidateLines(Index + 1, MaxInt);
|
|
InvalidateGutterLines(Index + 1, MaxInt);
|
|
end;
|
|
{end} //mh 2000-10-10
|
|
|
|
procedure TCustomSynEdit.ListCleared(Sender: TObject);
|
|
begin
|
|
ClearUndo;
|
|
// invalidate the *whole* client area
|
|
FillChar(fInvalidateRect, SizeOf(TRect), 0);
|
|
Invalidate;
|
|
// set caret and selected block to start of text
|
|
SetBlockBegin(Point(1, 1));
|
|
SetCaretXY(Point(1, 1));
|
|
// scroll to start of text
|
|
TopLine := 1;
|
|
LeftChar := 1;
|
|
Include(fStatusChanges, scAll);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ListDeleted(Index: Integer);
|
|
begin
|
|
if Assigned(fHighlighter) and (Lines.Count >= 1) then
|
|
if (Index > 0) then begin
|
|
{begin} //mh 2000-10-10
|
|
// fHighlighter.SetRange(Lines.Objects[Index - 1]);
|
|
//DebugLn(['TCustomSynEdit.ListDeleted A Index=',Index]);
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[Index - 1]);
|
|
ScanFrom(Index - 1);
|
|
end else begin
|
|
//DebugLn(['TCustomSynEdit.ListDeleted B Index=',Index]);
|
|
fHighlighter.ResetRange;
|
|
// Lines.Objects[0] := fHighlighter.GetRange;
|
|
TSynEditStringList(Lines).Ranges[0] := fHighlighter.GetRange;
|
|
{end} //mh 2000-10-10
|
|
if (Lines.Count > 1) then
|
|
ScanFrom(0);
|
|
end;
|
|
InvalidateLines(Index + 1, MaxInt);
|
|
InvalidateGutterLines(Index + 1, MaxInt);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ListInserted(Index: Integer);
|
|
begin
|
|
if Assigned(fHighlighter) and (Lines.Count >= 1) then
|
|
if (Index > 0) then begin
|
|
{begin} //mh 2000-10-10
|
|
// fHighlighter.SetRange(Lines.Objects[Index - 1]);
|
|
// the line and the range of the line
|
|
//DebugLn(['TCustomSynEdit.ListInserted A Index=',Index]);
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[Index - 1]);
|
|
ScanFrom(Index - 1);
|
|
end else begin
|
|
//DebugLn(['TCustomSynEdit.ListInserted B Index=',Index]);
|
|
fHighlighter.ReSetRange;
|
|
// Lines.Objects[0] := fHighlighter.GetRange;
|
|
TSynEditStringList(Lines).Ranges[0] := fHighlighter.GetRange;
|
|
{end} //mh 2000-10-10
|
|
if (Lines.Count > 1) then
|
|
ScanFrom(0);
|
|
end;
|
|
InvalidateLines(Index + 1, {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow+1){$ELSE}TopLine + LinesInWindow{$ENDIF});
|
|
InvalidateGutterLines(Index + 1, {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow+1){$ELSE}TopLine + LinesInWindow{$ENDIF});
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ListPutted(Index: Integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
var
|
|
EndIndex: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
//DebugLn(['TCustomSynEdit.ListPutted Index=',Index,' PaintLock=',PaintLock]);
|
|
{$IFDEF SYN_LAZARUS}
|
|
if PaintLock>0 then begin
|
|
if (fHighlighterNeedsUpdateStartLine<1)
|
|
or (fHighlighterNeedsUpdateStartLine>Index+1) then
|
|
fHighlighterNeedsUpdateStartLine:=Index+1;
|
|
if (fHighlighterNeedsUpdateEndLine<1)
|
|
or (fHighlighterNeedsUpdateEndLine<Index+1) then
|
|
fHighlighterNeedsUpdateEndLine:=Index+1;
|
|
exit;
|
|
end;
|
|
if Assigned(fHighlighter) then begin
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[Index]); //mh 2000-10-10
|
|
EndIndex:=ScanFrom(Index) + 1;
|
|
InvalidateLines(Index + 1, EndIndex);
|
|
InvalidateGutterLines(Index + 1, EndIndex);
|
|
end else
|
|
InvalidateLines(Index + 1, Index + 1);
|
|
{$ELSE}
|
|
if Assigned(fHighlighter) then begin
|
|
// fHighlighter.SetRange(Lines.Objects[Index]);
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[Index]); //mh 2000-10-10
|
|
InvalidateLines(Index + 1, ScanFrom(Index) + 1);
|
|
end else
|
|
InvalidateLines(Index + 1, Index + 1);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ListScanRanges(Sender: TObject);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
var
|
|
i: integer;
|
|
{$ENDIF}
|
|
begin
|
|
if Assigned(fHighlighter) and (Lines.Count > 0) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
ScanFrom(0,Lines.Count-1);
|
|
{$ELSE}
|
|
fHighlighter.ResetRange;
|
|
{begin} //mh 2000-10-10
|
|
(*
|
|
Lines.Objects[0] := fHighlighter.GetRange;
|
|
i := 1;
|
|
while (i < Lines.Count) do begin
|
|
fHighlighter.SetRange(Lines.Objects[i - 1]);
|
|
fHighlighter.SetLine(Lines[i - 1], i - 1);
|
|
fHighlighter.NextToEol;
|
|
Lines.Objects[i] := fHighlighter.GetRange;
|
|
Inc(i);
|
|
end;
|
|
*)
|
|
i := 0;
|
|
repeat
|
|
TSynEditStringList(Lines).Ranges[i] := fHighlighter.GetRange;
|
|
fHighlighter.SetLine(Lines[i], i);
|
|
fHighlighter.NextToEol;
|
|
Inc(i);
|
|
until i >= Lines.Count;
|
|
{end} //mh 2000-10-10
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
type
|
|
TStringType = (stNone, stHalfNumAlpha, stHalfSymbol, stHalfKatakana,
|
|
stWideNumAlpha, stWideSymbol, stWideKatakana, stHiragana, stIdeograph,
|
|
stControl, stKashida);
|
|
|
|
{ }
|
|
|
|
function IsStringType(Value: Word): TStringType;
|
|
begin
|
|
Result := stNone;
|
|
|
|
if (Value = C3_SYMBOL) then begin
|
|
(*** Controls ***)
|
|
Result := stControl;
|
|
end else
|
|
if ((Value and C3_HALFWIDTH) <> 0) then begin
|
|
(*** singlebyte ***)
|
|
if (Value = C3_HALFWIDTH) or
|
|
(Value = (C3_ALPHA or C3_HALFWIDTH)) then begin { Number & Alphabet }
|
|
Result := stHalfNumAlpha;
|
|
end else
|
|
if ((Value and C3_SYMBOL) <> 0) or
|
|
((Value and C3_LEXICAL) <> 0) then begin { Symbol }
|
|
Result := stHalfSymbol;
|
|
end else
|
|
if ((Value and C3_KATAKANA) <> 0) then begin { Japanese-KATAKANA }
|
|
Result := stHalfKatakana;
|
|
end;
|
|
end else begin
|
|
(*** doublebyte ***)
|
|
if (Value = C3_FULLWIDTH) or
|
|
(Value = (C3_ALPHA or C3_FULLWIDTH)) then begin { Number & Alphabet }
|
|
Result := stWideNumAlpha;
|
|
end
|
|
else if ((Value and C3_SYMBOL) <> 0) or
|
|
((Value and C3_LEXICAL) <> 0) then begin { Symbol }
|
|
Result := stWideSymbol;
|
|
end
|
|
else if ((Value and C3_KATAKANA) <> 0) then begin { Japanese-KATAKANA }
|
|
Result := stWideKatakana;
|
|
end
|
|
else if ((Value and C3_HIRAGANA) <> 0) then begin { Japanese-HIRAGANA }
|
|
Result := stHiragana;
|
|
end
|
|
else if ((Value and C3_IDEOGRAPH) <> 0) then begin { Ideograph }
|
|
Result := stIdeograph;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ }
|
|
|
|
procedure TCustomSynEdit.SetWordBlock(Value: TPoint);
|
|
var
|
|
i: Integer;
|
|
Runner: TPoint;
|
|
TempString: string;
|
|
IdChars: TSynIdentChars;
|
|
|
|
procedure MultiBlockScan;
|
|
var
|
|
i: Integer;
|
|
wideX: Integer;
|
|
cType: PWordArray;
|
|
cLeng: Integer;
|
|
stc: TStringType;
|
|
begin
|
|
wideX := ByteToCharIndex(TempString, Value.X - 1);
|
|
|
|
cLeng := ByteToCharLen(TempString, Length(TempString));
|
|
GetMem(cType, SizeOf(Word) * cLeng);
|
|
try
|
|
if not GetStringTypeEx(LOCALE_SYSTEM_DEFAULT, CT_CTYPE3,
|
|
PChar(TempString), Length(TempString), cType^)
|
|
then
|
|
exit;
|
|
stc := IsStringType(cType^[wideX]);
|
|
if (stc = stControl) then
|
|
exit;
|
|
{ search BlockEnd }
|
|
for i := wideX + 1 to cLeng - 1 do
|
|
if (IsStringType(cType^[i]) <> stc) then begin
|
|
Runner.Y := (i + 1);
|
|
Break;
|
|
end;
|
|
Runner.Y := (i + 1);
|
|
if Runner.Y > cLeng then Runner.Y := cLeng;
|
|
{ search BlockBegin }
|
|
for i := wideX - 1 downto 0 do
|
|
if (IsStringType(cType^[i]) <> stc) then begin
|
|
Runner.X := (i + 2);
|
|
Break;
|
|
end;
|
|
Runner.X := CharToByteIndex(TempString, Runner.X);
|
|
Runner.Y := CharToByteIndex(TempString, Runner.Y);
|
|
finally
|
|
FreeMem(cType);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Value.x := MinMax(Value.x, 1, fMaxLeftChar);
|
|
Value.y := MinMax(Value.y, 1, Lines.Count);
|
|
TempString := (Lines[Value.Y - 1] + #$0);
|
|
if (Value.X >= Length(TempString)) then begin
|
|
CaretXY := Point(Length(TempString), Value.Y);
|
|
exit;
|
|
end;
|
|
if (fHighlighter <> nil) and
|
|
(ByteType(TempString, Value.X) <> mbLeadByte) then begin
|
|
Runner := Point(0, Length(TempString));
|
|
IdChars := fHighlighter.IdentChars;
|
|
{ search BlockEnd }
|
|
for i := Value.X to Length(TempString) - 1 do begin
|
|
if not (TempString[i] in IdChars) then begin
|
|
Runner.Y := i;
|
|
Break;
|
|
end;
|
|
end;
|
|
{ search BlockBegin }
|
|
for i := Value.X - 1 downto 1 do begin
|
|
if not (TempString[i] in IdChars) then begin
|
|
Runner.X := (i + 1);
|
|
Break;
|
|
end;
|
|
end;
|
|
end else
|
|
MultiBlockScan;
|
|
SetCaretAndSelection(Point(Runner.Y, Value.Y), Point(Runner.X, Value.Y),
|
|
Point(Runner.Y, Value.Y));
|
|
InvalidateLine(Value.Y);
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
{$ELSE}
|
|
|
|
procedure TCustomSynEdit.SetWordBlock(Value: TPoint);
|
|
var
|
|
Runner: TPoint;
|
|
TempString: string;
|
|
IdChars: TSynIdentChars;
|
|
begin
|
|
{ Value is the position of the Carat in bytes }
|
|
Value.x := MinMax(Value.x, 1, fMaxLeftChar);
|
|
Value.y := MinMax(Value.y, 1, Lines.Count);
|
|
TempString := Lines[Value.Y - 1];
|
|
if TempString = '' then exit;
|
|
// Click on right side of text
|
|
if Length(TempString) < Value.X then Value.X := Length(TempString);
|
|
|
|
Runner := Value;
|
|
if Assigned(fHighlighter) then
|
|
{$IFDEF SYN_LAZARUS}
|
|
IdChars := [#1..#255] - (fHighlighter.WordBreakChars + TSynWhiteChars)
|
|
{$ELSE}
|
|
IdChars := fHighlighter.IdentChars
|
|
{$ENDIF}
|
|
else
|
|
{$IFDEF SYN_LAZARUS}
|
|
IDchars := [#1..#255] - (TSynWordBreakChars + TSynWhiteChars);
|
|
{$ELSE}
|
|
IDchars := [#33..#255];
|
|
{$ENDIF}
|
|
if not (TempString[Runner.X] in IdChars) then begin
|
|
// no word under cursor and next char right is not start of a word
|
|
if (Runner.X > 1) and (not (TempString[Runner.X] in IdChars)) then begin
|
|
// find end of word on the left side
|
|
while Runner.X > 1 do begin
|
|
if (TempString[Runner.X] in IdChars) then break;
|
|
Dec(Runner.X);
|
|
end;
|
|
end;
|
|
// no word on the left side, so look to the right side
|
|
if not (TempString[Runner.X] in IdChars) then begin
|
|
Runner := Value;
|
|
while (Runner.X < fMaxLeftChar)
|
|
{$IFDEF FPC} and (Runner.X < length(TempString)){$ENDIF} do begin
|
|
if (TempString[Runner.X] in IdChars) then break;
|
|
Inc(Runner.X);
|
|
end;
|
|
if Runner.X > fMaxLeftChar then
|
|
exit;
|
|
end;
|
|
Value := Runner;
|
|
end;
|
|
while Runner.X > 0 do begin
|
|
if not (TempString[Runner.X] in IdChars) then break;
|
|
Dec(Runner.X);
|
|
end;
|
|
Inc(Runner.X);
|
|
if Runner.X < 1 then Runner.X := 1;
|
|
fBlockBegin := Runner;
|
|
Runner := Value;
|
|
while (Runner.X < fMaxLeftChar)
|
|
{$IFDEF FPC} and (Runner.X <= length(TempString)){$ENDIF} do begin
|
|
if not (TempString[Runner.X] in IdChars) then break;
|
|
Inc(Runner.X);
|
|
end;
|
|
if Runner.X > fMaxLeftChar then Runner.X := fMaxLeftChar;
|
|
fBlockEnd := Runner;
|
|
// set caret to the end of selected block
|
|
CaretXY := Runner;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if UseUTF8 then begin
|
|
Delete(TempString, fBlockEnd.X, Length(TempString));
|
|
CaretX := CaretX - Max(0, (Length(TempString) - UTF8Length(TempString)));
|
|
end;
|
|
{$ENDIF}
|
|
InvalidateLine(Value.Y);
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetLineBlock(Value: TPoint);
|
|
var
|
|
ALine: string;
|
|
begin
|
|
fBlockBegin:=Point(1,MinMax(Value.y, 1, Lines.Count));
|
|
fBlockEnd:=Point(1,MinMax(Value.y+1, 1, Lines.Count));
|
|
if (fBlockBegin.Y>=1) and (fBlockBegin.Y<=Lines.Count) then begin
|
|
ALine:=Lines[fBlockBegin.Y-1];
|
|
while (fBlockBegin.X<length(ALine)) and (ALine[fBlockBegin.X] in [' ',#9])
|
|
do
|
|
inc(fBlockBegin.X);
|
|
fBlockEnd:=fBlockBegin;
|
|
fBlockEnd.X:=length(ALine)+1;
|
|
while (fBlockEnd.X>fBlockBegin.X) and (ALine[fBlockEnd.X-1] in [' ',#9])
|
|
do
|
|
dec(fBlockEnd.X);
|
|
end;
|
|
CaretXY:=fBlockEnd;
|
|
//DebugLn(' FFF2 ',Value.X,',',Value.Y,' BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
|
|
InvalidateLine(Value.Y);
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetParagraphBlock(Value: TPoint);
|
|
var ParagraphStartLine, ParagraphEndLine: integer;
|
|
begin
|
|
ParagraphStartLine:=MinMax(Value.y, 1, Lines.Count);
|
|
ParagraphEndLine:=MinMax(Value.y+1, 1, Lines.Count);
|
|
while (ParagraphStartLine>1)
|
|
and (Trim(Lines[ParagraphStartLine-1])<>'') do
|
|
dec(ParagraphStartLine);
|
|
while (ParagraphEndLine<Lines.Count)
|
|
and (Trim(Lines[ParagraphEndLine-1])<>'') do
|
|
inc(ParagraphEndLine);
|
|
fBlockBegin:=Point(1,ParagraphStartLine);
|
|
fBlockEnd:=Point(1,ParagraphEndLine);
|
|
CaretXY:=fBlockEnd;
|
|
//DebugLn(' FFF3 ',Value.X,',',Value.Y,' BlockBegin=',BlockBegin.X,',',BlockBegin.Y,' BlockEnd=',BlockEnd.X,',',BlockEnd.Y);
|
|
InvalidateLine(Value.Y);
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.DblClick;
|
|
var
|
|
ptMouse: TPoint;
|
|
begin
|
|
GetCursorPos(ptMouse);
|
|
ptMouse := ScreenToClient(ptMouse);
|
|
if ptMouse.X >= fGutterWidth + 2 then begin
|
|
if not (eoNoSelection in fOptions) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoDoubleClickSelectsLine in fOptions) then
|
|
SetLineBlock(PixelsToLogicalPos(ptMouse))
|
|
else
|
|
SetWordBlock(PixelsToLogicalPos(ptMouse));
|
|
{$ELSE}
|
|
SetWordBlock(CaretXY);
|
|
{$ENDIF}
|
|
end;
|
|
inherited;
|
|
Include(fStateFlags, sfDblClicked);
|
|
MouseCapture := FALSE;
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.TripleClick;
|
|
var
|
|
ptMouse: TPoint;
|
|
begin
|
|
GetCursorPos(ptMouse);
|
|
ptMouse := ScreenToClient(ptMouse);
|
|
if ptMouse.X >= fGutterWidth + 2 then begin
|
|
if not (eoNoSelection in fOptions) then begin
|
|
SetLineBlock(PixelsToLogicalPos(ptMouse))
|
|
end;
|
|
inherited;
|
|
Include(fStateFlags, sfTripleClicked);
|
|
MouseCapture := FALSE;
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.QuadClick;
|
|
var
|
|
ptMouse: TPoint;
|
|
begin
|
|
GetCursorPos(ptMouse);
|
|
ptMouse := ScreenToClient(ptMouse);
|
|
if ptMouse.X >= fGutterWidth + 2 then begin
|
|
if not (eoNoSelection in fOptions) then begin
|
|
SetParagraphBlock(PixelsToLogicalPos(ptMouse))
|
|
end;
|
|
inherited;
|
|
Include(fStateFlags, sfQuadClicked);
|
|
MouseCapture := FALSE;
|
|
end else
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.GetCanUndo: Boolean;
|
|
begin
|
|
result := fUndoList.CanUndo;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetCanRedo: Boolean;
|
|
begin
|
|
result := fRedoList.CanUndo;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetCanPaste:Boolean;
|
|
begin
|
|
Result := Clipboard.HasFormat(CF_TEXT)
|
|
or Clipboard.HasFormat(SynEditClipboardFormat)
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InsertBlock(BB, BE: TPoint; ChangeStr: PChar);
|
|
// used by BlockIndent and Redo
|
|
begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}LogicalToPhysicalPos(BB){$ELSE}BB{$ENDIF},
|
|
BB, BE);
|
|
fSelectionMode := smColumn;
|
|
SetSelTextPrimitive(smColumn, ChangeStr, nil);
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.Redo;
|
|
{begin} //sbs 2000-11-19
|
|
var
|
|
Item: TSynEditUndoItem;
|
|
OldChangeNumber: integer;
|
|
begin
|
|
Item := fRedoList.PeekItem;
|
|
if Item <> nil then begin
|
|
OldChangeNumber := fUndoList.BlockChangeNumber;
|
|
fUndoList.BlockChangeNumber := Item.fChangeNumber;
|
|
try
|
|
repeat
|
|
RedoItem;
|
|
Item := fRedoList.PeekItem;
|
|
until (Item = nil) or (Item.fChangeNumber <> fUndoList.BlockChangeNumber);
|
|
finally
|
|
fUndoList.BlockChangeNumber := OldChangeNumber;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.RedoItem;
|
|
{end} //sbs 2000-11-19
|
|
var
|
|
Item: TSynEditUndoItem;
|
|
OldSelMode: TSynSelectionMode;
|
|
Run, StrToDelete: PChar;
|
|
Len, e, x : integer;
|
|
TempString: string;
|
|
CaretPt: TPoint;
|
|
ChangeScrollPastEol: boolean; //mh 2000-10-30
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysStartPos: TPoint;
|
|
PhysEndPos: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
OldSelMode := SelectionMode;
|
|
ChangeScrollPastEol := not (eoScrollPastEol in Options); //mh 2000-10-30
|
|
Item := fRedoList.PopItem;
|
|
if Assigned(Item) then try
|
|
SelectionMode := Item.fChangeSelMode;
|
|
IncPaintLock;
|
|
Include(fOptions, eoScrollPastEol); //mh 2000-10-30
|
|
Include(fStateFlags, sfInsideRedo); //mh 2000-10-30
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysStartPos:=LogicalToPhysicalPos(Item.fChangeStartPos);
|
|
PhysEndPos:=LogicalToPhysicalPos(Item.fChangeEndPos);
|
|
{$ENDIF}
|
|
case Item.fChangeReason of
|
|
crInsert, crPaste, crDragDropInsert:
|
|
begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}PhysStartPos{$ELSE}Item.fChangeStartPos{$ENDIF},
|
|
Item.fChangeStartPos, Item.fChangeStartPos
|
|
);
|
|
SetSelTextPrimitive(Item.fChangeSelMode, PChar(Item.fChangeStr), nil);
|
|
{$IFDEF SYN_LAZARUS}
|
|
CaretXY := PhysEndPos;
|
|
{$ELSE}
|
|
CaretXY := Item.fChangeEndPos; //mh 2000-10-30
|
|
{$ENDIF}
|
|
fUndoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, GetSelText, Item.fChangeSelMode);
|
|
{begin} //mh 2000-11-20
|
|
if Item.fChangeReason = crDragDropInsert then begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}PhysStartPos{$ELSE}Item.fChangeStartPos{$ENDIF},
|
|
Item.fChangeStartPos, Item.fChangeEndPos);
|
|
end;
|
|
{end} //mh 2000-11-20
|
|
end;
|
|
crDeleteAfterCursor, crSilentDeleteAfterCursor: //mh 2000-10-30
|
|
begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}PhysStartPos{$ELSE}Item.fChangeStartPos{$ENDIF},
|
|
Item.fChangeStartPos,{$IFDEF SYN_LAZARUS}Item.fChangeEndPos{$ELSE}Item.fChangeStartPos{$ENDIF}
|
|
);
|
|
fUndoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, GetSelText, Item.fChangeSelMode);
|
|
SetSelTextPrimitive(Item.fChangeSelMode, PChar(Item.fChangeStr), nil);
|
|
{$IFDEF SYN_LAZARUS}
|
|
CaretXY := PhysStartPos;
|
|
{$ELSE}
|
|
CaretXY := Item.fChangeStartPos;
|
|
{$ENDIF}
|
|
end;
|
|
crDelete, {crDragDropDelete, crSelDelete, }crSilentDelete: //mh 2000-10-30, 2000-11-20
|
|
begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}PhysStartPos{$ELSE}Item.fChangeStartPos{$ENDIF},
|
|
Item.fChangeStartPos, {$IFDEF SYN_LAZARUS}Item.fChangeEndPos{$ELSE}Item.fChangeStartPos{$ENDIF}
|
|
);
|
|
fUndoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, GetSelText, Item.fChangeSelMode);
|
|
SetSelTextPrimitive(Item.fChangeSelMode, PChar(Item.fChangeStr), nil);
|
|
{$IFDEF SYN_LAZARUS}
|
|
CaretXY := PhysStartPos;
|
|
{$ELSE}
|
|
CaretXY := Item.fChangeStartPos;
|
|
{$ENDIF}
|
|
{begin} //mh 2000-11-20
|
|
(*
|
|
// process next entry? This is awkward, and should be replaced by
|
|
// undoitems maintaining a single linked list of connected items...
|
|
ItemNext := fRedoList.PeekItem;
|
|
if {(Item.fChangeReason = crSelDelete) or }
|
|
((Item.fChangeReason = crDragDropDelete) and Assigned(ItemNext)
|
|
and (ItemNext.fChangeReason = crDragDropInsert))
|
|
then
|
|
Redo;
|
|
*)
|
|
{end} //mh 2000-11-20
|
|
end;
|
|
crLineBreak:
|
|
{begin} //sbs 2000-11-20
|
|
// CommandProcessor(ecLineBreak, #13, nil);
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetCaretAndSelection(PhysStartPos, Item.fChangeStartPos,
|
|
Item.fChangeStartPos);
|
|
{$ELSE}
|
|
CaretPt := Item.fChangeStartPos;
|
|
SetCaretAndSelection(CaretPt, CaretPt, CaretPt);
|
|
{$ENDIF}
|
|
CommandProcessor(ecLineBreak, #13, nil);
|
|
end;
|
|
{end} //sbs 2000-11-20
|
|
crIndent:
|
|
begin // re-insert the column
|
|
if (Item.fChangeEndPos.X = 1) then
|
|
begin
|
|
e := Item.fChangeEndPos.y - 1;
|
|
x := 1;
|
|
end else begin
|
|
e := Item.fChangeEndPos.y;
|
|
x := Item.fChangeEndPos.x
|
|
+ {$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF};
|
|
end;
|
|
InsertBlock(Point(1, Item.fChangeStartPos.y),
|
|
Point(1, e), PChar(Item.fChangeStr));
|
|
// add to undo list
|
|
fUndoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, Item.fChangeStr, Item.fChangeSelMode);
|
|
// restore the selection
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(Point(1, Item.fChangeEndPos.Y + 1)),
|
|
{$ELSE}
|
|
Point(1, Item.fChangeEndPos.Y + 1),
|
|
{$ENDIF}
|
|
Point(Item.fChangeStartPos.x + fTabWidth,Item.fChangeStartPos.y),
|
|
Point(x, Item.fChangeEndPos.y));
|
|
end;
|
|
crUnindent :
|
|
begin // re-delete the (raggered) column
|
|
// add to undo list
|
|
fUndoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, Item.fChangeStr, smColumn);
|
|
// Delete string
|
|
StrToDelete := PChar(Item.fChangeStr);
|
|
CaretY := Item.fChangeStartPos.Y;
|
|
repeat
|
|
Run := GetEOL(StrToDelete);
|
|
if Run <> StrToDelete then begin
|
|
Len := Run - StrToDelete;
|
|
TempString := Lines[CaretY - 1];
|
|
if Len > 0 then
|
|
Delete(TempString, 1, Len);
|
|
Lines[CaretY - 1] := TempString;
|
|
end else
|
|
Len := 0;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Run^ in [#10,#13] then begin
|
|
if (Run[1] in [#10,#13]) and (Run^<>Run[1]) then
|
|
Inc(Run,2)
|
|
else
|
|
Inc(Run);
|
|
Inc(fCaretY);
|
|
end;
|
|
{$ELSE}
|
|
if Run^ = #13 then begin
|
|
Inc(Run);
|
|
if Run^ = #10 then
|
|
Inc(Run);
|
|
Inc(fCaretY);
|
|
end;
|
|
{$ENDIF}
|
|
StrToDelete := Run;
|
|
until Run^ = #0;
|
|
// restore selection
|
|
CaretPt := Point(Item.fChangeStartPos.x - fTabWidth,
|
|
Item.fChangeStartPos.y);
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(CaretPt),
|
|
{$ELSE}
|
|
CaretPt,
|
|
{$ENDIF}
|
|
CaretPt,
|
|
Point(Item.fChangeEndPos.x - Len, Item.fChangeEndPos.y)
|
|
);
|
|
end;
|
|
end;
|
|
finally
|
|
SelectionMode := OldSelMode;
|
|
Exclude(fStateFlags, sfInsideRedo); //mh 2000-10-30
|
|
if ChangeScrollPastEol then //mh 2000-10-30
|
|
Exclude(fOptions, eoScrollPastEol);
|
|
Item.Free;
|
|
DecPaintLock;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fRedoList.IsTopMarkedAsUnmodified then
|
|
fUndoList.MarkTopAsUnmodified;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.Undo;
|
|
{begin} //sbs 2000-11-19
|
|
var
|
|
Item: TSynEditUndoItem;
|
|
OldChangeNumber: integer;
|
|
begin
|
|
Item := fUndoList.PeekItem;
|
|
if Item <> nil then begin
|
|
OldChangeNumber := fRedoList.BlockChangeNumber;
|
|
fRedoList.BlockChangeNumber := Item.fChangeNumber;
|
|
try
|
|
repeat
|
|
UndoItem;
|
|
Item := fUndoList.PeekItem;
|
|
until (Item = nil) or (Item.fChangeNumber <> fRedoList.BlockChangeNumber);
|
|
finally
|
|
fRedoList.BlockChangeNumber := OldChangeNumber;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UndoItem;
|
|
{end} //sbs 2000-11-19
|
|
var
|
|
Item: TSynEditUndoItem;
|
|
OldSelMode: TSynSelectionMode;
|
|
TmpPos: TPoint;
|
|
TmpStr: string;
|
|
ChangeScrollPastEol: boolean; //mh 2000-10-30
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysStartPos: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
OldSelMode := SelectionMode;
|
|
ChangeScrollPastEol := not (eoScrollPastEol in Options); //mh 2000-10-30
|
|
Item := fUndoList.PopItem;
|
|
if Assigned(Item) then try
|
|
SelectionMode := Item.fChangeSelMode;
|
|
IncPaintLock;
|
|
Include(fOptions, eoScrollPastEol); //mh 2000-10-30
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysStartPos:=LogicalToPhysicalPos(Item.fChangeStartPos);
|
|
{$ENDIF}
|
|
case Item.fChangeReason of
|
|
crInsert, crPaste, crDragDropInsert:
|
|
begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}PhysStartPos{$ELSE}Item.fChangeStartPos{$ENDIF},
|
|
Item.fChangeStartPos, Item.fChangeEndPos);
|
|
fRedoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, GetSelText, Item.fChangeSelMode);
|
|
SetSelTextPrimitive(Item.fChangeSelMode, PChar(Item.fChangeStr), nil);
|
|
CaretXY := {$IFDEF SYN_LAZARUS}PhysStartPos
|
|
{$ELSE}Item.fChangeStartPos{$ENDIF};
|
|
{begin} //mh 2000-11-20
|
|
(*
|
|
// process next entry? This is awkward, and should be replaced by
|
|
// undoitems maintaining a single linked list of connected items...
|
|
ItemNext := fUndoList.PeekItem;
|
|
if Assigned(ItemNext) and
|
|
((ItemNext.fChangeReason = crSelDelete) or
|
|
((ItemNext.fChangeReason = crDragDropDelete)
|
|
and (Item.fChangeReason = crDragDropInsert)))
|
|
then
|
|
Undo;
|
|
*)
|
|
{end} //mh 2000-11-20
|
|
end;
|
|
crDeleteAfterCursor, crDelete, {crDragDropDelete, crSelDelete, } //mh 2000-11-20
|
|
crSilentDelete, crSilentDeleteAfterCursor: //mh 2000-10-30
|
|
begin
|
|
// If there's no selection, we have to set
|
|
// the Caret's position manually.
|
|
if Item.fChangeSelMode = smColumn then
|
|
TmpPos := Point(Min(Item.fChangeStartPos.X, Item.fChangeEndPos.X),
|
|
Min(Item.fChangeStartPos.Y, Item.fChangeEndPos.Y))
|
|
else
|
|
TmpPos := minPoint(Item.fChangeStartPos, Item.fChangeEndPos);
|
|
if (Item.fChangeReason in [crDeleteAfterCursor,
|
|
crSilentDeleteAfterCursor]) and (TmpPos.Y > Lines.Count) //mh 2000-10-30
|
|
then begin
|
|
CaretXY := Point(1, Lines.Count);
|
|
// this stinks!!!
|
|
CommandProcessor(ecLineBreak, #13, nil);
|
|
end;
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(TmpPos),
|
|
{$ELSE}
|
|
TmpPos,
|
|
{$ENDIF}
|
|
TmpPos, TmpPos);
|
|
//debugln('AAA1 Item.fChangeStr="',DbgStr(Item.fChangeStr),'"');
|
|
SetSelTextPrimitive(Item.fChangeSelMode, PChar(Item.fChangeStr), nil);
|
|
{begin} //mh 2000-10-30
|
|
if Item.fChangeReason in [crDeleteAfterCursor,
|
|
crSilentDeleteAfterCursor]
|
|
then
|
|
TmpPos := Item.fChangeStartPos
|
|
else
|
|
TmpPos := Item.fChangeEndPos;
|
|
if Item.fChangeReason in [crSilentDelete, crSilentDeleteAfterCursor]
|
|
then
|
|
CaretXY :={$IFDEF SYN_LAZARUS}LogicalToPhysicalPos(TmpPos)
|
|
{$ELSE}TmpPos{$ENDIF}
|
|
else begin
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(TmpPos),
|
|
{$ELSE}
|
|
TmpPos,
|
|
{$ENDIF}
|
|
Item.fChangeStartPos, Item.fChangeEndPos);
|
|
end;
|
|
{end} //mh 2000-10-30
|
|
fRedoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, '', Item.fChangeSelMode);
|
|
EnsureCursorPosVisible;
|
|
end;
|
|
crLineBreak:
|
|
begin
|
|
// If there's no selection, we have to set
|
|
// the Caret's position manualy.
|
|
CaretXY := Item.fChangeStartPos;
|
|
fRedoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, '', Item.fChangeSelMode);
|
|
if CaretY > 0 then begin
|
|
TmpStr := Lines.Strings[CaretY - 1];
|
|
if (Length(TmpStr) < CaretX - 1)
|
|
and (LeftSpaces(Item.fChangeStr) = 0)
|
|
then
|
|
AppendStr(TmpStr, StringOfChar(' ', CaretX - 1 - Length(TmpStr)));
|
|
Lines.Delete(Item.fChangeEndPos.y);
|
|
end;
|
|
CaretXY := {$IFDEF SYN_LAZARUS}PhysStartPos
|
|
{$ELSE}Item.fChangeStartPos{$ENDIF};
|
|
TrimmedSetLine(CaretY - 1, TmpStr + Item.fChangeStr);
|
|
DoLinesDeleted(CaretY, 1);
|
|
end;
|
|
crIndent: // remove the column that was inserted
|
|
begin
|
|
// select the inserted column
|
|
BlockBegin := Point(1, Item.fChangeStartPos.y);
|
|
TmpPos := Item.fChangeEndPos;
|
|
if TmpPos.x = 1 then
|
|
Dec(TmpPos.y);
|
|
TmpPos.x := {$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF}+1;
|
|
BlockEnd := TmpPos;
|
|
// add to redo list
|
|
fRedoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, GetSelText, Item.fChangeSelMode);
|
|
// remove the column
|
|
SetSelTextPrimitive(Item.fChangeSelMode, nil, nil);
|
|
// restore the selection
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(Item.fChangeEndPos),
|
|
{$ELSE}
|
|
Item.fChangeEndPos,
|
|
{$ENDIF}
|
|
Item.fChangeStartPos, Item.fChangeEndPos);
|
|
end;
|
|
crUnindent: // reinsert the (raggered) column that was deleted
|
|
begin
|
|
fRedoList.AddChange(Item.fChangeReason, Item.fChangeStartPos,
|
|
Item.fChangeEndPos, Item.fChangeStr, Item.fChangeSelMode);
|
|
// reinsert the string
|
|
InsertBlock(Point(1, Item.fChangeStartPos.y),
|
|
Point(1, Item.fChangeEndPos.y), PChar(Item.fChangeStr));
|
|
SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogicalToPhysicalPos(Item.fChangeStartPos),
|
|
{$ELSE}
|
|
Item.fChangeStartPos,
|
|
{$ENDIF}
|
|
Item.fChangeStartPos, Item.fChangeEndPos);
|
|
end;
|
|
end;
|
|
finally
|
|
SelectionMode := OldSelMode;
|
|
if ChangeScrollPastEol then //mh 2000-10-30
|
|
Exclude(fOptions, eoScrollPastEol);
|
|
Item.Free;
|
|
DecPaintLock;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fUndoList.IsTopMarkedAsUnmodified then
|
|
fRedoList.MarkTopAsUnmodified;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.UpdateCtrlMouse;
|
|
|
|
procedure doNotShowLink;
|
|
begin
|
|
if fLastCtrlMouseLinkY>0 then begin
|
|
Invalidate;
|
|
Cursor := crIBeam;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
NewY, NewX1, NewX2: integer;
|
|
begin
|
|
fLastControlIsPressed:=(GetKeyShiftState=[ssCtrl]);
|
|
if (eoShowCtrlMouseLinks in Options) and fLastControlIsPressed
|
|
and (fLastMouseCaret.X>0) and (fLastMouseCaret.Y>0) then begin
|
|
// show link
|
|
NewY:=fLastMouseCaret.Y;
|
|
GetWordBoundsAtRowCol(PhysicalToLogicalPos(fLastMouseCaret),NewX1,NewX2);
|
|
if NewX1<>NewX2 then begin
|
|
// there is a word to underline as link
|
|
if (NewY<>fLastCtrlMouseLinkY)
|
|
or (NewX1<>fLastCtrlMouseLinkX1)
|
|
or (NewX2<>fLastCtrlMouseLinkX2)
|
|
then begin
|
|
Invalidate;
|
|
Cursor := crHandPoint;
|
|
end;
|
|
end else
|
|
doNotShowLink // there is no link
|
|
end else
|
|
doNotShowLink;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.ClearBookMark(BookMark: Integer);
|
|
begin
|
|
if (BookMark in [0..9]) and assigned(fBookMarks[BookMark]) then begin
|
|
DoOnClearBookmark(fBookMarks[BookMark]); // djlp 2000-08-29
|
|
FMarkList.Remove(fBookMarks[Bookmark]);
|
|
fBookMarks[BookMark].Free;
|
|
fBookMarks[BookMark] := nil;
|
|
end
|
|
end;
|
|
|
|
procedure TCustomSynEdit.GotoBookMark(BookMark: Integer);
|
|
{$IFDEF SYN_LAZARUS}
|
|
var
|
|
NewCaret: TPoint;
|
|
LogCaret: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
if (BookMark in [0..9]) and assigned(fBookMarks[BookMark])
|
|
and (fBookMarks[BookMark].Line <= fLines.Count)
|
|
then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
NewCaret:=Point(fBookMarks[BookMark].Column, fBookMarks[BookMark].Line);
|
|
LogCaret:=PhysicalToLogicalPos(NewCaret);
|
|
IncPaintLock;
|
|
SetBlockEnd(LogCaret);
|
|
SetBlockBegin(LogCaret);
|
|
CaretXY:=NewCaret;
|
|
EnsureCursorPosVisible;
|
|
DecPaintLock;
|
|
{$ELSE}
|
|
CaretXY:=Point(fBookMarks[BookMark].Column, fBookMarks[BookMark].Line); // djlp 2000-08-29
|
|
EnsureCursorPosVisible;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.IdentChars: TSynIdentChars;
|
|
begin
|
|
if Highlighter <> nil then
|
|
Result := Highlighter.IdentChars
|
|
else
|
|
{$IFDEF SYN_LAZARUS}
|
|
Result := ['a'..'z','A'..'Z','0'..'9'];
|
|
{$ELSE}
|
|
Result := [#33..#255];
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.IsIdentChar(const c: TUTF8Char): boolean;
|
|
begin
|
|
Result:=(length(c)=1) and (c[1] in IdentChars);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetBookMark(BookMark: Integer; X: Integer; Y: Integer);
|
|
var
|
|
i: Integer;
|
|
mark: TSynEditMark;
|
|
begin
|
|
if (BookMark in [0..9]) and (Y >= 1) and (Y <= Max(1, fLines.Count)) then
|
|
begin
|
|
mark := TSynEditMark.Create(self);
|
|
with mark do begin
|
|
Line := Y;
|
|
Column := X;
|
|
ImageIndex := Bookmark;
|
|
BookmarkNumber := Bookmark;
|
|
Visible := true;
|
|
InternalImage := (fBookMarkOpt.BookmarkImages = nil);
|
|
end;
|
|
DoOnPlaceMark(Mark);
|
|
if (mark <> nil) and (BookMark in [0..9]) then begin
|
|
for i := 0 to 9 do
|
|
if assigned(fBookMarks[i]) and (fBookMarks[i].Line = Y) then
|
|
ClearBookmark(i);
|
|
if assigned(fBookMarks[BookMark]) then
|
|
ClearBookmark(BookMark);
|
|
fBookMarks[BookMark] := mark;
|
|
FMarkList.Add(fBookMarks[BookMark]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.WndProc(var Msg: TMessage);
|
|
// Prevent Alt-Backspace from beeping
|
|
const
|
|
ALT_KEY_DOWN = $20000000;
|
|
begin
|
|
if (Msg.Msg = WM_SYSCHAR) and (Msg.wParam = VK_BACK) and
|
|
(Msg.lParam and ALT_KEY_DOWN <> 0)
|
|
then
|
|
Msg.Msg := 0
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DragOver(Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
begin
|
|
inherited;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=Point(-1,-1);
|
|
{$ENDIF}
|
|
if (Source is TCustomSynEdit) and not TCustomSynEdit(Source).ReadOnly then
|
|
begin
|
|
Accept := True;
|
|
//Ctrl is pressed => change cursor to indicate copy instead of move
|
|
if GetKeyState(VK_CONTROL) < 0 then
|
|
DragCursor := crMultiDrag
|
|
else
|
|
DragCursor := crDrag;
|
|
if State = dsDragLeave then //restore prev caret position
|
|
ComputeCaret(FMouseDownX, FMouseDownY)
|
|
else //position caret under the mouse cursor
|
|
ComputeCaret(X, Y);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DragDrop(Source: TObject; X, Y: Integer);
|
|
var
|
|
NewCaret: TPoint;
|
|
DoDrop, DropAfter, DropMove: boolean;
|
|
BB, BE: TPoint;
|
|
DragDropText: string;
|
|
Adjust: integer;
|
|
ChangeScrollPastEOL: boolean;
|
|
begin
|
|
if not ReadOnly and (Source is TCustomSynEdit)
|
|
and TCustomSynEdit(Source).SelAvail
|
|
then begin
|
|
IncPaintLock;
|
|
try
|
|
inherited;
|
|
ComputeCaret(X, Y);
|
|
NewCaret := CaretXY;
|
|
// if from other control then move when SHIFT, else copy
|
|
// if from Self then copy when CTRL, else move
|
|
if Source <> Self then begin
|
|
DropMove := GetKeyState(VK_SHIFT) < 0;
|
|
DoDrop := TRUE;
|
|
DropAfter := FALSE;
|
|
end else begin
|
|
DropMove := GetKeyState(VK_CONTROL) >= 0;
|
|
BB := BlockBegin;
|
|
BE := BlockEnd;
|
|
DropAfter := (NewCaret.Y > BE.Y)
|
|
or ((NewCaret.Y = BE.Y) and (NewCaret.X > BE.X));
|
|
DoDrop := DropAfter or (NewCaret.Y < BB.Y)
|
|
or ((NewCaret.Y = BB.Y) and (NewCaret.X < BB.X));
|
|
end;
|
|
if DoDrop then begin
|
|
BeginUndoBlock; //mh 2000-11-20
|
|
try
|
|
DragDropText := TCustomSynEdit(Source).SelText;
|
|
// delete the selected text if necessary
|
|
if DropMove then begin
|
|
if Source <> Self then
|
|
TCustomSynEdit(Source).SelText := ''
|
|
else begin
|
|
// fUndoList.AddChange(crDragDropDelete, fBlockBegin, fBlockEnd,
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, //mh 2000-11-20
|
|
DragDropText, SelectionMode);
|
|
LockUndo;
|
|
try
|
|
SelText := '';
|
|
finally
|
|
UnlockUndo;
|
|
end;
|
|
// adjust horizontal drop position
|
|
if DropAfter and (NewCaret.Y = BE.Y) then begin
|
|
if BB.Y = BE.Y then
|
|
Adjust := BE.X - BB.X
|
|
else
|
|
Adjust := BE.X - 1;
|
|
Dec(NewCaret.X, Adjust);
|
|
end;
|
|
// adjust vertical drop position
|
|
if DropAfter and (BE.Y > BB.Y) then
|
|
Dec(NewCaret.Y, BE.Y - BB.Y);
|
|
end;
|
|
end;
|
|
// insert the selected text
|
|
ChangeScrollPastEOL := not (eoScrollPastEol in fOptions);
|
|
try
|
|
if ChangeScrollPastEOL then
|
|
Include(fOptions, eoScrollPastEol);
|
|
CaretXY := NewCaret;
|
|
BlockBegin := NewCaret;
|
|
LockUndo;
|
|
try
|
|
SelText := DragDropText;
|
|
finally
|
|
UnlockUndo;
|
|
end;
|
|
finally
|
|
if ChangeScrollPastEOL then
|
|
Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
// save undo information
|
|
if Source = Self then begin
|
|
fUndoList.AddChange(crDragDropInsert,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(NewCaret),
|
|
{$ELSE}
|
|
NewCaret,
|
|
{$ENDIF}
|
|
BlockEnd, SelText, SelectionMode);
|
|
end else begin
|
|
fUndoList.AddChange(crInsert,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(NewCaret),
|
|
{$ELSE}
|
|
NewCaret,
|
|
{$ENDIF}
|
|
BlockEnd, SelText, SelectionMode);
|
|
end;
|
|
BlockBegin := {$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(NewCaret)
|
|
{$ELSE}NewCaret{$ENDIF};
|
|
BlockEnd := {$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF};
|
|
CaretXY := NewCaret;
|
|
finally
|
|
EndUndoBlock;
|
|
end;
|
|
end;
|
|
finally
|
|
DecPaintLock;
|
|
end;
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetRightEdge(Value: Integer);
|
|
begin
|
|
if fRightEdge <> Value then begin
|
|
fRightEdge := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetRightEdgeColor(Value: TColor);
|
|
var
|
|
nX: integer;
|
|
rcInval: TRect;
|
|
begin
|
|
if fRightEdgeColor <> Value then begin
|
|
fRightEdgeColor := Value;
|
|
if HandleAllocated then begin
|
|
nX := fTextOffset + fRightEdge * fCharWidth;
|
|
rcInval := Rect(nX - 1, 0, nX + 1
|
|
, ClientHeight{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF});
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetMaxUndo: Integer;
|
|
begin
|
|
result := fUndoList.MaxUndoActions;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetMaxUndo(const Value: Integer);
|
|
begin
|
|
if Value > -1 then begin
|
|
fUndoList.MaxUndoActions := Value;
|
|
fRedoList.MaxUndoActions := Value;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then begin
|
|
if AComponent = fHighlighter then begin
|
|
fHighlighter := nil;
|
|
{begin} //mh 2000-10-01
|
|
if not (csDestroying in ComponentState) then begin
|
|
RecalcCharExtent;
|
|
SizeOrFontChanged(TRUE); //jr 2000-10-01
|
|
Invalidate;
|
|
end;
|
|
{end} //mh 2000-10-01
|
|
end;
|
|
if (fBookmarkOpt <> nil) then
|
|
if (AComponent = fBookmarkOpt.BookmarkImages) then begin
|
|
fBookmarkOpt.BookmarkImages := nil;
|
|
InvalidateGutterLines(-1, -1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetHighlighter(const Value: TSynCustomHighlighter);
|
|
begin
|
|
if Value <> fHighlighter then begin
|
|
if Assigned(fHighlighter) then
|
|
fHighlighter.UnhookAttrChangeEvent(
|
|
{$IFDEF FPC}@{$ENDIF}HighlighterAttrChanged);
|
|
if Assigned(Value) then begin
|
|
Value.HookAttrChangeEvent(
|
|
{$IFDEF FPC}@{$ENDIF}HighlighterAttrChanged);
|
|
Value.FreeNotification(Self);
|
|
end;
|
|
fHighlighter := Value;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fHighlighter<>nil then begin
|
|
fHighlighter.ResetRange;
|
|
TSynEditStringList(Lines).ClearRanges(fHighlighter.GetRange);
|
|
end;
|
|
{$ENDIF}
|
|
RecalcCharExtent;
|
|
Lines.BeginUpdate;
|
|
try
|
|
ListScanRanges(Self);
|
|
finally
|
|
Lines.EndUpdate;
|
|
end;
|
|
SizeOrFontChanged(TRUE);
|
|
end;
|
|
end;
|
|
|
|
{$ifndef SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetBorderStyle(Value: TBorderStyle);
|
|
begin
|
|
if fBorderStyle <> Value then begin
|
|
fBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
{$endif}
|
|
|
|
procedure TCustomSynEdit.SetHideSelection(const Value: boolean);
|
|
begin
|
|
if fHideSelection <> Value then begin
|
|
FHideSelection := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetInsertMode(const Value: boolean);
|
|
begin
|
|
if fInserting <> Value then begin
|
|
fInserting := Value;
|
|
if not (csDesigning in ComponentState) then
|
|
// Reset the caret.
|
|
InitializeCaret;
|
|
StatusChanged([scInsertMode]);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InitializeCaret;
|
|
var
|
|
ct: TSynEditCaretType;
|
|
cw, ch: integer;
|
|
begin
|
|
// CreateCaret automatically destroys the previous one, so we don't have to
|
|
// worry about cleaning up the old one here with DestroyCaret.
|
|
// Ideally, we will have properties that control what these two carets look like.
|
|
if InsertMode then
|
|
ct := FInsertCaret
|
|
else
|
|
ct := FOverwriteCaret;
|
|
case ct of
|
|
ctHorizontalLine:
|
|
begin
|
|
cw := fCharWidth;
|
|
ch := 2;
|
|
FCaretOffset := Point(0, fTextHeight - 2);
|
|
end;
|
|
ctHalfBlock:
|
|
begin
|
|
cw := fCharWidth;
|
|
ch := (fTextHeight - 2) div 2;
|
|
FCaretOffset := Point(0, ch);
|
|
end;
|
|
ctBlock:
|
|
begin
|
|
cw := fCharWidth;
|
|
ch := fTextHeight - 2;
|
|
FCaretOffset := Point(0, 0);
|
|
end;
|
|
else begin // ctVerticalLine
|
|
cw := 2;
|
|
ch := fTextHeight - 2;
|
|
FCaretOffset := Point(-1, 0);
|
|
end;
|
|
end;
|
|
Exclude(fStateFlags, sfCaretVisible);
|
|
CreateCaret(Handle, 0, cw, ch);
|
|
UpdateCaret;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetInsertCaret(const Value: TSynEditCaretType);
|
|
begin
|
|
if FInsertCaret <> Value then begin
|
|
FInsertCaret := Value;
|
|
InitializeCaret;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetOverwriteCaret(const Value: TSynEditCaretType);
|
|
begin
|
|
if FOverwriteCaret <> Value then begin
|
|
FOverwriteCaret := Value;
|
|
InitializeCaret;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetMaxLeftChar(Value: integer);
|
|
begin
|
|
Value := MinMax(Value, 1, MAX_SCROLL); // horz scrolling is only 16 bit
|
|
if fMaxLeftChar <> Value then begin
|
|
fMaxLeftChar := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.EnsureCursorPosVisible;
|
|
var
|
|
PhysCaretXY: TPoint;
|
|
{$IFDEF SYN_LAZARUS}
|
|
MinX: Integer;
|
|
MaxX: Integer;
|
|
i, Y : integer;
|
|
PhysBlockBeginXY: TPoint;
|
|
PhysBlockEndXY: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
IncPaintLock;
|
|
try
|
|
// Make sure X is visible
|
|
//DebugLn('[TCustomSynEdit.EnsureCursorPosVisible] A CaretX=',CaretX,' LeftChar=',LeftChar,' CharsInWindow=',CharsInWindow,' ClientWidth=',ClientWidth);
|
|
PhysCaretXY:=CaretXY;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// try to make the current selection visible as well
|
|
MinX:=PhysCaretXY.X;
|
|
MaxX:=PhysCaretXY.X;
|
|
if SelAvail then begin
|
|
PhysBlockBeginXY:=LogicalToPhysicalPos(BlockBegin);
|
|
PhysBlockEndXY:=LogicalToPhysicalPos(BlockEnd);
|
|
if (PhysBlockBeginXY.X<>PhysBlockEndXY.X)
|
|
or (PhysBlockBeginXY.Y<>PhysBlockEndXY.Y) then begin
|
|
if (SelectionMode<>smColumn) and (PhysBlockBeginXY.Y<>PhysBlockEndXY.Y) then
|
|
PhysBlockBeginXY.X:=1;
|
|
if MinX>PhysBlockBeginXY.X then
|
|
MinX:=Max(PhysBlockBeginXY.X,PhysCaretXY.X-CharsInWindow+1);
|
|
if MinX>PhysBlockEndXY.X then
|
|
MinX:=Max(PhysBlockEndXY.X,PhysCaretXY.X-CharsInWindow+1);
|
|
if MaxX<PhysBlockBeginXY.X then
|
|
MaxX:=Min(PhysBlockBeginXY.X,MinX+CharsInWindow-1);
|
|
if MaxX<PhysBlockEndXY.X then
|
|
MaxX:=Min(PhysBlockEndXY.X,MinX+CharsInWindow-1);
|
|
end;
|
|
end;
|
|
{DebugLn('TCustomSynEdit.EnsureCursorPosVisible A CaretX=',dbgs(PhysCaretXY.X),
|
|
' BlockX=',dbgs(PhysBlockBeginXY.X)+'-'+dbgs(PhysBlockEndXY.X),
|
|
' CharsInWindow='+dbgs(CharsInWindow),
|
|
' MinX='+dbgs(MinX),
|
|
' MaxX='+dbgs(MaxX),
|
|
' LeftChar='+dbgs(LeftChar),
|
|
'');}
|
|
if MinX < LeftChar then
|
|
LeftChar := MinX
|
|
else if LeftChar < MaxX - (CharsInWindow - 1) then
|
|
LeftChar := MaxX - (CharsInWindow - 1)
|
|
else
|
|
LeftChar := LeftChar; //mh 2000-10-19
|
|
//DebugLn(['TCustomSynEdit.EnsureCursorPosVisible B LeftChar=',LeftChar,' MinX=',MinX,' MaxX=',MaxX,' CharsInWindow=',CharsInWindow]);
|
|
{$ELSE}
|
|
if PhysCaretXY.X < LeftChar then
|
|
LeftChar := PhysCaretXY.X
|
|
else if PhysCaretXY.X > CharsInWindow + LeftChar then
|
|
LeftChar := PhysCaretXY.X - CharsInWindow + 1
|
|
else
|
|
LeftChar := LeftChar; //mh 2000-10-19
|
|
{$ENDIF}
|
|
// Make sure Y is visible
|
|
if CaretY < TopLine then
|
|
TopLine := CaretY
|
|
{$IFDEF SYN_LAZARUS}
|
|
else if CaretY > ScreenRowToRow(Max(1, LinesInWindow) - 1) then begin //mh 2000-10-19
|
|
Y := CaretY;
|
|
for i:=1 to (Max(1, LinesInWindow) - 1) do begin
|
|
dec(Y);
|
|
Y:=FindNextUnfoldedLine(Y,false);
|
|
end;
|
|
TopLine:=Max(Y, 1);
|
|
end
|
|
{$ELSE}
|
|
else if CaretY > TopLine + Max(1, LinesInWindow) - 1 then //mh 2000-10-19
|
|
TopLine := CaretY - (LinesInWindow - 1)
|
|
{$ENDIF}
|
|
else
|
|
TopLine := TopLine; //mh 2000-10-19
|
|
finally
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetKeystrokes(const Value: TSynEditKeyStrokes);
|
|
begin
|
|
if Value = nil then
|
|
FKeystrokes.Clear
|
|
else
|
|
FKeystrokes.Assign(Value);
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetExtraCharSpacing(const Value: integer);
|
|
begin
|
|
if fExtraCharSpacing=Value then exit;
|
|
fExtraCharSpacing := Value;
|
|
FontChanged(self);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetLastMouseCaret(const AValue: TPoint);
|
|
begin
|
|
if (FLastMouseCaret.X=AValue.X) and (FLastMouseCaret.Y=AValue.Y) then exit;
|
|
FLastMouseCaret:=AValue;
|
|
UpdateCtrlMouse;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetDefaultKeystrokes;
|
|
begin
|
|
FKeystrokes.ResetDefaults;
|
|
end;
|
|
|
|
// If the translations requires Data, memory will be allocated for it via a
|
|
// GetMem call. The client must call FreeMem on Data if it is not NIL.
|
|
|
|
function TCustomSynEdit.TranslateKeyCode(Code: word; Shift: TShiftState;
|
|
var Data: pointer): TSynEditorCommand;
|
|
var
|
|
i: integer;
|
|
{$IFNDEF SYN_COMPILER_3_UP}
|
|
const
|
|
VK_ACCEPT = $30;
|
|
{$ENDIF}
|
|
begin
|
|
i := KeyStrokes.FindKeycode2(fLastKey, fLastShiftState, Code, Shift);
|
|
if i >= 0 then begin
|
|
Result := KeyStrokes[i].Command
|
|
end else begin
|
|
i := Keystrokes.FindKeycode(Code, Shift);
|
|
if i >= 0 then begin
|
|
Result := Keystrokes[i].Command
|
|
end else
|
|
Result := ecNone;
|
|
end;
|
|
if (Result = ecNone) and (Code >= VK_ACCEPT) and (Code <= VK_SCROLL) then
|
|
begin
|
|
fLastKey := Code;
|
|
fLastShiftState := Shift;
|
|
end else begin
|
|
fLastKey := 0;
|
|
fLastShiftState := [];
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.CommandProcessor(Command: TSynEditorCommand;
|
|
AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer);
|
|
begin
|
|
{$IFDEF VerboseKeys}
|
|
DebugLn('[TCustomSynEdit.CommandProcessor] ',Command
|
|
,' AChar=',AChar,' Data=',DbgS(Data));
|
|
{$ENDIF}
|
|
// first the program event handler gets a chance to process the command
|
|
DoOnProcessCommand(Command, AChar, Data);
|
|
if Command <> ecNone then begin
|
|
// notify hooked command handlers before the command is executed inside of
|
|
// the class
|
|
NotifyHookedCommandHandlers(FALSE, Command, AChar, Data);
|
|
// internal command handler
|
|
if (Command <> ecNone) and (Command < ecUserFirst) then
|
|
ExecuteCommand(Command, AChar, Data);
|
|
// notify hooked command handlers after the command was executed inside of
|
|
// the class
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Command <> ecNone then
|
|
{$ENDIF}
|
|
NotifyHookedCommandHandlers(TRUE, Command, AChar, Data);
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Command <> ecNone then
|
|
{$ENDIF}
|
|
DoOnCommandProcessed(Command, AChar, Data);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ExecuteCommand(Command: TSynEditorCommand;
|
|
{$IFDEF SYN_LAZARUS}const AChar: TUTF8Char{$ELSE}AChar: Char{$ENDIF};
|
|
Data: pointer);
|
|
const
|
|
ALPHANUMERIC = DIGIT + ALPHA_UC + ALPHA_LC;
|
|
SEL_MODE: array[ecNormalSelect..ecLineSelect] of TSynSelectionMode = (
|
|
smNormal, smColumn, smLine);
|
|
var
|
|
CX: Integer;
|
|
Len: Integer;
|
|
Temp: string;
|
|
Temp2: string;
|
|
Helper: string;
|
|
SpaceCount1: Integer;
|
|
SpaceCount2: Integer;
|
|
BackCounter: Integer;
|
|
StartOfBlock: TPoint;
|
|
bChangeScroll: boolean;
|
|
moveBkm: boolean;
|
|
WP: TPoint;
|
|
Caret: TPoint;
|
|
CaretNew: TPoint;
|
|
OldSelMode: TSynSelectionMode;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
i: integer;
|
|
s: string;
|
|
{$ENDIF}
|
|
counter: Integer;
|
|
InsDelta: integer;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCounter: integer;
|
|
LogCaretXY: TPoint;
|
|
LogCaret: TPoint;
|
|
LogSpacePos: integer;
|
|
LastUndoItem:TSynEditUndoItem;
|
|
{$ENDIF}
|
|
|
|
{begin} //mh 2000-10-30
|
|
procedure SetSelectedTextEmpty;
|
|
begin
|
|
if (fBlockBegin.Y < fBlockEnd.Y)
|
|
or ((fBlockBegin.Y = fBlockEnd.Y) and (fBlockBegin.X < fBlockEnd.X))
|
|
then
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText,
|
|
SelectionMode)
|
|
else
|
|
fUndoList.AddChange(crDeleteAfterCursor, fBlockEnd, fBlockBegin, SelText,
|
|
SelectionMode);
|
|
SetSelText('');
|
|
end;
|
|
{end}
|
|
//mh 2000-10-30
|
|
begin
|
|
IncPaintLock;
|
|
try
|
|
case Command of
|
|
// horizontal caret movement or selection
|
|
ecLeft, ecSelLeft:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoCaretSkipsSelection in Options2) and (Command=ecLeft)
|
|
and SelAvail and (CompareCarets(LogicalCaretXY,BlockEnd)=0) then begin
|
|
CaretXY:=LogicalToPhysicalPos(BlockBegin);
|
|
end else
|
|
{$ENDIF}
|
|
MoveCaretHorz(-1, Command = ecSelLeft);
|
|
end;
|
|
ecRight, ecSelRight:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoCaretSkipsSelection in Options2) and (Command=ecRight)
|
|
and SelAvail and (CompareCarets(LogicalCaretXY,BlockBegin)=0) then begin
|
|
CaretXY:=LogicalToPhysicalPos(BlockEnd);
|
|
end else
|
|
{$ENDIF}
|
|
MoveCaretHorz(1, Command = ecSelRight);
|
|
end;
|
|
ecPageLeft, ecSelPageLeft:
|
|
begin
|
|
MoveCaretHorz(-CharsInWindow, Command = ecSelPageLeft);
|
|
end;
|
|
ecPageRight, ecSelPageRight:
|
|
begin
|
|
MoveCaretHorz(CharsInWindow, Command = ecSelPageRight);
|
|
end;
|
|
{begin} //mh 2000-10-19
|
|
ecLineStart, ecSelLineStart:
|
|
DoHomeKey(Command=ecSelLineStart);
|
|
{begin
|
|
MoveCaretAndSelectionPhysical(CaretXY,Point(1, CaretY),
|
|
Command = ecSelLineStart);
|
|
fLastCaretX := fCaretX;
|
|
end;}
|
|
ecLineEnd, ecSelLineEnd:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical(CaretXY,
|
|
LogicalToPhysicalPos(Point(1 + Length(LineText), CaretY)),
|
|
Command = ecSelLineEnd);
|
|
{$ELSE}
|
|
MoveCaretAndSelection(CaretXY, Point(1 + Length(LineText), CaretY),
|
|
Command = ecSelLineEnd);
|
|
{$ENDIF}
|
|
fLastCaretX := fCaretX;
|
|
end;
|
|
{end} //mh 2000-10-19
|
|
// vertical caret movement or selection
|
|
ecUp, ecSelUp:
|
|
begin
|
|
MoveCaretVert(-1, Command = ecSelUp);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
Update;
|
|
{$ENDIF}
|
|
end;
|
|
ecDown, ecSelDown:
|
|
begin
|
|
MoveCaretVert(1, Command = ecSelDown);
|
|
{$IFNDEF SYN_LAZARUS}
|
|
Update;
|
|
{$ENDIF}
|
|
end;
|
|
ecPageUp, ecSelPageUp, ecPageDown, ecSelPageDown:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
counter := fLinesInWindow;
|
|
if (eoHalfPageScroll in fOptions) then counter:=counter shr 1;
|
|
{$ELSE}
|
|
counter := fLinesInWindow shr Ord(eoHalfPageScroll in fOptions);
|
|
{$ENDIF}
|
|
if eoScrollByOneLess in fOptions then
|
|
Dec(counter);
|
|
if (Command in [ecPageUp, ecSelPageUp]) then
|
|
counter := -counter;
|
|
TopLine := TopLine + counter;
|
|
MoveCaretVert(counter, Command in [ecSelPageUp, ecSelPageDown]);
|
|
Update;
|
|
end;
|
|
ecPageTop, ecSelPageTop:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(CaretXY, Point(CaretX, TopLine), Command = ecSelPageTop);
|
|
Update;
|
|
end;
|
|
ecPageBottom, ecSelPageBottom:
|
|
begin
|
|
CaretNew := Point(CaretX, ScreenRowToRow(LinesInWindow - 1));
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(CaretXY, CaretNew, Command = ecSelPageBottom);
|
|
Update;
|
|
end;
|
|
ecEditorTop, ecSelEditorTop:
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(CaretXY, Point(1, 1), Command = ecSelEditorTop);
|
|
Update;
|
|
end;
|
|
ecEditorBottom, ecSelEditorBottom:
|
|
begin
|
|
CaretNew := Point(1, Lines.Count);
|
|
if (CaretNew.Y > 0) then
|
|
CaretNew.X := Length(Lines[CaretNew.Y - 1]) + 1;
|
|
MoveCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(CaretXY),
|
|
{$ELSE}
|
|
CaretXY,
|
|
{$ENDIF}
|
|
CaretNew, Command = ecSelEditorBottom);
|
|
Update;
|
|
end;
|
|
// goto special line / column position
|
|
ecGotoXY, ecSelGotoXY:
|
|
if Assigned(Data) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(CaretXY, PPoint(Data)^, Command = ecSelGotoXY);
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
Update;
|
|
end;
|
|
// word selection
|
|
ecWordLeft, ecSelWordLeft:
|
|
begin
|
|
Caret := CaretXY;
|
|
CaretNew := PrevWordPos;
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(Caret, CaretNew, Command = ecSelWordLeft);
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
{$IFDEF SYN_LAZARUS}
|
|
Update;
|
|
{$ENDIF}
|
|
end;
|
|
ecWordRight, ecSelWordRight:
|
|
begin
|
|
Caret := CaretXY;
|
|
CaretNew := NextWordPos;
|
|
{$IFDEF SYN_LAZARUS}
|
|
MoveCaretAndSelectionPhysical
|
|
{$ELSE}
|
|
MoveCaretAndSelection
|
|
{$ENDIF}
|
|
(Caret, CaretNew, Command = ecSelWordRight);
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
{$IFDEF SYN_LAZARUS}
|
|
Update;
|
|
{$ENDIF}
|
|
end;
|
|
ecSelectAll:
|
|
begin
|
|
SelectAll;
|
|
end;
|
|
{begin} //mh 2000-10-30
|
|
ecDeleteLastChar:
|
|
if not ReadOnly then begin
|
|
if SelAvail then
|
|
SetSelectedTextEmpty
|
|
else begin
|
|
Temp := LineText;
|
|
Len := Length(Temp);
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
LogCaret:=LogCaretXY;
|
|
{$ENDIF}
|
|
Caret := CaretXY;
|
|
//debugln('ecDeleteLastChar B Temp="',DbgStr(Temp),'" CaretX=',dbgs(CaretX),' LogCaretXY=',dbgs(LogCaretXY));
|
|
if {$IFDEF SYN_LAZARUS}LogCaretXY.X{$ELSE}CaretX{$ENDIF} > Len +1
|
|
then begin
|
|
// only move caret one column
|
|
Helper := ' ';
|
|
CaretX := CaretX - 1;
|
|
end else if CaretX = 1 then begin
|
|
// join this line with the last line if possible
|
|
if CaretY > 1 then begin
|
|
CaretY := CaretY - 1;
|
|
{$IFDEF SYN_LAZARUS}
|
|
CaretX := LogicalToPhysicalCol(Lines[CaretY - 1],
|
|
Length(Lines[CaretY - 1]) + 1);
|
|
{$ELSE}
|
|
CaretX := Length(Lines[CaretY - 1]) + 1;
|
|
{$ENDIF}
|
|
Lines.Delete(CaretY);
|
|
DoLinesDeleted(CaretY, 1);
|
|
if eoTrimTrailingSpaces in Options then
|
|
Temp := TrimRight(Temp);
|
|
LineText := LineText + Temp;
|
|
Helper := {$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#13#10{$ENDIF};
|
|
end;
|
|
end else begin
|
|
// delete text before the caret
|
|
SpaceCount1 := LeftSpaces(Temp{$IFDEF SYN_LAZARUS},true{$ENDIF});
|
|
SpaceCount2 := 0;
|
|
//debugln('ecDeleteLastChar C SpaceCount1=',dbgs(SpaceCount1),' Temp[LogCaretXY.X-1]=',DbgStr(Temp[LogCaretXY.X-1]));
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (Temp[LogCaretXY.X-1] <= #32) and (SpaceCount1 = CaretX - 1) then
|
|
{$ELSE}
|
|
if (Temp[CaretX-1] <= #32) and (SpaceCount1 = CaretX - 1) then
|
|
{$ENDIF}
|
|
begin
|
|
// unindent
|
|
if SpaceCount1 > 0 then begin
|
|
BackCounter := CaretY - 2;
|
|
while BackCounter >= 0 do begin
|
|
SpaceCount2 :=LeftSpaces(Lines[BackCounter]
|
|
{$IFDEF SYN_LAZARUS},true{$ENDIF});
|
|
if SpaceCount2 < SpaceCount1 then
|
|
break;
|
|
Dec(BackCounter);
|
|
end;
|
|
end;
|
|
if SpaceCount2 = SpaceCount1 then
|
|
SpaceCount2 := 0;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// remove visible spaces
|
|
LogSpacePos:=PhysicalToLogicalCol(Temp,SpaceCount2+1);
|
|
Helper:=copy(Temp,LogSpacePos,LogCaretXY.X-LogSpacePos);
|
|
//debugln('ecDeleteLastChar LogSpacePos=',dbgs(LogSpacePos),
|
|
// ' SpaceCount1=',dbgs(SpaceCount1),
|
|
// ' SpaceCount2=',dbgs(SpaceCount2),
|
|
// ' LogCaretXY.X=',dbgs(LogCaretXY.X),
|
|
// ' Temp="',DbgStr(Temp),'" Helper="',DbgStr(Helper),'"');
|
|
Temp:=copy(Temp,1,LogSpacePos-1)+copy(Temp,LogCaretXY.X,MaxInt);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
fCaretX := LogicalToPhysicalCol(Temp,LogSpacePos);
|
|
{$ELSE}
|
|
Helper := Copy(Temp, 1, SpaceCount1 - SpaceCount2);
|
|
Delete(Temp, 1, SpaceCount1 - SpaceCount2);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
fCaretX := fCaretX - (SpaceCount1 - SpaceCount2);
|
|
{$ENDIF}
|
|
fLastCaretX := fCaretX;
|
|
StatusChanged([scCaretX]);
|
|
end else begin
|
|
// delete char
|
|
counter := 1;
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
CaretX := CaretX - counter;
|
|
Helper := Copy(Temp, CaretX, counter);
|
|
VDelete(Temp, CaretX, counter, drLTR);
|
|
{$ELSE USE_UTF8BIDI_LCL}
|
|
LogCaretXY.X:=PhysicalToLogicalCol(Temp,CaretX-counter);
|
|
LogCounter:=GetCharLen(Temp,LogCaretXY.X);
|
|
CaretX := LogicalToPhysicalCol(Temp,LogCaretXY.X);
|
|
Helper := Copy(Temp, LogCaretXY.X, LogCounter);
|
|
System.Delete(Temp, LogCaretXY.X, LogCounter);
|
|
//debugln('ecDeleteLastChar delete char CaretX=',dbgs(CaretX),
|
|
// ' Helper="',DbgStr(Helper),'" Temp="',DbgStr(Temp),'"');
|
|
{$ENDIF USE_UTF8BIDI_LCL}
|
|
{$ELSE}
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if ByteType(Temp, CaretX - 2) = mbLeadByte then
|
|
Inc(counter);
|
|
{$ENDIF}
|
|
CaretX := CaretX - counter;
|
|
Helper := Copy(Temp, CaretX, counter);
|
|
Delete(Temp, CaretX, counter);
|
|
{$ENDIF}
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
end;
|
|
end;
|
|
|
|
if (Caret.X <> CaretX) or (Caret.Y <> CaretY) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if eoGroupUndo in Options then begin
|
|
LastUndoItem := fUndoList.PeekItem;
|
|
if (LastUndoItem <> nil)
|
|
and (LastUndoItem.fChangeReason = crSilentDelete)
|
|
and (LastUndoItem.fChangeStartPos.Y = LastUndoItem.fChangeEndPos.Y)
|
|
and (PhysicalToLogicalPos(CaretXY).Y = LogCaret.Y)
|
|
and (LastUndoItem.fChangeStartPos.X = LogCaret.X)
|
|
then begin // Share the undo item with the delete char action before
|
|
LastUndoItem.fChangeStartPos.X := PhysicalToLogicalPos(CaretXY).X;
|
|
LastUndoItem.fChangeStr := Helper + LastUndoItem.fChangeStr;
|
|
end
|
|
else
|
|
begin
|
|
fUndoList.AddChange(crSilentDelete,
|
|
PhysicalToLogicalPos(CaretXY), LogCaret,
|
|
Helper, smNormal);
|
|
end;
|
|
end else begin
|
|
//debugln('ecDeleteLastChar AddChange CaretXY=',dbgs(CaretXY),
|
|
// ' LogCaret=',dbgs(LogCaret),' Helper="',DbgStr(Helper),'" Temp="',DbgStr(Temp),'"');
|
|
fUndoList.AddChange(crSilentDelete, CaretXY, Caret,
|
|
Helper, smNormal);
|
|
end;
|
|
{$ELSE}
|
|
fUndoList.AddChange(crSilentDelete,CaretXY,Caret,Helper,smNormal);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
ecDeleteChar:
|
|
if not ReadOnly then begin
|
|
if SelAvail then
|
|
SetSelectedTextEmpty
|
|
else begin
|
|
Temp := LineText;
|
|
Len := Length(Temp);
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
{$ENDIF}
|
|
if {$IFDEF SYN_LAZARUS}LogCaretXY.X{$ELSE}CaretX{$ENDIF} <= Len then
|
|
begin
|
|
// delete char
|
|
{$IFDEF SYN_LAZARUS}
|
|
Counter:=GetCharLen(Temp,LogCaretXY.X);
|
|
Helper := Copy(Temp, LogCaretXY.X, Counter);
|
|
Caret.X := LogicalToPhysicalCol(Temp,LogCaretXY.X+Counter);
|
|
Caret.Y := CaretY;
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
VDelete(Temp, LogCaretXY.X, Counter, drLTR);
|
|
{$ELSE USE_UTF8BIDI_LCL}
|
|
System.Delete(Temp, LogCaretXY.X, Counter);
|
|
{$ENDIF USE_UTF8BIDI_LCL}
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
{$ELSE}
|
|
counter := 1;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if ByteType(Temp, CaretX) = mbLeadByte then
|
|
Inc(counter);
|
|
{$ENDIF}
|
|
Helper := Copy(Temp, CaretX, counter);
|
|
Caret := Point(CaretX + counter, CaretY);
|
|
Delete(Temp, CaretX, counter);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
{$ENDIF}
|
|
end else begin
|
|
// join line with the line after
|
|
if CaretY < Lines.Count then begin
|
|
Helper := StringOfChar(' ', CaretX - 1 - Len);
|
|
TrimmedSetLine(CaretY - 1, Temp + Helper + Lines[CaretY]);
|
|
Caret := Point(1, CaretY + 1);
|
|
Helper := {$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#13#10{$ENDIF};
|
|
Lines.Delete(CaretY);
|
|
DoLinesDeleted(CaretY - 1, 1);
|
|
end;
|
|
end;
|
|
if (Caret.X <> CaretX) or (Caret.Y <> CaretY) then begin
|
|
fUndoList.AddChange(crSilentDeleteAfterCursor,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(CaretXY), PhysicalToLogicalPos(Caret),
|
|
{$ELSE}
|
|
CaretXY, Caret,
|
|
{$ENDIF}
|
|
Helper, smNormal);
|
|
end;
|
|
end;
|
|
end;
|
|
ecDeleteWord, ecDeleteEOL:
|
|
if not ReadOnly then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Len := LogicalToPhysicalCol(LineText,Length(LineText)+1)-1;
|
|
{$ELSE}
|
|
Len := Length(LineText);
|
|
{$ENDIF}
|
|
if Command = ecDeleteWord then begin
|
|
if CaretX > Len + 1 then
|
|
CaretX := Len + 1;
|
|
{$IFDEF SYN_LAZARUS}
|
|
WP := NextTokenPos;
|
|
{$ELSE}
|
|
WP := NextWordPos;
|
|
{$ENDIF}
|
|
end else
|
|
WP := Point(Len + 1, CaretY);
|
|
if (WP.X <> CaretX) or (WP.Y <> CaretY) then begin
|
|
OldSelMode := fSelectionMode;
|
|
try
|
|
fSelectionMode := smNormal;
|
|
SetBlockBegin({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
SetBlockEnd({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(WP)
|
|
{$ELSE}WP{$ENDIF});
|
|
fUndoList.AddChange(crSilentDeleteAfterCursor,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(CaretXY), PhysicalToLogicalPos(WP),
|
|
{$ELSE}
|
|
CaretXY, WP,
|
|
{$ENDIF}
|
|
SelText, smNormal);
|
|
SetSelText('');
|
|
finally
|
|
fSelectionMode := OldSelMode;
|
|
end;
|
|
CaretXY := CaretXY;
|
|
end;
|
|
end;
|
|
ecDeleteLastWord, ecDeleteBOL:
|
|
if not ReadOnly then begin
|
|
if Command = ecDeleteLastWord then
|
|
WP := PrevWordPos
|
|
else
|
|
WP := Point(1, CaretY);
|
|
if (WP.X <> CaretX) or (WP.Y <> CaretY) then begin
|
|
OldSelMode := fSelectionMode;
|
|
try
|
|
fSelectionMode := smNormal;
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetBlockBegin(PhysicalToLogicalPos(CaretXY));
|
|
SetBlockEnd(PhysicalToLogicalPos(WP));
|
|
{$ELSE}
|
|
SetBlockBegin(CaretXY);
|
|
SetBlockEnd(WP);
|
|
{$ENDIF}
|
|
fUndoList.AddChange(crSilentDelete,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(WP), PhysicalToLogicalPos(CaretXY),
|
|
{$ELSE}
|
|
WP, CaretXY,
|
|
{$ENDIF}
|
|
SelText, smNormal);
|
|
SetSelText('');
|
|
finally
|
|
fSelectionMode := OldSelMode;
|
|
end;
|
|
CaretXY := WP;
|
|
end;
|
|
end;
|
|
{end} //mh 2000-10-30
|
|
ecDeleteLine:
|
|
if not ReadOnly and not ((Lines.Count = 1) and (Length(Lines[0]) = 0))
|
|
then begin
|
|
if SelAvail then
|
|
SetBlockBegin({$IFDEF SYN_LAZARUS}PhysicalToLogicalPos(CaretXY)
|
|
{$ELSE}CaretXY{$ENDIF});
|
|
if Lines.Count = 1 then begin
|
|
fUndoList.AddChange(crDeleteAfterCursor,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(Point(1, CaretY)),
|
|
PhysicalToLogicalPos(CaretXY),
|
|
{$ELSE}
|
|
Point(1, CaretY), CaretXY,
|
|
{$ENDIF}
|
|
LineText, smNormal);
|
|
Lines[0] := '';
|
|
end else begin
|
|
fUndoList.AddChange(crDeleteAfterCursor,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(Point(1, CaretY)),
|
|
PhysicalToLogicalPos(CaretXY),
|
|
LineText + LineEnding,
|
|
{$ELSE}
|
|
Point(1, CaretY), CaretXY,
|
|
LineText + #13#10,
|
|
{$ENDIF}
|
|
smNormal);
|
|
Lines.Delete(CaretY - 1);
|
|
end;
|
|
DoLinesDeleted(CaretY - 1, 1);
|
|
CaretXY := Point(1, CaretY); // like seen in the Delphi editor
|
|
end;
|
|
ecClearAll:
|
|
begin
|
|
if not ReadOnly then ClearAll;
|
|
end;
|
|
ecInsertLine,
|
|
ecLineBreak:
|
|
if not ReadOnly then begin
|
|
if SelAvail then begin
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText,
|
|
SelectionMode);
|
|
SetSelText('');
|
|
end;
|
|
SpaceCount2 := 0;
|
|
Temp := LineText;
|
|
Temp2 := Temp; //LineText;
|
|
// This is sloppy, but the Right Thing would be to track the column of markers
|
|
// too, so they could be moved depending on whether they are after the caret...
|
|
InsDelta := Ord(CaretX = 1);
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
Len := Length(Temp);
|
|
if Len >= LogCaretXY.X then begin
|
|
if LogCaretXY.X > 1 then begin
|
|
// break line in two
|
|
SpaceCount1 := LeftSpaces(Temp);
|
|
Temp := Copy(LineText, 1, LogCaretXY.X - 1);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
Delete(Temp2, 1, LogCaretXY.X - 1);
|
|
if Assigned(Beautifier) then
|
|
SpaceCount1:=Beautifier.GetIndentForLineBreak(Self,LogCaretXY,Temp2);
|
|
fUndoList.AddChange(crLineBreak,
|
|
LogCaretXY, LogCaretXY,
|
|
Temp2, smNormal);
|
|
Lines.Insert(CaretY, StringOfChar(' ', SpaceCount1) + Temp2);
|
|
if Command = ecLineBreak then
|
|
CaretXY := Point(SpaceCount1 + 1, CaretY + 1);
|
|
end else begin
|
|
// move the whole line
|
|
Lines.Insert(CaretY - 1, '');
|
|
fUndoList.AddChange(crLineBreak,
|
|
LogCaretXY, LogCaretXY,
|
|
Temp2, smNormal);
|
|
if Command = ecLineBreak then
|
|
CaretY := CaretY + 1;
|
|
end;
|
|
end else begin
|
|
// linebreak after end of line
|
|
fUndoList.AddChange(crLineBreak,
|
|
LogCaretXY, LogCaretXY,
|
|
'', smNormal);
|
|
SpaceCount2 := 0;
|
|
if Assigned(Beautifier) then begin
|
|
Temp:='';
|
|
SpaceCount2:=Beautifier.GetIndentForLineBreak(Self,LogCaretXY,Temp);
|
|
end else if eoAutoIndent in Options then begin
|
|
BackCounter := CaretY;
|
|
repeat
|
|
Dec(BackCounter);
|
|
Temp := Lines[BackCounter];
|
|
SpaceCount2 := LeftSpaces(Temp);
|
|
until (BackCounter = 0) or (Temp <> '');
|
|
end;
|
|
Lines.Insert(CaretY, '');
|
|
if Command = ecLineBreak then begin
|
|
if SpaceCount2 > 0 then
|
|
Lines[CaretY] := StringOfChar(' ', SpaceCount2);
|
|
CaretXY := Point(SpaceCount2 + 1, CaretY + 1);
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
Len := Length(Temp);
|
|
if Len > 0 then begin
|
|
if Len >= LogCaretXY.X then begin
|
|
if LogCaretXY.X > 1 then begin
|
|
// break line in two
|
|
SpaceCount1 := LeftSpaces(Temp);
|
|
Temp := Copy(LineText, 1, LogCaretXY.X - 1);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
Delete(Temp2, 1, LogCaretXY.X - 1);
|
|
fUndoList.AddChange(crLineBreak,
|
|
CaretXY, CaretXY,
|
|
Temp2, smNormal);
|
|
Lines.Insert(CaretY, StringOfChar(' ', SpaceCount1) + Temp2);
|
|
if Command = ecLineBreak then
|
|
CaretXY := Point(SpaceCount1 + 1, CaretY + 1);
|
|
end else begin
|
|
// move the whole line
|
|
Lines.Insert(CaretY - 1, '');
|
|
fUndoList.AddChange(crLineBreak,
|
|
CaretXY, CaretXY,
|
|
Temp2, smNormal);
|
|
if Command = ecLineBreak then
|
|
CaretY := CaretY + 1;
|
|
end;
|
|
end else begin
|
|
// linebreak after end of line
|
|
fUndoList.AddChange(crLineBreak,
|
|
CaretXY, CaretXY,
|
|
'', smNormal);
|
|
SpaceCount2 := 0;
|
|
if eoAutoIndent in Options then begin
|
|
BackCounter := CaretY;
|
|
repeat
|
|
Dec(BackCounter);
|
|
Temp := Lines[BackCounter];
|
|
SpaceCount2 := LeftSpaces(Temp);
|
|
until (BackCounter = 0) or (Temp <> '');
|
|
end;
|
|
Lines.Insert(CaretY, '');
|
|
if Command = ecLineBreak then begin
|
|
if SpaceCount2 > 0 then
|
|
Lines[CaretY] := StringOfChar(' ', SpaceCount2);
|
|
CaretXY := Point(SpaceCount2 + 1, CaretY + 1);
|
|
end;
|
|
end;
|
|
end else begin
|
|
// current line is empty
|
|
if fLines.Count = 0 then
|
|
fLines.Add('');
|
|
BackCounter := CaretY - 1;
|
|
while BackCounter >= 0 do begin
|
|
SpaceCount2 := LeftSpaces(Lines[BackCounter]);
|
|
if Length(Lines[BackCounter]) > 0 then break;
|
|
dec(BackCounter);
|
|
end;
|
|
fUndoList.AddChange(crLineBreak,
|
|
CaretXY, CaretXY,
|
|
'', smNormal);
|
|
if Command = ecLineBreak then
|
|
CaretX := SpaceCount2 + 1;
|
|
Lines.Insert(CaretY - 1, '');
|
|
if Command = ecLineBreak then
|
|
CaretY := CaretY + 1;
|
|
end;
|
|
{$ENDIF}
|
|
DoLinesInserted(CaretY - InsDelta, 1);
|
|
EnsureCursorPosVisible; //JGF 2000-09-23
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
end;
|
|
ecTab:
|
|
if not ReadOnly then DoTabKey;
|
|
ecShiftTab:
|
|
if not ReadOnly then
|
|
{$IFDEF SYN_LAZARUS}
|
|
if SelAvail and (eoTabIndent in Options) then
|
|
DoBlockUnindent
|
|
{$ENDIF};
|
|
ecMatchBracket:
|
|
FindMatchingBracket;
|
|
ecChar:
|
|
if not ReadOnly and (AChar >= #32) and (AChar <> #127) then begin
|
|
if SelAvail then begin
|
|
BeginUndoBlock;
|
|
try
|
|
{begin} //mh 2000-11-20
|
|
// fUndoList.AddChange(crSelDelete, fBlockBegin, fBlockEnd, SelText,
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText,
|
|
SelectionMode);
|
|
StartOfBlock := BlockBegin;
|
|
if SelectionMode = smLine then
|
|
StartOfBlock.X := 1;
|
|
SetSelText(AChar);
|
|
//debugln('ecChar SelAvail StartOfBlock=',dbgs(StartOfBlock),' fBlockEnd=',dbgs(fBlockEnd));
|
|
fUndoList.AddChange(crInsert, StartOfBlock, fBlockEnd, '',
|
|
smNormal);
|
|
finally
|
|
EndUndoBlock;
|
|
end;
|
|
{end} //mh 2000-11-20
|
|
end else begin
|
|
Temp := LineText;
|
|
// Added the check for whether or not we're in insert mode.
|
|
// If we are, we append one less space than we would in overwrite mode.
|
|
// This is because in overwrite mode we have to put in a final space
|
|
// character which will be overwritten with the typed character. If we put the
|
|
// extra space in in insert mode, it would be left at the end of the line and
|
|
// cause problems unless eoTrimTrailingSpaces is set.
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaretXY:=PhysicalToLogicalPos(CaretXY);
|
|
{debugln('ecChar CaretXY=',dbgs(CaretXY),
|
|
' LogCaretXY=',dbgs(PhysicalToLogicalPos(CaretXY)),
|
|
' Adjusted LogCaretXY=',dbgs(LogCaretXY),
|
|
' fInserting=',dbgs(fInserting),
|
|
' Temp=',dbgstr(Temp),
|
|
'" UseUTF8=',dbgs(UseUTF8));}
|
|
bChangeScroll := not (eoScrollPastEol in fOptions);
|
|
try
|
|
if bChangeScroll then Include(fOptions, eoScrollPastEol);
|
|
StartOfBlock := LogCaretXY;
|
|
if fInserting then begin
|
|
// insert mode
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
// TODO: improve utf8bidi for tabs
|
|
Len := VLength(Temp, drLTR);
|
|
if Len < CaretX then begin
|
|
Temp := Temp + StringOfChar(' ', CaretX - Len);
|
|
end;
|
|
CaretX := InsertChar(aChar, Temp, CaretX, drLTR);
|
|
{$ELSE}
|
|
Len := Length(Temp);
|
|
if Len < LogCaretXY.X then
|
|
Temp := Temp + StringOfChar(' ', LogCaretXY.X - Len);
|
|
System.Insert(AChar, Temp, LogCaretXY.X);
|
|
//debugln('ecChar Temp=',DbgStr(Temp),' AChar=',DbgStr(AChar));
|
|
CaretX := CaretX + 1;
|
|
{$ENDIF}
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
fUndoList.AddChange(crInsert, StartOfBlock,
|
|
PhysicalToLogicalPos(CaretXY), '', smNormal);
|
|
end else begin
|
|
// overwrite mode
|
|
Counter := GetCharLen(Temp,LogCaretXY.X);
|
|
Helper := Copy(Temp, LogCaretXY.X, Counter);
|
|
{$IFDEF USE_UTF8BIDI_LCL}
|
|
CaretNew.X := CaretX;
|
|
// TODO: improve utf8bidi for tabs
|
|
//utf8bidi.insert(Temp,AChar,CaretNew.X);
|
|
CaretX := CaretNew.X;
|
|
{$ELSE}
|
|
Len := Length(Temp);
|
|
if LogCaretXY.X<=Len then
|
|
Temp:=copy(Temp,1,LogCaretXY.X-1)+AChar
|
|
+copy(Temp,LogCaretXY.X+Counter,length(Temp))
|
|
else
|
|
Temp:=Temp+StringOfChar(' ', LogCaretXY.X-1-Len)+AChar;
|
|
{$ENDIF}
|
|
CaretNew := Point((CaretX + 1), CaretY);
|
|
TrimmedSetLine(CaretY - 1, Temp);
|
|
fUndoList.AddChange(crInsert,
|
|
StartOfBlock, PhysicalToLogicalPos(CaretNew),
|
|
Helper, smNormal);
|
|
CaretX := CaretX + 1;
|
|
end;
|
|
if CaretX >= LeftChar + fCharsInWindow then
|
|
LeftChar := LeftChar + Min(25, fCharsInWindow - 1);
|
|
finally
|
|
if bChangeScroll then Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
{$ELSE below for NOT SYN_LAZARUS ----------------------------------}
|
|
bChangeScroll := not (eoScrollPastEol in fOptions);
|
|
try
|
|
if bChangeScroll then Include(fOptions, eoScrollPastEol);
|
|
StartOfBlock := CaretXY;
|
|
if fInserting then begin
|
|
Len := Length(Temp);
|
|
if Len < CaretX then
|
|
// Temp := Temp + StringOfChar(' ', CaretX - Len);
|
|
Temp := Temp + StringOfChar(' ', CaretX - Len - Ord(fInserting)); //JGF 2000-09-23
|
|
System.Insert(AChar, Temp, CaretX);
|
|
CaretX := CaretX + 1;
|
|
TrimmedSetLine(CaretY - 1, Temp); //JGF 2000-09-23
|
|
fUndoList.AddChange(crInsert, StartOfBlock,
|
|
CaretXY, '', smNormal);
|
|
end else begin
|
|
// Processing of case character covers on LeadByte.
|
|
counter := 1;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (ByteType(Temp, CaretX) = mbLeadByte) then begin
|
|
Inc(counter);
|
|
end;
|
|
{$ENDIF}
|
|
Helper := Copy(Temp, CaretX, counter);
|
|
Temp[CaretX] := AChar;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (counter > 1) then begin
|
|
Temp[CaretX + 1] := ' ';
|
|
end;
|
|
{$ENDIF}
|
|
CaretNew := Point((CaretX + counter), CaretY);
|
|
TrimmedSetLine(CaretY - 1, Temp); //JGF 2000-09-23
|
|
fUndoList.AddChange(crInsert, StartOfBlock, CaretNew,
|
|
Helper, smNormal);
|
|
CaretX := CaretX + 1;
|
|
end;
|
|
if CaretX >= LeftChar + fCharsInWindow then
|
|
LeftChar := LeftChar + Min(25, fCharsInWindow - 1);
|
|
finally
|
|
if bChangeScroll then Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
ecUndo:
|
|
begin
|
|
if not ReadOnly then Undo;
|
|
end;
|
|
ecRedo:
|
|
begin
|
|
if not ReadOnly then Redo;
|
|
end;
|
|
ecGotoMarker0..ecGotoMarker9:
|
|
begin
|
|
if BookMarkOptions.EnableKeys then
|
|
GotoBookMark(Command - ecGotoMarker0);
|
|
end;
|
|
ecSetMarker0..ecSetMarker9:
|
|
begin
|
|
if BookMarkOptions.EnableKeys then begin
|
|
CX := Command - ecSetMarker0;
|
|
if assigned(fBookMarks[CX]) then begin
|
|
moveBkm := (fBookMarks[CX].Line <> CaretY);
|
|
ClearBookMark(CX);
|
|
if moveBkm then
|
|
SetBookMark(CX, CaretX, CaretY);
|
|
end else
|
|
SetBookMark(CX, CaretX, CaretY);
|
|
end; // if BookMarkOptions.EnableKeys
|
|
end;
|
|
ecCut:
|
|
begin
|
|
if (not ReadOnly) and SelAvail then
|
|
CutToClipboard;
|
|
end;
|
|
ecCopy:
|
|
begin
|
|
CopyToClipboard;
|
|
end;
|
|
ecPaste:
|
|
begin
|
|
if not ReadOnly then PasteFromClipboard;
|
|
end;
|
|
ecScrollUp:
|
|
begin
|
|
TopLine := TopLine - 1;
|
|
if CaretY > {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow-1){$ELSE}TopLine + LinesInWindow - 1{$ENDIF} then
|
|
CaretY := {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow-1){$ELSE}TopLine + LinesInWindow - 1{$ENDIF};
|
|
Update;
|
|
end;
|
|
ecScrollDown:
|
|
begin
|
|
TopLine := TopLine + 1;
|
|
if CaretY < TopLine then
|
|
CaretY := TopLine;
|
|
Update;
|
|
end;
|
|
ecScrollLeft:
|
|
begin
|
|
LeftChar := LeftChar - 1;
|
|
if CaretX > LeftChar + CharsInWindow then
|
|
CaretX := LeftChar + CharsInWindow;
|
|
Update;
|
|
end;
|
|
ecScrollRight:
|
|
begin
|
|
LeftChar := LeftChar + 1;
|
|
if CaretX < LeftChar then
|
|
CaretX := LeftChar;
|
|
Update;
|
|
end;
|
|
ecInsertMode:
|
|
begin
|
|
InsertMode := TRUE;
|
|
end;
|
|
ecOverwriteMode:
|
|
begin
|
|
InsertMode := FALSE;
|
|
end;
|
|
ecToggleMode:
|
|
begin
|
|
InsertMode := not InsertMode;
|
|
end;
|
|
ecBlockIndent:
|
|
if not ReadOnly then DoBlockIndent;
|
|
ecBlockUnindent:
|
|
if not ReadOnly then DoBlockUnindent;
|
|
ecNormalSelect,
|
|
ecColumnSelect,
|
|
ecLineSelect:
|
|
begin
|
|
SelectionMode := SEL_MODE[Command];
|
|
end;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
ecImeStr:
|
|
if not ReadOnly then begin
|
|
SetString(s, PChar(Data), StrLen(Data));
|
|
if SelAvail then begin
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, Helper,
|
|
smNormal);
|
|
StartOfBlock := fBlockBegin;
|
|
SetSelText(s);
|
|
fUndoList.AddChange(crInsert, fBlockBegin, fBlockEnd, Helper,
|
|
smNormal);
|
|
end else begin
|
|
Temp := LineText;
|
|
Len := Length(Temp);
|
|
if Len < CaretX then
|
|
Temp := Temp + StringOfChar(' ', CaretX - Len);
|
|
bChangeScroll := not (eoScrollPastEol in fOptions);
|
|
try
|
|
if bChangeScroll then Include(fOptions, eoScrollPastEol);
|
|
StartOfBlock := CaretXY;
|
|
// Processing of case character covers on LeadByte.
|
|
Len := Length(s);
|
|
if not fInserting then begin
|
|
i := (CaretX + Len);
|
|
if (ByteType(Temp, i) = mbTrailByte) then begin
|
|
s := s + Temp[i - 1];
|
|
Helper := Copy(Temp, CaretX, Len - 1);
|
|
end else
|
|
Helper := Copy(Temp, CaretX, Len);
|
|
Delete(Temp, CaretX, Len);
|
|
end;
|
|
Insert(s, Temp, CaretX);
|
|
CaretX := (CaretX + Len);
|
|
TrimmedSetLine(CaretY - 1, Temp); //JGF 2000-09-23
|
|
if fInserting then
|
|
Helper := '';
|
|
fUndoList.AddChange(crInsert, StartOfBlock,
|
|
{$IFDEF SYN_LAZARUS}
|
|
PhysicalToLogicalPos(CaretXY),
|
|
{$ELSE}
|
|
CaretXY,
|
|
{$ENDIF}
|
|
Helper, smNormal);
|
|
if CaretX >= LeftChar + fCharsInWindow then
|
|
LeftChar := LeftChar + min(25, fCharsInWindow - 1);
|
|
finally
|
|
if bChangeScroll then Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
finally
|
|
DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoOnCommandProcessed(Command: TSynEditorCommand;
|
|
AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF};
|
|
Data: pointer);
|
|
begin
|
|
if Assigned(fOnCommandProcessed) then
|
|
fOnCommandProcessed(Self, Command, AChar, Data);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoOnProcessCommand(var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer);
|
|
begin
|
|
if Command < ecUserFirst then begin
|
|
if Assigned(FOnProcessCommand) then
|
|
FOnProcessCommand(Self, Command, AChar, Data);
|
|
end else begin
|
|
if Assigned(FOnProcessUserCommand) then
|
|
FOnProcessUserCommand(Self, Command, AChar, Data);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ClearAll;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
BeginUndoBlock;
|
|
SelectAll;
|
|
SelText:='';
|
|
EndUndoBlock;
|
|
{$ELSE}
|
|
Lines.Clear;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ClearSelection;
|
|
begin
|
|
if SelAvail then
|
|
SelText := '';
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.NextTokenPos: TPoint;
|
|
var
|
|
CX, CY, LineLen: integer;
|
|
Line: string;
|
|
CurIdentChars, WhiteChars: TSynIdentChars;
|
|
nTokenPos, nTokenLen: integer;
|
|
sToken: PChar;
|
|
LogCaret: TPoint;
|
|
|
|
procedure FindFirstNonWhiteSpaceCharInNextLine;
|
|
begin
|
|
if CY < Lines.Count then begin
|
|
Line := Lines[CY];
|
|
LineLen := Length(Line);
|
|
Inc(CY);
|
|
CX:=1;
|
|
while (CX<=LineLen) and (Line[CX] in WhiteChars) do inc(CX);
|
|
if CX>LineLen then CX:=1;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
LogCaret:=PhysicalToLogicalPos(CaretXY);
|
|
CX := LogCaret.X;
|
|
CY := LogCaret.Y;
|
|
// valid line?
|
|
if (CY >= 1) and (CY <= Lines.Count) then begin
|
|
Line := Lines[CY - 1];
|
|
LineLen := Length(Line);
|
|
WhiteChars := [#9,' '];
|
|
if CX > LineLen then begin
|
|
FindFirstNonWhiteSpaceCharInNextLine;
|
|
end else begin
|
|
if fHighlighter<>nil then begin
|
|
fHighlighter.SetRange(TSynEditStringList(Lines).Ranges[CY - 1]);
|
|
fHighlighter.SetLine(Line, CY - 1);
|
|
while not fHighlighter.GetEol do begin
|
|
nTokenPos := fHighlighter.GetTokenPos; // zero-based
|
|
fHighlighter.GetTokenEx(sToken,nTokenLen);
|
|
if (CX>nTokenPos) and (CX<=nTokenPos+nTokenLen) then begin
|
|
CX:=nTokenPos+nTokenLen+1;
|
|
break;
|
|
end;
|
|
// Let the highlighter scan the next token.
|
|
fHighlighter.Next;
|
|
end;
|
|
if fHighlighter.GetEol then
|
|
FindFirstNonWhiteSpaceCharInNextLine;
|
|
end else begin
|
|
// no highlighter
|
|
CurIdentChars:=IdentChars;
|
|
// find first "whitespace" if next char is not a "whitespace"
|
|
if (Line[CX] in CurIdentChars) then begin
|
|
// in a word -> move to end of word
|
|
while (CX<=LineLen) and (Line[CX] in CurIdentChars) do inc(CX);
|
|
end;
|
|
if (Line[CX] in WhiteChars) then begin
|
|
// skip white space
|
|
while (CX<=LineLen) and (Line[CX] in WhiteChars) do inc(CX);
|
|
end;
|
|
// delete at least one char
|
|
if (CX=CaretX) then inc(CX);
|
|
end;
|
|
end;
|
|
end;
|
|
Result := LogicalToPhysicalPos(Point(CX, CY));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.NextWordPos: TPoint;
|
|
var
|
|
CX, CY, LineLen: integer;
|
|
Line: string;
|
|
CurIdentChars, WhiteChars: TSynIdentChars;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaret: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaret:=PhysicalToLogicalPos(CaretXY);
|
|
CX := LogCaret.X;
|
|
CY := LogCaret.Y;
|
|
{$ELSE}
|
|
CX := CaretX;
|
|
CY := CaretY;
|
|
{$ENDIF}
|
|
// valid line?
|
|
if (CY >= 1) and (CY <= Lines.Count) then begin
|
|
Line := Lines[CY - 1];
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Assigned(Highlighter) then
|
|
CurIdentChars := [#1..#255] - (Highlighter.WordBreakChars + TSynWhiteChars)
|
|
else
|
|
CurIdentChars := [#1..#255] - (TSynWordBreakChars + TSynWhiteChars);
|
|
WhiteChars := TSynWhiteChars + ([#1..#255] - CurIdentChars);
|
|
{$ELSE}
|
|
CurIdentChars:=IdentChars;
|
|
WhiteChars := [#1..#255] - CurIdentChars;
|
|
{$ENDIF}
|
|
LineLen := Length(Line);
|
|
|
|
if CX >= LineLen then begin
|
|
// find first IdentChar in the next line
|
|
if CY < Lines.Count then begin
|
|
Line := Lines[CY];
|
|
Inc(CY);
|
|
CX := Max(1, StrScanForCharInSet(Line, 1, CurIdentChars));
|
|
end;
|
|
end else begin
|
|
// find first "whitespace" if next char is an IdentChar
|
|
if Line[CX] in CurIdentChars then
|
|
CX := StrScanForCharInSet(Line, CX, WhiteChars);
|
|
// if "whitespace" found find the first IdentChar behind
|
|
if CX > 0 then
|
|
CX := StrScanForCharInSet(Line, CX, CurIdentChars);
|
|
// if one of those failed just position at the end of the line
|
|
if CX = 0 then
|
|
CX := LineLen + 1;
|
|
end;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
Result := LogicalToPhysicalPos(Point(CX, CY));
|
|
{$ELSE}
|
|
Result := Point(CX, CY);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TCustomSynEdit.PrevWordPos: TPoint;
|
|
var
|
|
CX, CY: integer;
|
|
Line: string;
|
|
CurIdentChars, WhiteChars: TSynIdentChars;
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaret: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
LogCaret:=LogicalCaretXY;
|
|
CX := LogCaret.X;
|
|
CY := LogCaret.Y;
|
|
{$ELSE}
|
|
CX := CaretX;
|
|
CY := CaretY;
|
|
{$ENDIF}
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos ',dbgs(LogCaret)]);
|
|
// valid line?
|
|
if (CY >= 1) and (CY <= Lines.Count) then begin
|
|
Line := Lines[CY - 1];
|
|
CX := Min(CX, Length(Line) + 1);
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Assigned(Highlighter) then
|
|
CurIdentChars := [#1..#255] - (Highlighter.WordBreakChars + TSynWhiteChars)
|
|
else
|
|
CurIdentChars := [#1..#255] - (TSynWordBreakChars + TSynWhiteChars);
|
|
WhiteChars := TSynWhiteChars + ([#1..#255] - CurIdentChars);
|
|
{$ELSE}
|
|
CurIdentChars:=IdentChars;
|
|
WhiteChars := [#1..#255] - CurIdentChars;
|
|
{$ENDIF}
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos Line="',dbgstr(Line),'" CX=',CX]);
|
|
if CX <= 1 then begin
|
|
// find last IdentChar in the previous line
|
|
if CY > 1 then begin
|
|
Dec(CY);
|
|
Line := Lines[CY - 1];
|
|
CX := Length(Line) + 1;
|
|
end;
|
|
end else begin
|
|
// if previous char is a "whitespace" search for the last IdentChar
|
|
if Line[CX - 1] in WhiteChars then
|
|
CX := StrRScanForCharInSet(Line, CX - 1, CurIdentChars);
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos AAA1 CX=',CX]);
|
|
if CX > 0 then
|
|
// search for the first IdentChar of this "word"
|
|
CX := StrRScanForCharInSet(Line, CX - 1, WhiteChars) + 1
|
|
else
|
|
// just position at the end of the previous line
|
|
if CY > 1 then begin
|
|
Dec(CY);
|
|
Line := Lines[CY - 1];
|
|
CX := Length(Line) + 1;
|
|
end;
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos AAA2 CX=',CX]);
|
|
end;
|
|
end;
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos AAA3 ',CX,',',CY]);
|
|
{$IFDEF SYN_LAZARUS}
|
|
Result := LogicalToPhysicalPos(Point(CX, CY));
|
|
{$ELSE}
|
|
Result := Point(CX, CY);
|
|
{$ENDIF}
|
|
//DebugLn(['TCustomSynEdit.PrevWordPos END ',dbgs(Result)]);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetSelectionMode(const Value: TSynSelectionMode);
|
|
begin
|
|
if FSelectionMode <> Value then begin
|
|
FSelectionMode := Value;
|
|
if SelAvail then
|
|
Invalidate;
|
|
StatusChanged([scSelection]);
|
|
end;
|
|
end;
|
|
|
|
{begin} //sbs 2000-11-19
|
|
procedure TCustomSynEdit.BeginUndoBlock;
|
|
begin
|
|
fUndoList.BeginBlock;
|
|
end;
|
|
{end} //sbs 2000-11-19
|
|
|
|
procedure TCustomSynEdit.BeginUpdate;
|
|
begin
|
|
IncPaintLock;
|
|
end;
|
|
|
|
{begin} //sbs 2000-11-19
|
|
procedure TCustomSynEdit.EndUndoBlock;
|
|
begin
|
|
fUndoList.EndBlock;
|
|
end;
|
|
{end} //sbs 2000-11-19
|
|
|
|
procedure TCustomSynEdit.EndUpdate;
|
|
begin
|
|
DecPaintLock;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.AddKey(Command: TSynEditorCommand;
|
|
Key1: word; SS1: TShiftState; Key2: word; SS2: TShiftState);
|
|
var
|
|
Key: TSynEditKeyStroke;
|
|
begin
|
|
Key := Keystrokes.Add;
|
|
Key.Command := Command;
|
|
Key.Key := Key1;
|
|
Key.Shift := SS1;
|
|
Key.Key2 := Key2;
|
|
Key.Shift2 := SS2;
|
|
end;
|
|
|
|
{ Called by FMarkList if change }
|
|
procedure TCustomSynEdit.MarkListChange(Sender: TObject);
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
Invalidate; // marks can have special line colors
|
|
{$ELSE}
|
|
InvalidateGutter;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.GetSelStart: integer; //L505 begin
|
|
|
|
function llen(const data: string): integer;
|
|
begin
|
|
result := length(Data) + length(LineEnding);
|
|
end;
|
|
|
|
var
|
|
loop: integer;
|
|
p: TPoint;
|
|
begin
|
|
if SelAvail then
|
|
begin
|
|
p:=BlockBegin;
|
|
end
|
|
else
|
|
begin
|
|
p:=LogicalCaretXY;
|
|
end;
|
|
|
|
result := 0;
|
|
loop := 0;
|
|
while (loop < (p.Y - 1)) and (loop < Lines.Count) do
|
|
begin
|
|
result := result + llen(lines[loop]);
|
|
inc(loop);
|
|
end;
|
|
if loop < Lines.Count then
|
|
result := result + Min(p.X, length(lines[loop]) + 1);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetSelStart(const Value: integer);
|
|
|
|
function llen(const data: string): integer;
|
|
begin
|
|
result := length(Data) + length(LineEnding);
|
|
end;
|
|
|
|
var
|
|
loop: integer;
|
|
count: integer;
|
|
begin
|
|
loop := 0;
|
|
count := 0;
|
|
while (loop < Lines.Count) and (count + llen(lines[loop]) < value) do begin
|
|
count := count + llen(lines[loop]);
|
|
inc(loop);
|
|
end;
|
|
{ CaretX := value - count;
|
|
CaretY := loop + 1;
|
|
|
|
fBlockBegin.X := CaretX;
|
|
fBlockBegin.Y := CaretY;}
|
|
|
|
//This seems the same as above, but uses the other fixes inside of SetCaretXY
|
|
//to adjust the cursor pos correctly.
|
|
BlockBegin := Point(value - count, loop + 1);
|
|
CaretXY := LogicalToPhysicalPos(BlockBegin);
|
|
end;
|
|
|
|
function TCustomSynEdit.GetSelEnd: integer;
|
|
|
|
function llen(const data: string): integer;
|
|
begin
|
|
result := length(Data) + length(LineEnding);
|
|
end;
|
|
|
|
var
|
|
loop: integer;
|
|
p: TPoint;
|
|
begin
|
|
if SelAvail then
|
|
begin
|
|
p := BlockEnd;
|
|
end else begin
|
|
p := LogicalCaretXY;
|
|
end;
|
|
|
|
result := 0;
|
|
loop := 0;
|
|
while (loop < (p.y - 1)) and (loop < Lines.Count) do begin
|
|
Result := result + llen(lines[loop]);
|
|
inc(loop);
|
|
end;
|
|
if loop<Lines.Count then
|
|
result := result + p.x;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetSelEnd(const Value: integer);
|
|
|
|
function llen(const data: string): integer;
|
|
begin
|
|
result := length(Data) + length(LineEnding);
|
|
end;
|
|
|
|
var
|
|
p: TPoint;
|
|
loop: integer;
|
|
count: integer;
|
|
begin
|
|
loop := 0;
|
|
count := 0;
|
|
while (loop < Lines.Count) and (count + llen(lines[loop]) < value) do begin
|
|
count := count + llen(lines.strings[loop]);
|
|
inc(loop);
|
|
end;
|
|
p.x := value - count; p.y := loop + 1;
|
|
BlockEnd := p;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetSelWord;
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
SetWordBlock(PhysicalToLogicalPos(CaretXY));
|
|
{$ELSE}
|
|
SetWordBlock(CaretXY);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetExtraLineSpacing(const Value: integer);
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fExtraLineSpacing=Value then exit;
|
|
{$ENDIF}
|
|
fExtraLineSpacing := Value;
|
|
FontChanged(self);
|
|
end;
|
|
|
|
function TCustomSynEdit.GetBookMark(BookMark: integer; var X, Y: integer):
|
|
boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := false;
|
|
if assigned(Marks) then
|
|
for i := 0 to Marks.Count - 1 do
|
|
if Marks[i].IsBookmark and (Marks[i].BookmarkNumber = BookMark) then begin
|
|
X := Marks[i].Column;
|
|
Y := Marks[i].Line;
|
|
Result := true;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.IsBookmark(BookMark: integer): boolean;
|
|
var
|
|
x, y: integer;
|
|
begin
|
|
Result := GetBookMark(BookMark, x, y);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.ClearUndo;
|
|
begin
|
|
fUndoList.Clear;
|
|
fRedoList.Clear;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetSelTextExternal(const Value: string);
|
|
var
|
|
StartOfBlock, EndOfBlock: TPoint;
|
|
begin
|
|
{begin} //mh 2000-11-20
|
|
BeginUndoBlock;
|
|
try
|
|
{$IFDEF SYN_LAZARUS}
|
|
if SelAvail then begin
|
|
fUndoList.AddChange({crSelDelete} crDelete, fBlockBegin, fBlockEnd,
|
|
GetSelText, SelectionMode);
|
|
StartOfBlock := minPoint(fBlockBegin, fBlockEnd);
|
|
EndOfBlock := maxPoint(fBlockBegin, fBlockEnd);
|
|
end else begin
|
|
StartOfBlock := CaretXY;
|
|
EndOfBlock := CaretXY;
|
|
end;
|
|
{$ELSE}
|
|
if SelAvail then begin
|
|
fUndoList.AddChange({crSelDelete} crDelete, fBlockBegin, fBlockEnd,
|
|
GetSelText, SelectionMode);
|
|
end;
|
|
StartOfBlock := minPoint(fBlockBegin, fBlockEnd);
|
|
EndOfBlock := maxPoint(fBlockBegin, fBlockEnd);
|
|
{$ENDIF}
|
|
fBlockBegin := StartOfBlock;
|
|
fBlockEnd := EndOfBlock;
|
|
LockUndo;
|
|
SetSelText(Value);
|
|
UnlockUndo;
|
|
fUndoList.AddChange(crInsert, StartOfBlock, BlockEnd,
|
|
{$IFDEF SYN_LAZARUS}''{$ELSE}SelText{$ENDIF}, smNormal);
|
|
finally
|
|
EndUndoBlock;
|
|
end;
|
|
{end} //mh 2000-11-20
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetGutter(const Value: TSynGutter);
|
|
begin
|
|
fGutter.Assign(Value);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.GutterChanged(Sender: TObject);
|
|
var
|
|
nW: integer;
|
|
begin
|
|
if not (csLoading in ComponentState) then begin
|
|
if fGutter.ShowLineNumbers and fGutter.AutoSize then
|
|
fGutter.AutoSizeDigitCount(Lines.Count);
|
|
nW := fGutter.RealGutterWidth(fCharWidth);
|
|
if nW = fGutterWidth then
|
|
InvalidateGutter
|
|
else
|
|
SetGutterWidth(nW);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.LockUndo;
|
|
begin
|
|
fUndoList.Lock;
|
|
fRedoList.Lock
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UnlockUndo;
|
|
begin
|
|
fUndoList.Unlock;
|
|
fRedoList.Unlock;
|
|
end;
|
|
|
|
{$IFNDEF SYN_LAZARUS}
|
|
|
|
procedure TCustomSynEdit.WMMouseWheel(var Msg: TMessage);
|
|
var
|
|
nDelta: integer;
|
|
nWheelClicks: integer;
|
|
{$IFNDEF SYN_COMPILER_4_UP}
|
|
const
|
|
LinesToScroll = 3;
|
|
WHEEL_DELTA = 120;
|
|
WHEEL_PAGESCROLL = MAXDWORD;
|
|
{$ENDIF}
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
exit;
|
|
|
|
if GetKeyState(VK_CONTROL) >= 0 then
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
nDelta := Mouse.WheelScrollLines
|
|
{$ELSE}
|
|
nDelta := LinesToScroll
|
|
{$ENDIF}
|
|
else begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
nDelta := fLinesInWindow;
|
|
if (eoHalfPageScroll in fOptions) then counter:=counter shr 1;
|
|
{$ELSE}
|
|
nDelta := fLinesInWindow shr Ord(eoHalfPageScroll in fOptions);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
Inc(fMouseWheelAccumulator, SmallInt(Msg.wParamHi));
|
|
nWheelClicks := fMouseWheelAccumulator div WHEEL_DELTA;
|
|
fMouseWheelAccumulator := fMouseWheelAccumulator mod WHEEL_DELTA;
|
|
if (nDelta = integer(WHEEL_PAGESCROLL)) or (nDelta > LinesInWindow) then
|
|
nDelta := LinesInWindow;
|
|
TopLine := TopLine - (nDelta * nWheelClicks);
|
|
Update;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetWantTabs(const Value: boolean);
|
|
begin
|
|
fWantTabs := Value;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetTabWidth(Value: integer);
|
|
begin
|
|
Value := MinMax(Value, 1{0}, 256); //lt 2000-10-19
|
|
if (Value <> fTabWidth) then begin
|
|
fTabWidth := Value;
|
|
TSynEditStringList(Lines).TabWidth := Value; //mh 2000-10-19
|
|
Invalidate; // to redraw text containing tab chars
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SelectedColorsChanged(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
// find / replace
|
|
|
|
function TCustomSynEdit.SearchReplace(const ASearch, AReplace: string;
|
|
AOptions: TSynSearchOptions): integer;
|
|
var
|
|
ptStart, ptEnd: TPoint; // start and end of the search range
|
|
ptCurrent: TPoint; // current search position
|
|
nFound: integer;
|
|
bBackward, bFromCursor: boolean;
|
|
bPrompt: boolean;
|
|
bReplace, bReplaceAll: boolean;
|
|
nAction: TSynReplaceAction;
|
|
{$IFDEF SYN_LAZARUS}
|
|
CurReplace: string;
|
|
ptFoundStart, ptFoundEnd: TPoint;
|
|
{$ELSE}
|
|
n, nSearchLen, nReplaceLen, nInLine: integer;
|
|
{$ENDIF}
|
|
|
|
function InValidSearchRange(First, Last: integer): boolean;
|
|
begin
|
|
Result := TRUE;
|
|
case fSelectionMode of
|
|
smNormal:
|
|
if ((ptCurrent.Y = ptStart.Y) and (First < ptStart.X)) or
|
|
((ptCurrent.Y = ptEnd.Y) and (Last > ptEnd.X)) then Result := FALSE;
|
|
smColumn:
|
|
Result := (First >= ptStart.X) and (Last <= ptEnd.X);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result := 0;
|
|
// can't search for or replace an empty string
|
|
if Length(ASearch) = 0 then exit;
|
|
// get the text range to search in, ignore the "Search in selection only"
|
|
// option if nothing is selected
|
|
bBackward := (ssoBackwards in AOptions);
|
|
bPrompt := (ssoPrompt in AOptions);
|
|
bReplace := (ssoReplace in AOptions);
|
|
bReplaceAll := (ssoReplaceAll in AOptions);
|
|
bFromCursor := not (ssoEntireScope in AOptions);
|
|
if not SelAvail then Exclude(AOptions, ssoSelectedOnly);
|
|
if (ssoSelectedOnly in AOptions) then begin
|
|
ptStart := BlockBegin;
|
|
ptEnd := BlockEnd;
|
|
// search the whole line in the line selection mode
|
|
if (fSelectionMode = smLine) then begin
|
|
ptStart.X := 1;
|
|
ptEnd.X := Length(Lines[ptEnd.Y - 1]) + 1;
|
|
end else if (fSelectionMode = smColumn) then
|
|
// make sure the start column is smaller than the end column
|
|
if (ptStart.X > ptEnd.X) then begin
|
|
nFound := ptStart.X;
|
|
ptStart.X := ptEnd.X;
|
|
ptEnd.X := nFound;
|
|
end;
|
|
// ignore the cursor position when searching in the selection
|
|
if bBackward then ptCurrent := ptEnd else ptCurrent := ptStart;
|
|
end else begin
|
|
ptStart := Point(1, 1);
|
|
ptEnd.Y := Lines.Count;
|
|
ptEnd.X := Length(Lines[ptEnd.Y - 1]) + 1;
|
|
if bFromCursor then
|
|
if bBackward then
|
|
ptEnd := {$IFDEF SYN_LAZARUS}LogicalCaretXY{$ELSE}CaretXY{$ENDIF}
|
|
else
|
|
ptStart := {$IFDEF SYN_LAZARUS}LogicalCaretXY{$ELSE}CaretXY{$ENDIF};
|
|
if bBackward then ptCurrent := ptEnd else ptCurrent := ptStart;
|
|
end;
|
|
// initialize the search engine
|
|
fTSearch.Sensitive := ssoMatchCase in AOptions;
|
|
fTSearch.Whole := ssoWholeWord in AOptions;
|
|
fTSearch.Pattern := ASearch;
|
|
fTSearch.RegularExpressions := ssoRegExpr in AOptions;
|
|
{$IFDEF SYN_LAZARUS}
|
|
fTSearch.RegExprMultiLine := ssoRegExprMultiLine in AOptions;
|
|
fTSearch.Replacement:=AReplace;
|
|
fTSearch.Backwards:=bBackward;
|
|
{$ELSE}
|
|
nSearchLen := Length(ASearch);
|
|
nReplaceLen := Length(AReplace);
|
|
{$ENDIF}
|
|
// search while the current search position is inside of the search range
|
|
if bReplaceAll then IncPaintLock;
|
|
try
|
|
{$IFDEF SYN_LAZARUS}
|
|
//DebugLn(['TCustomSynEdit.SearchReplace ptStart=',dbgs(ptStart),' ptEnd=',dbgs(ptEnd),' ASearch="',dbgstr(ASearch),'" AReplace="',dbgstr(AReplace),'"']);
|
|
while fTSearch.FindNextOne(Lines,ptStart,ptEnd,ptFoundStart,ptFoundEnd) do
|
|
begin
|
|
//DebugLn(['TCustomSynEdit.SearchReplace FOUND ptStart=',dbgs(ptStart),' ptEnd=',dbgs(ptEnd),' ptFoundStart=',dbgs(ptFoundStart),' ptFoundEnd=',dbgs(ptFoundEnd)]);
|
|
// check if found place is entirely in range
|
|
if (fSelectionMode<>smColumn)
|
|
or ((ptFoundStart.Y=ptFoundEnd.Y)
|
|
and (ptFoundStart.X >= ptStart.X) and (ptFoundEnd.X <= ptEnd.X)) then
|
|
begin
|
|
// pattern found
|
|
Inc(Result);
|
|
// Select the text, so the user can see it in the OnReplaceText event
|
|
// handler or as the search result.
|
|
BlockBegin := ptFoundStart;
|
|
if bBackward then LogicalCaretXY := BlockBegin;
|
|
BlockEnd := ptFoundEnd;
|
|
if not bBackward then LogicalCaretXY := ptFoundEnd;
|
|
// If it's a 'search' only we can leave the procedure now.
|
|
if not (bReplace or bReplaceAll) then exit;
|
|
// Prompt and replace or replace all. If user chooses to replace
|
|
// all after prompting, turn off prompting.
|
|
CurReplace:=AReplace;
|
|
if ssoRegExpr in AOptions then
|
|
CurReplace:=fTSearch.RegExprReplace;
|
|
if bPrompt and Assigned(fOnReplaceText) then begin
|
|
EnsureCursorPosVisible;
|
|
nAction := DoOnReplaceText(ASearch,CurReplace,
|
|
ptFoundStart.Y,ptFoundStart.X);
|
|
if nAction = raCancel then exit;
|
|
end else
|
|
nAction := raReplace;
|
|
if not (nAction = raSkip) then begin
|
|
// user has been prompted and has requested to silently replace all
|
|
// so turn off prompting
|
|
if nAction = raReplaceAll then begin
|
|
if not bReplaceAll then begin
|
|
bReplaceAll := TRUE;
|
|
IncPaintLock;
|
|
end;
|
|
bPrompt := False;
|
|
end;
|
|
// replace text
|
|
//DebugLn(['TCustomSynEdit.SearchReplace OldSel="',dbgstr(SelText),'"']);
|
|
SetSelTextExternal(CurReplace);
|
|
//DebugLn(['TCustomSynEdit.SearchReplace NewSel="',dbgstr(SelText),'"']);
|
|
// adjust positions
|
|
ptEnd:=AdjustPositionAfterReplace(ptEnd,ptFoundStart,ptFoundEnd,
|
|
CurReplace);
|
|
ptFoundEnd:=AdjustPositionAfterReplace(ptFoundEnd,
|
|
ptFoundStart,ptFoundEnd,CurReplace);
|
|
end;
|
|
if not bReplaceAll then
|
|
exit;
|
|
end;
|
|
// shrink search range for next search
|
|
if ssoSearchInReplacement in AOptions then begin
|
|
if bBackward then begin
|
|
ptEnd:=ptFoundEnd;
|
|
end else begin
|
|
ptStart:=ptFoundStart;
|
|
end;
|
|
end else begin
|
|
if bBackward then begin
|
|
ptEnd:=ptFoundStart;
|
|
end else begin
|
|
ptStart:=ptFoundEnd;
|
|
end;
|
|
end;
|
|
//DebugLn(['TCustomSynEdit.SearchReplace FIND NEXT ptStart=',dbgs(ptStart),' ptEnd=',dbgs(ptEnd)]);
|
|
end;
|
|
{$ELSE}
|
|
while (ptCurrent.Y >= ptStart.Y) and (ptCurrent.Y <= ptEnd.Y) do begin
|
|
nInLine := fTSearch.FindAll(Lines[ptCurrent.Y - 1]);
|
|
if bBackward then n := Pred(fTSearch.ResultCount) else n := 0;
|
|
// Operate on all results in this line.
|
|
while nInLine > 0 do begin
|
|
nFound := fTSearch.Results[n];
|
|
if bBackward then Dec(n) else Inc(n);
|
|
Dec(nInLine);
|
|
// Is the search result entirely in the search range?
|
|
if not InValidSearchRange(nFound, nFound + nSearchLen) then continue;
|
|
Inc(Result);
|
|
// Select the text, so the user can see it in the OnReplaceText event
|
|
// handler or as the search result.
|
|
ptCurrent.X := nFound;
|
|
BlockBegin := ptCurrent;
|
|
if bBackward then CaretXY := ptCurrent;
|
|
Inc(ptCurrent.X, nSearchLen);
|
|
BlockEnd := ptCurrent;
|
|
if not bBackward then CaretXY := ptCurrent;
|
|
// If it's a search only we can leave the procedure now.
|
|
if not (bReplace or bReplaceAll) then exit;
|
|
// Prompt and replace or replace all. If user chooses to replace
|
|
// all after prompting, turn off prompting.
|
|
if bPrompt and Assigned(fOnReplaceText) then begin
|
|
EnsureCursorPosVisible;
|
|
nAction := DoOnReplaceText(ASearch,AReplace,ptCurrent.Y, nFound);
|
|
if nAction = raCancel then exit;
|
|
end else
|
|
nAction := raReplace;
|
|
if not (nAction = raSkip) then begin
|
|
// user has been prompted and has requested to silently replace all
|
|
// so turn off prompting
|
|
if nAction = raReplaceAll then begin
|
|
if not bReplaceAll then begin
|
|
bReplaceAll := TRUE;
|
|
IncPaintLock;
|
|
end;
|
|
bPrompt := False;
|
|
end;
|
|
SetSelTextExternal(AReplace);
|
|
end;
|
|
// fix the caret position and the remaining results
|
|
if not bBackward then begin
|
|
CaretX := nFound + nReplaceLen;
|
|
if (nSearchLen <> nReplaceLen) and (nAction <> raSkip) then
|
|
fTSearch.FixResults(nFound, nSearchLen - nReplaceLen);
|
|
end;
|
|
if not bReplaceAll then
|
|
exit;
|
|
end;
|
|
// search next / previous line
|
|
if bBackward then Dec(ptCurrent.Y) else Inc(ptCurrent.Y);
|
|
end;
|
|
{$ENDIF}
|
|
finally
|
|
if bReplaceAll then DecPaintLock;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
|
|
procedure TCustomSynEdit.MBCSGetSelRangeInLineWhenColumnSelectionMode(
|
|
const s: string; var ColFrom, ColTo: Integer);
|
|
// --ColFrom and ColTo are in/out parameter. their range
|
|
// will be from 1 to MaxInt.
|
|
// --a range of selection means: Copy(s, ColFrom, ColTo - ColFrom);
|
|
// be careful what ColTo means.
|
|
var
|
|
Len: Integer;
|
|
begin
|
|
Len := Length(s);
|
|
if (0 < ColFrom) and (ColFrom <= Len) then
|
|
if mbTrailByte = ByteType(s, ColFrom) then
|
|
Inc(ColFrom);
|
|
if (0 < ColTo) and (ColTo <= Len) then
|
|
if mbTrailByte = ByteType(s, ColTo) then
|
|
Inc(ColTo);
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.IsPointInSelection(Value: TPoint): boolean;
|
|
var
|
|
ptBegin, ptEnd: TPoint;
|
|
begin
|
|
ptBegin := BlockBegin;
|
|
ptEnd := BlockEnd;
|
|
if (Value.Y >= ptBegin.Y) and (Value.Y <= ptEnd.Y) and
|
|
((ptBegin.Y <> ptEnd.Y) or (ptBegin.X <> ptEnd.X))
|
|
then begin
|
|
if SelectionMode = smLine then
|
|
Result := TRUE
|
|
else if (SelectionMode = smColumn) then begin
|
|
if (ptBegin.X > ptEnd.X) then
|
|
Result := (Value.X >= ptEnd.X) and (Value.X < ptBegin.X)
|
|
else if (ptBegin.X < ptEnd.X) then
|
|
Result := (Value.X >= ptBegin.X) and (Value.X < ptEnd.X)
|
|
else
|
|
Result := FALSE;
|
|
end else
|
|
Result := ((Value.Y > ptBegin.Y) or (Value.X >= ptBegin.X)) and
|
|
((Value.Y < ptEnd.Y) or (Value.X < ptEnd.X));
|
|
end else
|
|
Result := FALSE;
|
|
end;
|
|
|
|
{$IFNDEF SYN_LAZARUS}
|
|
{ LCL never sends WM_SETCURSOR messages, use OnMouseMove and then set cursor }
|
|
|
|
procedure TCustomSynEdit.WMSetCursor(var Msg: TWMSetCursor);
|
|
var
|
|
ptCursor, ptLineCol: TPoint;
|
|
begin
|
|
GetCursorPos(ptCursor);
|
|
ptCursor := ScreenToClient(ptCursor);
|
|
if (ptCursor.X < fGutterWidth) then
|
|
// ToDo TStreenCursors
|
|
SetCursor(Screen.Cursors[fGutter.Cursor])
|
|
else begin
|
|
ptLineCol.X := (LeftChar * fCharWidth + ptCursor.X - fGutterWidth - 2)
|
|
div fCharWidth;
|
|
ptLineCol.Y := TopLine + ptCursor.Y div fTextHeight;
|
|
if (eoDragDropEditing in fOptions) and IsPointInSelection(ptLineCol) then
|
|
// ToDo TStreenCursors
|
|
SetCursor(Screen.Cursors[crDefault])
|
|
else
|
|
// ToDo WMSetCursor
|
|
inherited WMSetCursor(Msg);
|
|
end;
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
procedure TCustomSynEdit.BookMarkOptionsChanged(Sender: TObject);
|
|
begin
|
|
InvalidateGutter;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetOptions(Value: TSynEditorOptions);
|
|
var
|
|
bSetDrag: boolean;
|
|
{$IFDEF SYN_LAZARUS}
|
|
ChangedOptions: TSynEditorOptions;
|
|
{$ENDIF}
|
|
begin
|
|
if (Value <> fOptions) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
ChangedOptions:=(fOptions-Value)+(Value-fOptions);
|
|
{$ENDIF}
|
|
bSetDrag := (eoDropFiles in fOptions) <> (eoDropFiles in Value);
|
|
fOptions := Value;
|
|
// Reset column position in case Cursor is past EOL.
|
|
if not (eoScrollPastEol in fOptions) then
|
|
CaretX := CaretX;
|
|
// (un)register HWND as drop target
|
|
if bSetDrag and not (csDesigning in ComponentState) and HandleAllocated then
|
|
{$IFDEF SYN_LAZARUS}
|
|
// ToDo DragAcceptFiles
|
|
;
|
|
{$ELSE}
|
|
DragAcceptFiles(Handle, (eoDropFiles in fOptions));
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoPersistentCaret in ChangedOptions) and HandleAllocated then begin
|
|
SetCaretRespondToFocus(Handle,not (eoPersistentCaret in fOptions));
|
|
UpdateCaret;
|
|
end;
|
|
if (eoShowCtrlMouseLinks in ChangedOptions) and HandleAllocated then
|
|
UpdateCtrlMouse;
|
|
if (eoShowSpecialChars in ChangedOptions) and HandleAllocated then
|
|
Invalidate;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.SetOptions2(const Value: TSynEditorOptions2);
|
|
begin
|
|
if (Value <> fOptions2) then begin
|
|
fOptions2 := Value;
|
|
// Reset column position in case Cursor is past EOL.
|
|
if not (eoScrollPastEol in fOptions) then
|
|
CaretX := CaretX;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetOptionFlag(Flag: TSynEditorOption; Value: boolean);
|
|
begin
|
|
if (Value <> (Flag in fOptions)) then begin
|
|
if Value then Include(fOptions, Flag) else Exclude(fOptions, Flag);
|
|
if (Flag = eoScrollPastEol) and not Value then
|
|
CaretX := CaretX;
|
|
{begin} //mh 2000-10-19
|
|
if not (eoScrollPastEol in Options) then
|
|
LeftChar := LeftChar;
|
|
if not (eoScrollPastEof in Options) then
|
|
TopLine := TopLine;
|
|
{end} //mh 2000-10-19
|
|
if (Flag = eoDropFiles) then begin
|
|
if not (csDesigning in ComponentState) and HandleAllocated then
|
|
{$IFDEF SYN_LAZARUS}
|
|
// ToDo DragAcceptFiles
|
|
;
|
|
{$ELSE}
|
|
DragAcceptFiles(Handle, Value);
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (Flag = eoPersistentCaret) and HandleAllocated then
|
|
SetCaretRespondToFocus(Handle,not (eoPersistentCaret in fOptions));
|
|
{$ENDIF}
|
|
EnsureCursorPosVisible;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SizeOrFontChanged(bFont: boolean);
|
|
begin
|
|
if HandleAllocated then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
LastMouseCaret:=Point(-1,-1);
|
|
fCharsInWindow := Max(1,(ClientWidth - fGutterWidth - 2 - ScrollBarWidth)
|
|
div fCharWidth);
|
|
fLinesInWindow := Max(0,ClientHeight - ScrollBarWidth) div Max(1,fTextHeight);
|
|
fMarkupManager.LinesInWindow:= fLinesInWindow;
|
|
//DebugLn('TCustomSynEdit.SizeOrFontChanged fLinesInWindow=',dbgs(fLinesInWindow),' ClientHeight=',dbgs(ClientHeight),' ',dbgs(fTextHeight));
|
|
//debugln('TCustomSynEdit.SizeOrFontChanged A ClientWidth=',dbgs(ClientWidth),' fGutterWidth=',dbgs(fGutterWidth),' ScrollBarWidth=',dbgs(ScrollBarWidth),' fCharWidth=',dbgs(fCharWidth),' fCharsInWindow=',dbgs(fCharsInWindow),' Width=',dbgs(Width));
|
|
{$ELSE}
|
|
fCharsInWindow := Max(1,Max(0,(ClientWidth - fGutterWidth - 2
|
|
- ScrollBarWidth) div Max(1,fCharWidth)));
|
|
fLinesInWindow := ClientHeight div fTextHeight;
|
|
{$ENDIF}
|
|
if bFont then begin
|
|
if Gutter.ShowLineNumbers then
|
|
GutterChanged(Self)
|
|
else
|
|
UpdateScrollbars;
|
|
InitializeCaret;
|
|
Exclude(fStateFlags, sfCaretChanged);
|
|
Invalidate;
|
|
end else
|
|
UpdateScrollbars;
|
|
Exclude(fStateFlags, sfScrollbarChanged);
|
|
{begin} //mh 2000-10-19
|
|
if not (eoScrollPastEol in Options) then
|
|
LeftChar := LeftChar;
|
|
if not (eoScrollPastEof in Options) then
|
|
TopLine := TopLine;
|
|
{end} //mh 2000-10-19
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.MoveCaretHorz(DX: integer; SelectionCommand: boolean);
|
|
{$IFDEF SYN_LAZARUS}
|
|
var
|
|
NewCaret: TPoint;
|
|
s: String;
|
|
PhysicalLineLen: Integer;
|
|
begin
|
|
NewCaret:=Point(CaretX+DX,CaretY);
|
|
if NewCaret.X<1 then begin
|
|
if (eoScrollPastEol in fOptions) or (NewCaret.Y=1) then
|
|
NewCaret.X:=1
|
|
else begin
|
|
// move to end of prev line
|
|
NewCaret.Y:=FindNextUnfoldedLine(NewCaret.Y-1, false);
|
|
s:=Lines[NewCaret.Y-1];
|
|
PhysicalLineLen:=LogicalToPhysicalPos(Point(length(s)+1,NewCaret.Y)).X-1;
|
|
NewCaret.X:=PhysicalLineLen+1;
|
|
end;
|
|
end else if not (eoScrollPastEol in fOptions) then begin
|
|
s:=LineText;
|
|
PhysicalLineLen:=LogicalToPhysicalPos(Point(length(s)+1,CaretY)).X-1;
|
|
if NewCaret.X>PhysicalLineLen+1 then begin
|
|
// move to start of next line
|
|
NewCaret.X:=1;
|
|
NewCaret.Y:=FindNextUnfoldedLine(NewCaret.Y+1, true);
|
|
end;
|
|
end;
|
|
|
|
// adjust selection
|
|
IncPaintLock;
|
|
if SelectionCommand then begin
|
|
//debugln('TCustomSynEdit.MoveCaretHorz A CaretXY=',dbgs(CaretXY),' NewCaret=',dbgs(NewCaret));
|
|
if not SelAvail then SetBlockBegin(PhysicalToLogicalPos(CaretXY));
|
|
SetBlockEnd(PhysicalToLogicalPos(NewCaret));
|
|
//debugln('TCustomSynEdit.MoveCaretHorz B BB=',dbgs(BlockBegin),' BE=',dbgs(BlockEnd));
|
|
AquirePrimarySelection;
|
|
end else
|
|
SetBlockBegin(PhysicalToLogicalPos(NewCaret));
|
|
// commit new caret
|
|
CaretXY := NewCaret;
|
|
DecPaintLock;
|
|
end;
|
|
{$ELSE}
|
|
var
|
|
ptO, ptDst: TPoint;
|
|
s: string;
|
|
nLineLen: integer;
|
|
bChangeY: boolean;
|
|
begin
|
|
ptO := CaretXY;
|
|
ptDst := ptO;
|
|
s := LineText;
|
|
nLineLen := Length(s);
|
|
// only moving or selecting one char can change the line
|
|
bChangeY := not (eoScrollPastEol in fOptions);
|
|
if bChangeY and (DX = -1) and (ptO.X = 1) and (ptO.Y > 1) then begin
|
|
// end of previous line
|
|
Dec(ptDst.Y);
|
|
ptDst.X := Length(Lines[ptDst.Y - 1]) + 1;
|
|
end else
|
|
if bChangeY and (DX = 1) and (ptO.X > nLineLen) and (ptO.Y < Lines.Count)
|
|
then begin
|
|
// start of next line
|
|
Inc(ptDst.Y);
|
|
ptDst.X := 1;
|
|
end else begin
|
|
ptDst.X := Max(1, ptDst.X + DX);
|
|
// don't go past last char when ScrollPastEol option not set
|
|
if (DX > 0) and bChangeY then ptDst.X := Min(ptDst.X, nLineLen + 1);
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
// prevent from getting inside of a doublebyte char
|
|
if (ptDst.X > 1) and (ptDst.X <= nLineLen) then begin
|
|
DX := ptDst.X - ptO.X;
|
|
if (DX < 0) then begin
|
|
if ByteType(s, ptDst.X) = mbTrailByte then Dec(ptDst.X);
|
|
end else if (DX > 0) then begin
|
|
if ByteType(s, ptDst.X) = mbTrailByte then Inc(ptDst.X);
|
|
end;
|
|
end;
|
|
end;
|
|
fMBCSStepAside := False;
|
|
{$ELSE}
|
|
end;
|
|
{$ENDIF}
|
|
// set caret and block begin / end
|
|
MoveCaretAndSelection(ptO, ptDst, SelectionCommand);
|
|
fLastCaretX := fCaretX; //mh 2000-10-19
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.MoveCaretVert(DY: integer; SelectionCommand: boolean);
|
|
{$IFDEF SYN_LAZARUS}
|
|
// moves Caret vertical DY unfolded lines
|
|
var
|
|
NewCaret: TPoint;
|
|
LogCaret: TPoint;
|
|
OldCaret: TPoint;
|
|
SaveLastCaretX: LongInt;
|
|
i: Integer;
|
|
begin
|
|
OldCaret:=CaretXY;
|
|
NewCaret:=OldCaret;
|
|
with NewCaret do begin
|
|
if DY>=0 then begin
|
|
for i:=1 to DY do begin
|
|
Inc(Y);
|
|
Y:=FindNextUnfoldedLine(Y,true);
|
|
end;
|
|
end else begin
|
|
for i:=1 to -DY do begin
|
|
dec(Y);
|
|
Y:=FindNextUnfoldedLine(Y,false);
|
|
end;
|
|
end;
|
|
if DY >= 0 then begin
|
|
if (Y > Lines.Count) or (CaretY > Y) then
|
|
Y := Lines.Count;
|
|
end else
|
|
if (Y < 1) or (CaretY < Y) then
|
|
Y := 1;
|
|
end;
|
|
if (OldCaret.Y<>NewCaret.Y) and (fLastCaretX>0) and (eoKeepCaretX in Options)
|
|
then
|
|
NewCaret.X:=fLastCaretX;
|
|
// set caret and block begin / end
|
|
LogCaret:=PhysicalToLogicalPos(NewCaret);
|
|
IncPaintLock;
|
|
if SelectionCommand then begin
|
|
if not SelAvail then SetBlockBegin(PhysicalToLogicalPos(CaretXY));
|
|
SetBlockEnd(LogCaret);
|
|
AquirePrimarySelection;
|
|
end else
|
|
SetBlockBegin(LogCaret);
|
|
SaveLastCaretX:=fLastCaretX;
|
|
CaretXY:=NewCaret;
|
|
fLastCaretX:=SaveLastCaretX;
|
|
DecPaintLock;
|
|
end;
|
|
{$ELSE below for NOT SYN_LAZARUS ----------------------------------------------}
|
|
var
|
|
ptO, ptDst: TPoint;
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
NewStepAside: Boolean;
|
|
s: string;
|
|
{$ENDIF}
|
|
SaveLastCaretX: Integer;
|
|
begin
|
|
ptO := CaretXY; // sblbg 2001-12-17
|
|
ptDst := ptO;
|
|
with ptDst do begin
|
|
Inc(Y, DY);
|
|
if DY >= 0 then begin
|
|
if (Y > Lines.Count) or (ptO.Y > Y) then
|
|
Y := Lines.Count;
|
|
end else
|
|
if (Y < 1) or (ptO.Y < Y) then
|
|
Y := 1;
|
|
end;
|
|
if (ptO.Y <> ptDst.Y) then begin
|
|
if eoKeepCaretX in Options then //mh 2000-10-19
|
|
ptDst.X := fLastCaretX; //mh 2000-10-19
|
|
end;
|
|
|
|
ptDst := PhysicalToLogicalPos(ptDst); // sblbg 2001-12-17
|
|
ptO := PhysicalToLogicalPos(ptO); // sblbg 2001-12-17
|
|
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
if (ptO.Y <> ptDst.Y) then begin
|
|
if fMBCSStepAside and not (eoKeepCaretX in Options) then
|
|
Inc(ptDst.X);
|
|
NewStepAside := False;
|
|
s := Lines[ptDst.Y - 1];
|
|
if (ptDst.X <= Length(s)) then
|
|
if (ByteType(s, ptDst.X) = mbTrailByte) then begin
|
|
NewStepAside := True;
|
|
Dec(ptDst.X);
|
|
end;
|
|
end
|
|
else
|
|
NewStepAside := fMBCSStepAside;
|
|
{$ENDIF}
|
|
SaveLastCaretX := fLastCaretX;
|
|
|
|
// set caret and block begin / end
|
|
MoveCaretAndSelection(ptO, ptDst, SelectionCommand);
|
|
|
|
// Set fMBCSStepAside and restore fLastCaretX after moving caret, since
|
|
// UpdateLastCaretX, called by SetCaretXYEx, changes them. This is the one
|
|
// case where we don't want that.
|
|
{$IFDEF SYN_MBCSSUPPORT}
|
|
fMBCSStepAside := NewStepAside;
|
|
{$ENDIF}
|
|
fLastCaretX := SaveLastCaretX; //jr 2002-04-26
|
|
end;
|
|
{$ENDIF not SYN_LAZARUS}
|
|
|
|
procedure TCustomSynEdit.MoveCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}const {$ENDIF}ptBefore, ptAfter: TPoint;
|
|
SelectionCommand: boolean);
|
|
// ptBefore and ptAfter are logical (byte)
|
|
begin
|
|
IncPaintLock;
|
|
if SelectionCommand then begin
|
|
if not SelAvail then SetBlockBegin(ptBefore);
|
|
SetBlockEnd(ptAfter);
|
|
{$IFDEF SYN_LAZARUS}
|
|
AquirePrimarySelection;
|
|
{$ENDIF}
|
|
end else
|
|
SetBlockBegin(ptAfter);
|
|
CaretXY := {$IFDEF SYN_LAZARUS}LogicalToPhysicalPos(ptAfter)
|
|
{$ELSE}ptAfter{$ENDIF};
|
|
DecPaintLock;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.MoveCaretAndSelectionPhysical(const ptBeforePhysical,
|
|
ptAfterPhysical: TPoint; SelectionCommand: boolean);
|
|
begin
|
|
MoveCaretAndSelection(PhysicalToLogicalPos(ptBeforePhysical),
|
|
PhysicalToLogicalPos(ptAfterPhysical),
|
|
SelectionCommand);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetCaretAndSelection(
|
|
{$IFDEF SYN_LAZARUS}const {$ENDIF}ptCaret, ptBefore, ptAfter: TPoint);
|
|
// caret is physical (screen)
|
|
// Before, After is logical (byte)
|
|
begin
|
|
IncPaintLock;
|
|
CaretXY := ptCaret;
|
|
SetBlockBegin(ptBefore);
|
|
SetBlockEnd(ptAfter);
|
|
{$IFDEF SYN_LAZARUS}
|
|
AquirePrimarySelection;
|
|
{$ENDIF}
|
|
DecPaintLock;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.RecalcCharExtent;
|
|
|
|
function UsesFontStyle(AStyle: TFontStyle): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
if Assigned(fHighlighter) then begin
|
|
for i := 0 to Pred(fHighlighter.AttrCount) do
|
|
if AStyle in fHighlighter.Attribute[i].Style then begin
|
|
Result := TRUE;
|
|
exit;
|
|
end;
|
|
Result := FALSE;
|
|
end else
|
|
Result := AStyle in Font.Style;
|
|
end;
|
|
|
|
const
|
|
BoldStyles: array[boolean] of TFontStyles = ([], [fsBold]);
|
|
ItalicStyles: array[boolean] of TFontStyles = ([], [fsItalic]);
|
|
begin
|
|
with fTextDrawer do begin
|
|
//debugln('TCustomSynEdit.RecalcCharExtent A UseUTF8=',dbgs(UseUTF8),
|
|
// ' Font.CanUTF8='+dbgs(Font.CanUTF8)+' CharHeight=',dbgs(CharHeight));
|
|
BaseFont := Self.Font;
|
|
BaseStyle := ItalicStyles[UsesFontStyle(fsItalic)];
|
|
//debugln('TCustomSynEdit.RecalcCharExtent B CharHeight=',dbgs(CharHeight));
|
|
fTextHeight := CharHeight + fExtraLineSpacing;
|
|
BaseStyle := BoldStyles[UsesFontStyle(fsBold)];
|
|
fCharWidth := CharWidth {$IFDEF SYN_LAZARUS}+fExtraCharSpacing{$ENDIF};
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
FUseUTF8:=fTextDrawer.UseUTF8;
|
|
//debugln('TCustomSynEdit.RecalcCharExtent UseUTF8=',dbgs(UseUTF8),' Font.CanUTF8=',dbgs(Font.CanUTF8));
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.HighlighterAttrChanged(Sender: TObject);
|
|
begin
|
|
RecalcCharExtent;
|
|
SizeOrFontChanged(TRUE); //jr 2000-10-01
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.StatusChanged(AChanges: TSynStatusChanges);
|
|
begin
|
|
fStatusChanges := fStatusChanges + AChanges;
|
|
if PaintLock = 0 then
|
|
DoOnStatusChange(fStatusChanges);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoTabKey;
|
|
var
|
|
StartOfBlock: TPoint;
|
|
i, MinLen, iLine: integer;
|
|
PrevLine,
|
|
Spaces: string;
|
|
p: PChar;
|
|
NewCaretX: integer; //mh 2000-10-01
|
|
ChangeScroll: boolean; //mh 2000-10-01
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if (eoTabIndent in Options) and SelAvail then begin
|
|
DoBlockIndent;
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
i := 0;
|
|
if eoSmartTabs in fOptions then begin
|
|
iLine := CaretY - 1;
|
|
if (iLine > 0) and (iLine < Lines.Count) then begin
|
|
Dec(iLine);
|
|
{$IFNDEF SYN_LAZARUS ! NOT}
|
|
MinLen := CaretX;
|
|
{$ENDIF}
|
|
repeat
|
|
// NOTE mh: after throwing in real tabs we have to use:
|
|
// PrevLine := pConvert(Lines[iLine], TabWidth);
|
|
PrevLine := Lines[iLine];
|
|
{$IFDEF SYN_LAZARUS}
|
|
MinLen := PhysicalToLogicalCol(PrevLine,CaretX);
|
|
{$ENDIF}
|
|
if (Length(PrevLine) >= MinLen) then begin
|
|
p := @PrevLine[MinLen];
|
|
// scan over non-whitespaces
|
|
repeat
|
|
if p^ = #32 then break;
|
|
Inc(i);
|
|
Inc(p);
|
|
until p^ = #0;
|
|
// scan over whitespaces
|
|
if p^ <> #0 then
|
|
repeat
|
|
if p^ <> #32 then break;
|
|
Inc(i);
|
|
Inc(p);
|
|
until p^ = #0;
|
|
break;
|
|
end;
|
|
Dec(iLine);
|
|
until iLine < 0;
|
|
end;
|
|
end;
|
|
if i = 0 then begin
|
|
i := TabWidth - (CaretX - 1) mod TabWidth;
|
|
if i = 0 then i := TabWidth;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
// i now contains the needed spaces
|
|
Spaces := CreateTabsAndSpaces(CaretX,i,TabWidth,
|
|
not (eoTabsToSpaces in Options));
|
|
//debugln('TCustomSynEdit.DoTabKey Spaces="',DbgStr(Spaces),'" TabChar=',DbgStr(TabChar));
|
|
|
|
BeginUndoBlock;
|
|
try
|
|
if SelAvail then begin
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText,
|
|
SelectionMode);
|
|
end;
|
|
|
|
StartOfBlock := BlockBegin;
|
|
if SelectionMode = smLine then
|
|
StartOfBlock.X := 1;
|
|
NewCaretX := CaretX + i;
|
|
//debugln('TCustomSynEdit.DoTabKey Before SetSelText Line="',DbgStr(GetLineText),'"');
|
|
SetSelText(Spaces);
|
|
//debugln('TCustomSynEdit.DoTabKey After SetSelText Line="',DbgStr(GetLineText),'"');
|
|
ChangeScroll := not (eoScrollPastEol in fOptions);
|
|
try
|
|
Include(fOptions, eoScrollPastEol);
|
|
CaretX := NewCaretX;
|
|
finally
|
|
if ChangeScroll then
|
|
Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
//debugln('TCustomSynEdit.DoTabKey StartOfBlock=',dbgs(StartOfBlock),' fBlockEnd=',dbgs(fBlockEnd),' Spaces="',Spaces,'"');
|
|
fUndoList.AddChange(crInsert, StartOfBlock, fBlockEnd, '', smNormal);
|
|
finally
|
|
EndUndoBlock;
|
|
end;
|
|
EnsureCursorPosVisible;
|
|
{$ELSE}
|
|
Spaces := StringOfChar(' ', i);
|
|
//debugln('TCustomSynEdit.DoTabKey Spaces="',DbgStr(Spaces),'" TabChar=',DbgStr(TabChar));
|
|
|
|
if SelAvail then begin
|
|
fUndoList.AddChange(crDelete, fBlockBegin, fBlockEnd, SelText,
|
|
SelectionMode);
|
|
end;
|
|
{begin} //mh 2000-10-01
|
|
StartOfBlock := CaretXY;
|
|
NewCaretX := StartOfBlock.X + i;
|
|
SetSelText(Spaces);
|
|
ChangeScroll := not (eoScrollPastEol in fOptions);
|
|
try
|
|
Include(fOptions, eoScrollPastEol);
|
|
CaretX := NewCaretX;
|
|
finally
|
|
if ChangeScroll then
|
|
Exclude(fOptions, eoScrollPastEol);
|
|
end;
|
|
// i := CaretY - 1;
|
|
// if eoTrimTrailingSpaces in Options then //JGF 2000-09-23
|
|
// Lines[i] := TrimRight(Lines[i]);
|
|
// EnsureCursorPosVisible;
|
|
// if Length(Lines[i]) >= StartOfBlock.X then
|
|
fUndoList.AddChange(crInsert, StartOfBlock, CaretXY, Spaces, SelectionMode);
|
|
EnsureCursorPosVisible;
|
|
{end} //mh 2000-10-01
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.CreateWnd;
|
|
begin
|
|
inherited;
|
|
if (eoDropFiles in fOptions) and not (csDesigning in ComponentState) then
|
|
{$IFDEF SYN_LAZARUS}
|
|
// ToDo DragAcceptFiles
|
|
;
|
|
{$ELSE}
|
|
DragAcceptFiles(Handle, TRUE);
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
SizeOrFontChanged(true);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DestroyWnd;
|
|
begin
|
|
if (eoDropFiles in fOptions) and not (csDesigning in ComponentState) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
// ToDo DragAcceptFiles
|
|
;
|
|
{$ELSE}
|
|
DragAcceptFiles(Handle, FALSE);
|
|
{$ENDIF}
|
|
end;
|
|
{$IFDEF EnableDoubleBuf}
|
|
FreeAndNil(BufferBitmap);
|
|
{$ENDIF}
|
|
{$IFDEF SYN_LAZARUS}
|
|
if PrimarySelection.OnRequest=@PrimarySelectionRequest then
|
|
PrimarySelection.OnRequest:=nil;
|
|
{$ENDIF}
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoBlockIndent;
|
|
var
|
|
OrgCaretPos,
|
|
BB,BE : TPoint;
|
|
Run,
|
|
StrToInsert : PChar;
|
|
e,x,
|
|
i,InsertStrLen : integer;
|
|
Spaces : String;
|
|
OrgSelectionMode : TSynSelectionMode;
|
|
begin
|
|
if not SelAvail then exit;
|
|
OrgSelectionMode := fSelectionMode;
|
|
OrgCaretPos := CaretXY;
|
|
x := 1;
|
|
StrToInsert := nil;
|
|
fSelectionMode := smColumn;
|
|
try
|
|
// keep current selection detail
|
|
BB := BlockBegin;
|
|
BE := BlockEnd;
|
|
|
|
// build text to insert
|
|
if (BE.X = 1) then begin
|
|
e := BE.y - 1;
|
|
x := 1;
|
|
end else begin
|
|
e := BE.y;
|
|
x := BE.x + {$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF};
|
|
end;
|
|
InsertStrLen := ({$IFDEF SYN_LAZARUS}
|
|
(fBlockIndent+length(LineEnding))* (e - BB.y)+fBlockIndent+1
|
|
{$ELSE}
|
|
(fTabWidth+2)* (e - BB.y) + TabWidth +1
|
|
{$ENDIF}
|
|
);
|
|
// chars per line * lines-1 + last line + null char
|
|
StrToInsert := StrAlloc(InsertStrLen);
|
|
try
|
|
Run := StrToInsert;
|
|
Spaces := StringOfChar(#32,
|
|
{$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF});
|
|
for i := BB.Y to e-1 do
|
|
begin
|
|
StrPCopy(Run, Spaces+{$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#13#10{$ENDIF});
|
|
Inc(Run,{$IFDEF SYN_LAZARUS}fBlockIndent+length(LineEnding)
|
|
{$ELSE}fTabWidth+2{$ENDIF});
|
|
end;
|
|
StrPCopy(Run, Spaces);
|
|
|
|
InsertBlock(Point(1,BB.y),Point(1,BB.y),StrToInsert);
|
|
fUndoList.AddChange(crIndent, BB, BE, '', smColumn);
|
|
finally
|
|
StrDispose(StrToInsert);
|
|
end;
|
|
finally
|
|
fSelectionMode := OrgSelectionMode;
|
|
SetCaretAndSelection(OrgCaretPos,
|
|
Point(BB.x + {$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF},
|
|
BB.y),
|
|
Point(x, BE.y));
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoBlockUnindent;
|
|
var
|
|
OrgCaretPos,
|
|
BB, BE: TPoint;
|
|
FullStrToDelete: PChar;
|
|
Line, Run,
|
|
StrToDelete: PChar;
|
|
Len,
|
|
x, StrToDeleteLen,
|
|
FirstIndent,
|
|
LastIndent,
|
|
e : integer;
|
|
TempString: AnsiString;
|
|
OrgSelectionMode : TSynSelectionMode;
|
|
SomethingToDelete : Boolean;
|
|
|
|
function GetDelLen : integer;
|
|
var
|
|
Run : PChar;
|
|
begin
|
|
Result := 0;
|
|
Run := Line;
|
|
while (Run[0] = ' ')
|
|
and (Result < {$IFDEF SYN_LAZARUS}fBlockIndent{$ELSE}fTabWidth{$ENDIF}) do
|
|
begin
|
|
Inc(Result);
|
|
Inc(Run);
|
|
SomethingToDelete := True;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
OrgSelectionMode := fSelectionMode;
|
|
Len := 0;
|
|
LastIndent := 0;
|
|
if SelAvail then
|
|
begin
|
|
// store current selection detail
|
|
BB := BlockBegin;
|
|
BE := BlockEnd;
|
|
OrgCaretPos := CaretXY;
|
|
|
|
// convert selection to complete lines
|
|
if BE.X = 1 then
|
|
e := BE.y - 1
|
|
else
|
|
e := BE.y;
|
|
|
|
// build string to delete
|
|
StrToDeleteLen :=
|
|
{$IFDEF SYN_LAZARUS}
|
|
(fBlockIndent+length(LineEnding)) * (e - BB.y)
|
|
+ fBlockIndent
|
|
+ 1;
|
|
{$ELSE}
|
|
(fTabWidth+2) * (e - BB.y)
|
|
+ fTabWidth
|
|
+ 1;
|
|
{$ENDIF}
|
|
// chars per line * lines-1 + last line + null char
|
|
FullStrToDelete := StrAlloc(StrToDeleteLen);
|
|
try
|
|
FullStrToDelete[0] := #0;
|
|
SomethingToDelete := False;
|
|
for x := BB.Y to e-1 do
|
|
begin
|
|
Line := PChar(Lines[x-1]);
|
|
TempString:=StringOfChar(' ', GetDelLen);
|
|
StrCat(FullStrToDelete,PChar(TempString));
|
|
StrCat(FullStrToDelete,
|
|
PChar({$IFDEF SYN_LAZARUS}LineEnding{$ELSE}#13#10{$ENDIF}));
|
|
end;
|
|
Line := PChar(Lines[e-1]);
|
|
TempString:=StringOfChar(' ', GetDelLen);
|
|
StrCat(FullStrToDelete,PChar(TempString));
|
|
|
|
FirstIndent := -1;
|
|
// Delete string
|
|
if SomethingToDelete then
|
|
begin
|
|
StrToDelete := FullStrToDelete;
|
|
CaretY := BB.Y;
|
|
repeat
|
|
Run := GetEOL(StrToDelete);
|
|
if Run <> StrToDelete then
|
|
begin
|
|
Len := Run - StrToDelete;
|
|
if FirstIndent = -1 then
|
|
FirstIndent := Len;
|
|
TempString := Lines[CaretY - 1];
|
|
if Len > 0 then
|
|
Delete(TempString, 1, Len);
|
|
Lines[CaretY - 1] := TempString;
|
|
end;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Run^ in [#10,#13] then begin
|
|
if (Run[1] in [#10,#13]) and (Run^<>Run[1]) then
|
|
Inc(Run,2)
|
|
else
|
|
Inc(Run);
|
|
inc(fCaretY);
|
|
end;
|
|
{$ELSE}
|
|
if Run^ = #13 then
|
|
begin
|
|
Inc(Run);
|
|
if Run^ = #10 then
|
|
Inc(Run);
|
|
Inc(fCaretY);
|
|
end;
|
|
{$ENDIF}
|
|
StrToDelete := Run;
|
|
until Run^ = #0;
|
|
LastIndent := Len;
|
|
fUndoList.AddChange(crUnindent, BB, BE, StrToDelete, smColumn);
|
|
end;
|
|
// restore selection
|
|
fSelectionMode := OrgSelectionMode;
|
|
if FirstIndent = -1 then
|
|
FirstIndent := 0;
|
|
SetCaretAndSelection(OrgCaretPos, Point(BB.x - FirstIndent, BB.Y),
|
|
Point(BE.x - LastIndent, BE.y));
|
|
finally
|
|
StrDispose(FullStrToDelete);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoHomeKey(Selection: boolean);
|
|
// jump to start of line (x=1),
|
|
// or if already there, jump to first non blank char
|
|
// or if blank line, jump to line indent position
|
|
// if eoEnhanceHomeKey and behind alternative point then jump first
|
|
var
|
|
s: string;
|
|
FirstNonBlank: Integer;
|
|
LineStart: LongInt;
|
|
OldPos: TPoint;
|
|
NewPos: TPoint;
|
|
begin
|
|
OldPos:=LogicalCaretXY;
|
|
NewPos:=OldPos;
|
|
|
|
if not (eoEnhanceHomeKey in fOptions) and (CaretX>1) then begin
|
|
// not at start of line -> jump to start of line
|
|
NewPos.X:=1;
|
|
end else begin
|
|
// calculate line start position
|
|
FirstNonBlank:=-1;
|
|
if CaretY<=Lines.Count then begin
|
|
s:=fLines[CaretXY.Y-1];
|
|
|
|
// search first non blank char pos
|
|
FirstNonBlank:=1;
|
|
while (FirstNonBlank<=length(s)) and (s[FirstNonBlank] in [#32, #9]) do
|
|
inc(FirstNonBlank);
|
|
if FirstNonBlank>length(s) then
|
|
FirstNonBlank:=-1;
|
|
end else
|
|
s:='';
|
|
if FirstNonBlank>=1 then begin
|
|
// this line is not blank
|
|
LineStart:=FirstNonBlank;
|
|
end else begin
|
|
// this line is blank
|
|
// -> use automatic line indent
|
|
LineStart:=GetLineIndentProposal(CaretY,true);
|
|
end;
|
|
|
|
NewPos.X:=LineStart;
|
|
if (eoEnhanceHomeKey in fOptions) and (OldPos.X>1) and (OldPos.X<=NewPos.X)
|
|
then begin
|
|
NewPos.X:=1;
|
|
end;
|
|
end;
|
|
|
|
MoveCaretAndSelection(OldPos, NewPos, Selection);
|
|
end;
|
|
|
|
{$IFDEF SYN_COMPILER_4_UP}
|
|
function TCustomSynEdit.ExecuteAction(ExeAction: TBasicAction): boolean;
|
|
begin
|
|
if ExeAction is TEditAction then
|
|
begin
|
|
Result := TRUE;
|
|
if ExeAction is TEditCut then
|
|
CutToClipboard
|
|
else if ExeAction is TEditCopy then
|
|
CopyToClipboard
|
|
else if ExeAction is TEditPaste then
|
|
PasteFromClipboard
|
|
{$IFDEF SYN_COMPILER_5_UP}
|
|
else if ExeAction is TEditDelete then
|
|
ClearSelection
|
|
else if ExeAction is TEditUndo then
|
|
Undo
|
|
else if ExeAction is TEditSelectAll then
|
|
SelectAll;
|
|
{$ENDIF}
|
|
end else
|
|
Result := inherited ExecuteAction(ExeAction);
|
|
end;
|
|
|
|
function TCustomSynEdit.UpdateAction(TheAction: TBasicAction): boolean;
|
|
begin
|
|
if TheAction is TEditAction then
|
|
begin
|
|
Result := Focused;
|
|
if Result then
|
|
begin
|
|
if (TheAction is TEditCut) or (TheAction is TEditCopy) then
|
|
TEditAction(TheAction).Enabled := SelAvail
|
|
else if TheAction is TEditPaste then
|
|
TEditAction(TheAction).Enabled := CanPaste
|
|
{$IFDEF SYN_COMPILER_5_UP}
|
|
else if TheAction is TEditDelete then
|
|
TEditAction(TheAction).Enabled := TRUE
|
|
else if TheAction is TEditUndo then
|
|
TEditAction(TheAction).Enabled := CanUndo
|
|
else if TheAction is TEditSelectAll then
|
|
TEditAction(TheAction).Enabled := TRUE;
|
|
{$ENDIF}
|
|
end;
|
|
end else
|
|
Result := inherited UpdateAction(TheAction);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.SetModified(Value: boolean);
|
|
begin
|
|
if Value <> fModified then begin
|
|
fModified := Value;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if not fModified then begin
|
|
// the current state should be the unmodified state.
|
|
fUndoList.MarkTopAsUnmodified;
|
|
fRedoList.MarkTopAsUnmodified;
|
|
end;
|
|
{$ENDIF}
|
|
StatusChanged([scModified]);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.DoOnSpecialLineColors(Line: integer; var Foreground,
|
|
Background: TColor): boolean;
|
|
begin
|
|
Result := FALSE;
|
|
if Assigned(fOnSpecialLineColors) then
|
|
fOnSpecialLineColors(Self, Line, Result, Foreground, Background);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.InvalidateLine(Line: integer);
|
|
var
|
|
rcInval: TRect;
|
|
begin
|
|
if Visible and (Line >= TopLine) and
|
|
(Line <= {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow){$ELSE}
|
|
TopLine + LinesInWindow{$ENDIF})
|
|
and (Line <= Lines.Count) and HandleAllocated
|
|
then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
fMarkupHighAll.InvalidateLines(Line, Line);
|
|
{$ENDIF}
|
|
// we invalidate gutter and text area of this line
|
|
rcInval := Rect(0, fTextHeight * RowToScreenRow(Line)
|
|
, ClientWidth{$IFDEF SYN_LAZARUS}-ScrollBarWidth{$ENDIF}, 0);
|
|
rcInval.Bottom := rcInval.Top + fTextHeight;
|
|
if sfLinesChanging in fStateFlags then
|
|
UnionRect(fInvalidateRect, fInvalidateRect, rcInval)
|
|
else
|
|
InvalidateRect(Handle, @rcInval, FALSE);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetReadOnly: boolean;
|
|
begin
|
|
Result := fReadOnly;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.SetReadOnly(Value: boolean);
|
|
begin
|
|
if fReadOnly <> Value then begin
|
|
fReadOnly := Value;
|
|
StatusChanged([scReadOnly]);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.FindMatchingBracket;
|
|
{$IFDEF SYN_LAZARUS}
|
|
{$ELSE}
|
|
const
|
|
Brackets: array[0..5] of char = ('(', ')', '[', ']', '{', '}');
|
|
var
|
|
Line: string;
|
|
i, PosX, PosY, Len: integer;
|
|
Test, BracketInc, BracketDec: char;
|
|
NumBrackets: integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
FindMatchingBracket(CaretXY,false,true,false,false);
|
|
{$ELSE}
|
|
// get char at caret
|
|
PosX := CaretX;
|
|
PosY := CaretY;
|
|
Line := LineText;
|
|
if Length(Line) >= PosX then begin
|
|
Test := Line[PosX];
|
|
// is it one of the recognized brackets?
|
|
for i := Low(Brackets) to High(Brackets) do
|
|
if Test = Brackets[i] then begin
|
|
// this is the bracket, get the matching one and the direction
|
|
BracketInc := Brackets[i];
|
|
BracketDec := Brackets[i xor 1]; // 0 -> 1, 1 -> 0, ...
|
|
// search for the matching bracket (that is until NumBrackets = 0)
|
|
NumBrackets := 1;
|
|
if Odd(i) then begin
|
|
// closing bracket -> search opening bracket
|
|
repeat
|
|
// search until start of line
|
|
while PosX > 1 do begin
|
|
Dec(PosX);
|
|
Test := Line[PosX];
|
|
if Test = BracketInc then
|
|
Inc(NumBrackets)
|
|
else if Test = BracketDec then begin
|
|
Dec(NumBrackets);
|
|
if NumBrackets = 0 then begin
|
|
// matching bracket found, set caret and bail out
|
|
CaretXY := Point(PosX, PosY);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
// get previous line if possible
|
|
if PosY = 1 then break;
|
|
Dec(PosY);
|
|
Line := Lines[PosY - 1];
|
|
PosX := Length(Line) + 1;
|
|
until FALSE;
|
|
end else begin
|
|
// opening bracket -> search closing bracket
|
|
repeat
|
|
// search until end of line
|
|
Len := Length(Line);
|
|
while PosX < Len do begin
|
|
Inc(PosX);
|
|
Test := Line[PosX];
|
|
if Test = BracketInc then
|
|
Inc(NumBrackets)
|
|
else if Test = BracketDec then begin
|
|
Dec(NumBrackets);
|
|
if NumBrackets = 0 then begin
|
|
// matching bracket found, set caret and bail out
|
|
CaretXY := Point(PosX, PosY);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
// get next line if possible
|
|
if PosY = Lines.Count then break;
|
|
Inc(PosY);
|
|
Line := Lines[PosY - 1];
|
|
PosX := 0;
|
|
until FALSE;
|
|
end;
|
|
// don't test the other brackets, we're done
|
|
break;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.FindMatchingBracket(PhysStartBracket: TPoint;
|
|
StartIncludeNeighborChars, MoveCaret, SelectBrackets, OnlyVisible: boolean
|
|
): TPoint;
|
|
// returns physical (screen) position of end bracket
|
|
const
|
|
Brackets: array[0..5] of char = ('(', ')', '[', ']', '{', '}');
|
|
var
|
|
Line: string;
|
|
PosX, PosY: integer;
|
|
StartPt: TPoint;
|
|
LogicalStart: TPoint;
|
|
|
|
procedure DoMatchingBracketFound;
|
|
var
|
|
EndPt, DummyPt: TPoint;
|
|
begin
|
|
// matching bracket found, set caret and bail out
|
|
Result := Point(PosX, PosY); // start with logical (byte) position
|
|
if SelectBrackets then begin
|
|
EndPt:=Result;
|
|
if (EndPt.Y < StartPt.Y)
|
|
or ((EndPt.Y = StartPt.Y) and (EndPt.X < StartPt.X)) then
|
|
begin
|
|
DummyPt:=StartPt;
|
|
StartPt:=EndPt;
|
|
EndPt:=DummyPt;
|
|
end;
|
|
inc(EndPt.X);
|
|
SetCaretAndSelection(CaretXY, StartPt, EndPt);
|
|
// Selection should have changed...
|
|
StatusChanged([scSelection]);
|
|
end else if MoveCaret then
|
|
CaretXY := LogicalToPhysicalPos(Result)
|
|
else
|
|
Result := LogicalToPhysicalPos(Result);
|
|
end;
|
|
|
|
procedure DoFindMatchingBracket(i: integer);
|
|
var
|
|
Test, BracketInc, BracketDec: char;
|
|
NumBrackets, Len: integer;
|
|
begin
|
|
StartPt:=Point(PosX,PosY);
|
|
BracketInc := Brackets[i];
|
|
BracketDec := Brackets[i xor 1]; // 0 -> 1, 1 -> 0, ...
|
|
// search for the matching bracket (that is until NumBrackets = 0)
|
|
NumBrackets := 1;
|
|
if Odd(i) then begin
|
|
// closing bracket -> search opening bracket
|
|
repeat
|
|
// search until start of line
|
|
while PosX > 1 do begin
|
|
Dec(PosX);
|
|
Test := Line[PosX];
|
|
if Test = BracketInc then
|
|
Inc(NumBrackets)
|
|
else if Test = BracketDec then begin
|
|
Dec(NumBrackets);
|
|
if NumBrackets = 0 then begin
|
|
DoMatchingBracketFound;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
// get previous line if possible
|
|
if PosY = 1 then break;
|
|
Dec(PosY);
|
|
if OnlyVisible and ((PosY<TopLine)
|
|
or (PosY >= {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow){$ELSE}TopLine+LinesInWindow{$ENDIF}))
|
|
then
|
|
break;
|
|
Line := Lines[PosY - 1];
|
|
PosX := Length(Line) + 1;
|
|
until FALSE;
|
|
end else begin
|
|
// opening bracket -> search closing bracket
|
|
repeat
|
|
// search until end of line
|
|
Len := Length(Line);
|
|
while PosX < Len do begin
|
|
Inc(PosX);
|
|
Test := Line[PosX];
|
|
if Test = BracketInc then
|
|
Inc(NumBrackets)
|
|
else if Test = BracketDec then begin
|
|
Dec(NumBrackets);
|
|
if NumBrackets = 0 then begin
|
|
DoMatchingBracketFound;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
// get next line if possible
|
|
if PosY = Lines.Count then break;
|
|
Inc(PosY);
|
|
if OnlyVisible and ((PosY < TopLine)
|
|
or (PosY >= {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow){$ELSE}TopLine+LinesInWindow{$ENDIF}))
|
|
then
|
|
break;
|
|
Line := Lines[PosY - 1];
|
|
PosX := 0;
|
|
until FALSE;
|
|
end;
|
|
end;
|
|
|
|
procedure DoCheckBracket;
|
|
var
|
|
i: integer;
|
|
Test: char;
|
|
begin
|
|
if Length(Line) >= PosX then begin
|
|
Test := Line[PosX];
|
|
// is it one of the recognized brackets?
|
|
for i := Low(Brackets) to High(Brackets) do begin
|
|
if Test = Brackets[i] then begin
|
|
// this is the bracket, get the matching one and the direction
|
|
DoFindMatchingBracket(i);
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Result.X:=-1;
|
|
Result.Y:=-1;
|
|
|
|
// get char at caret
|
|
LogicalStart:=PhysicalToLogicalPos(PhysStartBracket);
|
|
PosX := LogicalStart.X;
|
|
PosY := LogicalStart.Y;
|
|
if (PosY<1) or (PosY>Lines.Count) then exit;
|
|
if OnlyVisible and ((PosY<TopLine)
|
|
or (PosY >= {$IFDEF SYN_LAZARUS}ScreenRowToRow(LinesInWindow){$ELSE}TopLine+LinesInWindow{$ENDIF})) then
|
|
exit;
|
|
|
|
Line := LineText;
|
|
DoCheckBracket;
|
|
try
|
|
if Result.Y>0 then exit;
|
|
if StartIncludeNeighborChars then begin
|
|
if PosX>1 then begin
|
|
// search in front
|
|
dec(PosX);
|
|
DoCheckBracket;
|
|
if Result.Y>0 then exit;
|
|
inc(PosX);
|
|
end;
|
|
if PosX<Length(Line) then begin
|
|
// search behind
|
|
inc(PosX);
|
|
DoCheckBracket;
|
|
if Result.Y>0 then exit;
|
|
end;
|
|
end;
|
|
finally
|
|
if Result.Y>0 then begin
|
|
Result:=LogicalToPhysicalPos(Result);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
//L505 begin
|
|
function TCustomSynEdit.GetHighlighterAttriAtRowCol(XY: TPoint;
|
|
var Token: string; var Attri: TSynHighlighterAttributes): boolean;
|
|
var
|
|
TmpType, TmpStart: Integer;
|
|
begin
|
|
Result := GetHighlighterAttriAtRowColEx(XY, Token, TmpType, TmpStart, Attri);
|
|
end;
|
|
|
|
function TCustomSynEdit.GetHighlighterAttriAtRowColEx(XY: TPoint;
|
|
var Token: string; var TokenType, Start: Integer;
|
|
var Attri: TSynHighlighterAttributes): boolean;
|
|
var
|
|
PosX, PosY: integer;
|
|
Line: string;
|
|
begin
|
|
PosY := XY.Y -1;
|
|
if Assigned(Highlighter) and (PosY >= 0) and (PosY < Lines.Count) then
|
|
begin
|
|
Line := Lines[PosY];
|
|
if PosY = 0 then
|
|
Highlighter.ResetRange
|
|
else
|
|
Highlighter.SetRange(TSynEditStringList(Lines).Ranges[PosY - 1]);
|
|
Highlighter.SetLine(Line, PosY);
|
|
PosX := XY.X;
|
|
if (PosX > 0) and (PosX <= Length(Line)) then
|
|
while not Highlighter.GetEol do begin
|
|
Start := Highlighter.GetTokenPos + 1;
|
|
Token := Highlighter.GetToken;
|
|
if (PosX >= Start) and (PosX < Start + Length(Token)) then begin
|
|
Attri := Highlighter.GetTokenAttribute;
|
|
TokenType := Highlighter.GetTokenKind;
|
|
Result := TRUE;
|
|
exit;
|
|
end;
|
|
Highlighter.Next;
|
|
end;
|
|
end;
|
|
Token := '';
|
|
Attri := nil;
|
|
Result := FALSE;
|
|
end;
|
|
//L505 end
|
|
{$IFDEF SYN_LAZARUS}
|
|
|
|
procedure TCustomSynEdit.GetWordBoundsAtRowCol(const XY: TPoint; var StartX,
|
|
EndX: integer);
|
|
// all params are logical (byte) positions
|
|
var
|
|
Line: string;
|
|
IdChars: TSynIdentChars;
|
|
Len: integer;
|
|
begin
|
|
//debugln('TCustomSynEdit.GetWordBoundsAtRowCol A ',dbgs(XY));
|
|
StartX:=XY.X;
|
|
EndX:=XY.X;
|
|
if (XY.Y >= 1) and (XY.Y <= Lines.Count) then begin
|
|
Line := Lines[XY.Y - 1];
|
|
Len := Length(Line);
|
|
if (XY.X >= 1) and (XY.X <= Len + 1) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Assigned(Highlighter) then
|
|
IdChars := [#1..#255] - (Highlighter.WordBreakChars + TSynWhiteChars)
|
|
else
|
|
IdChars := [#1..#255] - (TSynWordBreakChars + TSynWhiteChars);
|
|
{$ELSE}
|
|
if Assigned(Highlighter) then
|
|
IdChars := Highlighter.IdentChars
|
|
else
|
|
IdChars := ['a'..'z', 'A'..'Z'];
|
|
{$ENDIF}
|
|
EndX := XY.X;
|
|
while (EndX <= Len) and (Line[EndX] in IdChars) do
|
|
Inc(EndX);
|
|
StartX := XY.X;
|
|
while (StartX > 1) and (Line[StartX - 1] in IdChars) do
|
|
Dec(StartX);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetLineIndentProposal(Line: integer;
|
|
IgnoreCurrentLineText: boolean): integer;
|
|
// calculate a nice indent for the Line (starting at 1)
|
|
var
|
|
y: Integer;
|
|
s: string;
|
|
FirstNonBlank: Integer;
|
|
begin
|
|
if fBeautifier<>nil then begin
|
|
if IgnoreCurrentLineText then
|
|
s:=''
|
|
else
|
|
s:=LineText;
|
|
Result:=fBeautifier.GetIndentForLineBreak(Self,Point(1,Line),s);
|
|
end else begin
|
|
// default: use last non empty line indent, ignore always current line
|
|
y:=Line-1;
|
|
if y>Lines.Count then y:=Lines.Count;
|
|
while y>=1 do begin
|
|
s:=fLines[y-1];
|
|
FirstNonBlank:=1;
|
|
while (FirstNonBlank<=length(s)) and (s[FirstNonBlank] in [' ',#9]) do
|
|
inc(FirstNonBlank);
|
|
if FirstNonBlank<=Length(s) then begin
|
|
// non empty line found
|
|
Result:=LogicalToPhysicalCol(s,FirstNonBlank);
|
|
exit;
|
|
end;
|
|
dec(y);
|
|
end;
|
|
Result:=1;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TCustomSynEdit.FindHookedCmdEvent(AHandlerProc: THookedCommandEvent):
|
|
integer;
|
|
var
|
|
Entry: THookedCommandHandlerEntry;
|
|
begin
|
|
Result := GetHookedCommandHandlersCount - 1;
|
|
while Result >= 0 do begin
|
|
Entry := THookedCommandHandlerEntry(fHookedCommandHandlers[Result]);
|
|
if Entry.Equals(AHandlerProc) then
|
|
break;
|
|
Dec(Result);
|
|
end;
|
|
end;
|
|
|
|
function TCustomSynEdit.GetHookedCommandHandlersCount: integer;
|
|
begin
|
|
if Assigned(fHookedCommandHandlers) then
|
|
Result := fHookedCommandHandlers.Count
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.RegisterCommandHandler(AHandlerProc:
|
|
THookedCommandEvent; AHandlerData: pointer);
|
|
begin
|
|
if not Assigned(AHandlerProc) then begin
|
|
{$IFDEF SYN_DEVELOPMENT_CHECKS}
|
|
raise Exception.Create('Event handler is NIL in RegisterCommandHandler');
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
if not Assigned(fHookedCommandHandlers) then
|
|
fHookedCommandHandlers := TList.Create;
|
|
if FindHookedCmdEvent(AHandlerProc) = -1 then
|
|
fHookedCommandHandlers.Add(THookedCommandHandlerEntry.Create(
|
|
AHandlerProc, AHandlerData))
|
|
else
|
|
{$IFDEF SYN_DEVELOPMENT_CHECKS}
|
|
raise Exception.CreateFmt('Event handler (%p, %p) already registered',
|
|
[TMethod(AHandlerProc).Data, TMethod(AHandlerProc).Code]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UnregisterCommandHandler(AHandlerProc:
|
|
THookedCommandEvent);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if not Assigned(AHandlerProc) then begin
|
|
{$IFDEF SYN_DEVELOPMENT_CHECKS}
|
|
raise Exception.Create('Event handler is NIL in UnregisterCommandHandler');
|
|
{$ENDIF}
|
|
exit;
|
|
end;
|
|
i := FindHookedCmdEvent(AHandlerProc);
|
|
if i > -1 then begin
|
|
THookedCommandHandlerEntry(fHookedCommandHandlers[i]).Free;
|
|
fHookedCommandHandlers.Delete(i);
|
|
end else
|
|
{$IFDEF SYN_DEVELOPMENT_CHECKS}
|
|
raise Exception.CreateFmt('Event handler (%p, %p) is not registered',
|
|
[TMethod(AHandlerProc).Data, TMethod(AHandlerProc).Code]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TCustomSynEdit.NotifyHookedCommandHandlers(AfterProcessing: boolean;
|
|
var Command: TSynEditorCommand;
|
|
var AChar: {$IFDEF SYN_LAZARUS}TUTF8Char{$ELSE}Char{$ENDIF}; Data: pointer);
|
|
var
|
|
Handled: boolean;
|
|
i: integer;
|
|
Entry: THookedCommandHandlerEntry;
|
|
begin
|
|
Handled := FALSE;
|
|
for i := 0 to GetHookedCommandHandlersCount - 1 do begin
|
|
Entry := THookedCommandHandlerEntry(fHookedCommandHandlers[i]);
|
|
// NOTE: Command should NOT be set to ecNone, because this might interfere
|
|
// with other handlers. Set Handled to False instead (and check its value
|
|
// to not process the command twice).
|
|
Entry.fEvent(Self, AfterProcessing, Handled, Command, AChar, Data,
|
|
Entry.fData);
|
|
end;
|
|
if Handled then
|
|
Command := ecNone;
|
|
end;
|
|
|
|
{begin} // djlp - 2000-08-29
|
|
procedure TCustomSynEdit.DoOnClearBookmark(var Mark: TSynEditMark);
|
|
begin
|
|
if Assigned(fOnClearMark) then
|
|
fOnClearMark(Self, Mark);
|
|
end;
|
|
{end} // djlp - 2000-08-29
|
|
|
|
procedure TCustomSynEdit.DoOnPaint;
|
|
begin
|
|
if Assigned(fOnPaint) then begin
|
|
Canvas.Font.Assign(Font);
|
|
Canvas.Brush.Color := Color;
|
|
fOnPaint(Self, Canvas);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoOnPlaceMark(var Mark: TSynEditMark);
|
|
begin
|
|
if Assigned(fOnPlaceMark) then
|
|
fOnPlaceMark(Self, Mark);
|
|
end;
|
|
|
|
function TCustomSynEdit.DoOnReplaceText(const ASearch, AReplace: string;
|
|
Line, Column: integer): TSynReplaceAction;
|
|
begin
|
|
Result := raCancel;
|
|
if Assigned(fOnReplaceText) then
|
|
fOnReplaceText(Self, ASearch, AReplace, Line, Column, Result);
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoOnStatusChange(Changes: TSynStatusChanges);
|
|
begin
|
|
if Assigned(fOnStatusChange) then begin
|
|
fOnStatusChange(Self, fStatusChanges);
|
|
fStatusChanges := [];
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.UndoRedoAdded(Sender: TObject);
|
|
begin
|
|
// Modified := TRUE;
|
|
{$IFDEF SYN_LAZARUS}
|
|
if fUndoList.UnModifiedMarkerExists then
|
|
Modified:=not fUndoList.IsTopMarkedAsUnmodified
|
|
else if fRedoList.UnModifiedMarkerExists then
|
|
Modified:=not fRedoList.IsTopMarkedAsUnmodified
|
|
else
|
|
{$ENDIF}
|
|
Modified := fUndoList.CanUndo or fUndoList.FullUndoImpossible; //mh 2000-10-03
|
|
// we have to clear the redo information, since adding undo info removes
|
|
// the necessary context to undo earlier edit actions
|
|
if (Sender = fUndoList) and not (sfInsideRedo in fStateFlags) then //mh 2000-10-30
|
|
fRedoList.Clear;
|
|
if Assigned(fOnChange) then
|
|
fOnChange(Self);
|
|
end;
|
|
|
|
function TCustomSynEdit.GetWordAtRowCol(XY: TPoint): string;
|
|
var
|
|
Line: string;
|
|
IdChars: TSynIdentChars;
|
|
Len, Stop: integer;
|
|
begin
|
|
Result := '';
|
|
if (XY.Y >= 1) and (XY.Y <= Lines.Count) then begin
|
|
Line := Lines[XY.Y - 1];
|
|
Len := Length(Line);
|
|
if (XY.X >= 1) and (XY.X <= Len + 1) then begin
|
|
{$IFDEF SYN_LAZARUS}
|
|
if Assigned(Highlighter) then
|
|
IdChars := [#1..#255] - (Highlighter.WordBreakChars + TSynWhiteChars)
|
|
else
|
|
IdChars := [#1..#255] - (TSynWordBreakChars + TSynWhiteChars);
|
|
{$ELSE}
|
|
if Assigned(Highlighter) then
|
|
IdChars := Highlighter.IdentChars
|
|
else
|
|
IdChars := ['a'..'z', 'A'..'Z'];
|
|
{$ENDIF}
|
|
Stop := XY.X;
|
|
while (Stop <= Len) and (Line[Stop] in IdChars) do
|
|
Inc(Stop);
|
|
while (XY.X > 1) and (Line[XY.X - 1] in IdChars) do
|
|
Dec(XY.X);
|
|
if Stop > XY.X then
|
|
Result := Copy(Line, XY.X, Stop - XY.X);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.LogicalToPhysicalPos(const p: TPoint): TPoint;
|
|
// LogicalToPhysicalPos takes a position in the text and transforms it into
|
|
// the row and column it appears to be on the screen
|
|
begin
|
|
Result := p;
|
|
if Result.Y - 1 < Lines.Count then
|
|
Result.X:=LogicalToPhysicalCol(Lines[Result.Y - 1],Result.X);
|
|
end;
|
|
{$ELSE}
|
|
function TCustomSynEdit.LogicalToPhysicalPos(p: TPoint): TPoint;
|
|
// LogicalToPhysicalPos takes a position in the text and transforms it into
|
|
// the row and column it appears to be on the screen
|
|
var
|
|
s: string;
|
|
i, L: integer;
|
|
x: integer;
|
|
begin
|
|
if p.Y - 1 < Lines.Count then begin
|
|
s := Lines[p.Y - 1];
|
|
if UseUTF8 then begin
|
|
end else begin
|
|
l := Length(s);
|
|
x := 0;
|
|
for i := 1 to p.x - 1 do begin
|
|
if (i <= l) and (s[i] = #9) then
|
|
inc(x, TabWidth - (x mod TabWidth))
|
|
else
|
|
inc(x);
|
|
end;
|
|
p.x := x + 1;
|
|
end;
|
|
end;
|
|
Result := p;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
function TCustomSynEdit.LogicalToPhysicalCol(const Line: string;
|
|
LogicalPos: integer): integer;
|
|
begin
|
|
Result:=LogicalToPhysicalCol(PChar(Pointer(Line)),length(Line),LogicalPos,1,1);
|
|
end;
|
|
|
|
function TCustomSynEdit.LogicalToPhysicalCol(Line: PChar; LineLen: integer;
|
|
LogicalPos, StartBytePos, StartPhysicalPos: integer): integer;
|
|
// Note: LogicalPos, StartBytePos, StartPhysicalPos start at 1
|
|
var
|
|
BytePos, ByteLen: integer;
|
|
ScreenPos: integer;
|
|
begin
|
|
ByteLen := LineLen;
|
|
// map UTF8 and Tab chars
|
|
ScreenPos := StartPhysicalPos;
|
|
BytePos:= StartBytePos;
|
|
while BytePos<LogicalPos do begin
|
|
if (BytePos <= ByteLen) then begin
|
|
if Line[BytePos-1] = #9 then begin
|
|
inc(ScreenPos, TabWidth - ((ScreenPos-1) mod TabWidth));
|
|
inc(BytePos);
|
|
end else begin
|
|
inc(ScreenPos);
|
|
if UseUTF8 then
|
|
inc(BytePos,UTF8CharacterLength(@Line[BytePos-1]))
|
|
else
|
|
inc(BytePos);
|
|
end;
|
|
end else begin
|
|
// beyond end of line
|
|
inc(ScreenPos,LogicalPos-BytePos);
|
|
break;
|
|
end;
|
|
end;
|
|
if (BytePos>LogicalPos) and (ScreenPos>StartPhysicalPos) then
|
|
dec(ScreenPos);
|
|
Result := ScreenPos;
|
|
end;
|
|
|
|
function TCustomSynEdit.PhysicalLineLength(Line: PChar; LineLen: integer;
|
|
WithTabs: boolean): integer;
|
|
begin
|
|
if WithTabs then
|
|
Result:=LogicalToPhysicalCol(Line,LineLen,LineLen+1,1,1)-1
|
|
else
|
|
Result:=UTF8Length(Line,LineLen);
|
|
end;
|
|
|
|
function TCustomSynEdit.PhysicalToLogicalPos(const p: TPoint): TPoint;
|
|
// converts physical (screen) to logical (bytes)
|
|
begin
|
|
Result := p;
|
|
if (Result.Y>=1) and (Result.Y <= Lines.Count) then
|
|
Result.X:=PhysicalToLogicalCol(Lines[Result.Y - 1],Result.X,1,1);
|
|
end;
|
|
|
|
function TCustomSynEdit.PhysicalToLogicalCol(const Line: string;
|
|
PhysicalPos: integer): integer;
|
|
begin
|
|
Result:=PhysicalToLogicalCol(Line,PhysicalPos,1,1);
|
|
end;
|
|
|
|
function TCustomSynEdit.PhysicalToLogicalCol(const Line: string;
|
|
PhysicalPos, StartBytePos, StartPhysicalPos: integer): integer;
|
|
// converts physical (screen) to logical (bytes)
|
|
var
|
|
BytePos, ByteLen: integer;
|
|
ScreenPos: integer;
|
|
PLine: PChar;
|
|
begin
|
|
ByteLen := Length(Line);
|
|
ScreenPos := StartPhysicalPos;
|
|
BytePos := StartBytePos;
|
|
PLine := PChar(Line);
|
|
// map utf and tab chars
|
|
while ScreenPos < PhysicalPos do begin
|
|
if (BytePos <= ByteLen) then begin
|
|
if (PLine[BytePos-1] <> #9) then begin
|
|
inc(ScreenPos);
|
|
if UseUTF8 then
|
|
inc(BytePos,UTF8CharacterLength(@PLine[BytePos-1]))
|
|
else
|
|
inc(BytePos);
|
|
end else begin
|
|
inc(ScreenPos, TabWidth - ((ScreenPos-1) mod TabWidth));
|
|
inc(BytePos);
|
|
end;
|
|
end else begin
|
|
// beyond end of line
|
|
inc(BytePos,PhysicalPos-ScreenPos);
|
|
break;
|
|
end;
|
|
end;
|
|
if (ScreenPos>PhysicalPos) and (BytePos>1) and (BytePos<ByteLen)
|
|
and (PLine[BytePos-2]=#9) then
|
|
dec(BytePos);
|
|
Result := BytePos;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.DoLinesDeleted(FirstLine, Count: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
// gutter marks
|
|
for i := 0 to Marks.Count - 1 do begin
|
|
if Marks[i].Line >= FirstLine + Count then
|
|
Marks[i].Line := Marks[i].Line - Count
|
|
else if Marks[i].Line > FirstLine then
|
|
Marks[i].Line := FirstLine;
|
|
end;
|
|
// plugins
|
|
if fPlugins <> nil then begin
|
|
for i := 0 to fPlugins.Count - 1 do
|
|
TSynEditPlugin(fPlugins[i]).LinesDeleted(FirstLine, Count);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.DoLinesInserted(FirstLine, Count: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
// gutter marks
|
|
for i := 0 to Marks.Count - 1 do begin
|
|
if Marks[i].Line >= FirstLine then
|
|
Marks[i].Line := Marks[i].Line + Count;
|
|
end;
|
|
// plugins
|
|
if fPlugins <> nil then begin
|
|
for i := 0 to fPlugins.Count - 1 do
|
|
TSynEditPlugin(fPlugins[i]).LinesInserted(FirstLine, Count);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomSynEdit.PluginsAfterPaint(ACanvas: TCanvas; AClip: TRect;
|
|
FirstLine, LastLine: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if fPlugins <> nil then
|
|
for i := 0 to fPlugins.Count - 1 do begin
|
|
TSynEditPlugin(fPlugins[i]).AfterPaint(ACanvas, AClip, FirstLine,
|
|
LastLine);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
procedure TCustomSynEdit.PrimarySelectionRequest(
|
|
const RequestedFormatID: TClipboardFormat; Data: TStream);
|
|
var s: string;
|
|
begin
|
|
if (not SelAvail) or (RequestedFormatID<>CF_TEXT) then exit;
|
|
s:=SelText;
|
|
if s<>'' then
|
|
Data.Write(s[1],length(s));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TCustomSynEdit.TrimmedSetLine(ALine: integer; ALineText: string);
|
|
begin
|
|
if eoTrimTrailingSpaces in Options then
|
|
Lines[ALine] := TrimRight(ALineText)
|
|
else
|
|
Lines[ALine] := ALineText;
|
|
end;
|
|
|
|
{ TSynEditMark }
|
|
|
|
function TSynEditMark.GetEdit: TCustomSynEdit;
|
|
begin
|
|
if FEdit <> nil then try
|
|
if FEdit.Marks.IndexOf(self) = -1 then
|
|
FEdit := nil;
|
|
except
|
|
FEdit := nil;
|
|
end;
|
|
Result := FEdit;
|
|
end;
|
|
|
|
function TSynEditMark.GetIsBookmark: boolean;
|
|
begin
|
|
Result := (fBookmarkNum >= 0);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetColumn(const Value: Integer);
|
|
begin
|
|
FColumn := Value;
|
|
end;
|
|
|
|
procedure TSynEditMark.SetImage(const Value: Integer);
|
|
begin
|
|
FImage := Value;
|
|
if fVisible and Assigned(fEdit) then
|
|
fEdit.InvalidateGutterLines(fLine, fLine);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetInternalImage(const Value: boolean);
|
|
begin
|
|
fInternalImage := Value;
|
|
if fVisible and Assigned(fEdit) then
|
|
fEdit.InvalidateGutterLines(fLine, fLine);
|
|
end;
|
|
|
|
procedure TSynEditMark.SetLine(const Value: Integer);
|
|
begin
|
|
if fVisible and Assigned(fEdit) then begin
|
|
if fLine > 0 then
|
|
fEdit.InvalidateGutterLines(fLine, fLine);
|
|
fLine := Value;
|
|
fEdit.InvalidateGutterLines(fLine, fLine);
|
|
end else
|
|
fLine := Value;
|
|
end;
|
|
|
|
procedure TSynEditMark.SetVisible(const Value: boolean);
|
|
begin
|
|
if fVisible <> Value then begin
|
|
fVisible := Value;
|
|
if Assigned(fEdit) then
|
|
fEdit.InvalidateGutterLines(fLine, fLine);
|
|
end;
|
|
end;
|
|
|
|
constructor TSynEditMark.Create(AOwner: TCustomSynEdit);
|
|
begin
|
|
inherited Create;
|
|
fBookmarkNum := -1;
|
|
fEdit := AOwner;
|
|
end;
|
|
|
|
{ TSynEditMarkList }
|
|
|
|
function TSynEditMarkList.Add(Item: TSynEditMark): Integer;
|
|
begin
|
|
Result := inherited Add(Item);
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.ClearLine(Line: integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := Count - 1 downto 0 do
|
|
if not Items[i].IsBookmark and (Items[i].Line = Line) then Delete(i);
|
|
end;
|
|
|
|
constructor TSynEditMarkList.Create(AOwner: TCustomSynEdit);
|
|
begin
|
|
inherited Create;
|
|
fEdit := AOwner;
|
|
end;
|
|
|
|
destructor TSynEditMarkList.Destroy;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to Pred(Count) do
|
|
Get(i).Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.Delete(Index: Integer);
|
|
begin
|
|
inherited Delete(Index);
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.DoChange;
|
|
begin
|
|
if Assigned(FOnChange) then
|
|
FOnChange(Self);
|
|
end;
|
|
|
|
function TSynEditMarkList.First: TSynEditMark;
|
|
begin
|
|
result := TSynEditMark(inherited First);
|
|
end;
|
|
|
|
function TSynEditMarkList.Get(Index: Integer): TSynEditMark;
|
|
begin
|
|
result := TSynEditMark(inherited Get(Index));
|
|
end;
|
|
|
|
//Returns up to maxMarks book/gutter marks for a chosen line.
|
|
|
|
procedure TSynEditMarkList.GetMarksForLine(line: integer;
|
|
var marks: TSynEditMarks);
|
|
var
|
|
cnt: integer;
|
|
i: integer;
|
|
begin
|
|
FillChar(marks, SizeOf(marks), 0);
|
|
cnt := 0;
|
|
for i := 0 to Count - 1 do begin
|
|
if Items[i].Line = line then begin
|
|
Inc(cnt);
|
|
marks[cnt] := Items[i];
|
|
if cnt = maxMarks then break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.Insert(Index: Integer; Item: TSynEditMark);
|
|
begin
|
|
inherited Insert(Index, Item);
|
|
DoChange;
|
|
end;
|
|
|
|
function TSynEditMarkList.Last: TSynEditMark;
|
|
begin
|
|
result := TSynEditMark(inherited Last);
|
|
end;
|
|
|
|
procedure TSynEditMarkList.Place(mark: TSynEditMark);
|
|
begin
|
|
if assigned(fEdit) then
|
|
if assigned(fEdit.OnPlaceBookmark) then fEdit.OnPlaceBookmark(fEdit, mark);
|
|
if assigned(mark) then
|
|
Add(mark);
|
|
DoChange;
|
|
end;
|
|
|
|
procedure TSynEditMarkList.Put(Index: Integer; Item: TSynEditMark);
|
|
begin
|
|
inherited Put(Index, Item);
|
|
DoChange;
|
|
end;
|
|
|
|
function TSynEditMarkList.Remove(Item: TSynEditMark): Integer;
|
|
begin
|
|
Result := inherited Remove(Item);
|
|
DoChange;
|
|
end;
|
|
|
|
{ TSynEditPlugin }
|
|
|
|
constructor TSynEditPlugin.Create(AOwner: TCustomSynEdit);
|
|
begin
|
|
inherited Create;
|
|
if AOwner <> nil then begin
|
|
fOwner := AOwner;
|
|
if fOwner.fPlugins = nil then
|
|
fOwner.fPlugins := TList.Create;
|
|
fOwner.fPlugins.Add(Self);
|
|
end;
|
|
end;
|
|
|
|
destructor TSynEditPlugin.Destroy;
|
|
begin
|
|
if fOwner <> nil then
|
|
fOwner.fPlugins.Remove(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{$IFDEF SYN_LAZARUS}
|
|
{ TSynCustomBeautifier }
|
|
|
|
function TSynCustomBeautifier.LeftSpaces(Editor: TCustomSynEdit;
|
|
const Line: string; Physical: boolean): Integer;
|
|
var
|
|
p: PChar;
|
|
begin
|
|
p := pointer(Line);
|
|
if Assigned(p) then begin
|
|
Result := 0;
|
|
while p^ in [#1..#32] do begin
|
|
Inc(p);
|
|
Inc(Result);
|
|
end;
|
|
if Physical and (Result>0) then
|
|
Result:=Editor.LogicalToPhysicalCol(Line,Result+1)-1;
|
|
end else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TSynCustomBeautifier.GetIndentForLineBreak(Editor: TCustomSynEdit;
|
|
InsertPos: TPoint; var NextText: string): integer;
|
|
var
|
|
LastTextY: LongInt;
|
|
Line: string;
|
|
Lines: TStrings;
|
|
begin
|
|
Result:=0;
|
|
if InsertPos.Y<1 then exit;
|
|
LastTextY:=InsertPos.Y;
|
|
Lines:=Editor.Lines;
|
|
if LastTextY>Lines.Count then
|
|
LastTextY:=Lines.Count;
|
|
while (LastTextY>0) do begin
|
|
Line:=Lines[LastTextY-1];
|
|
if LastTextY=InsertPos.Y then
|
|
Line:=copy(Line,1,InsertPos.X-1);
|
|
if Line<>'' then begin
|
|
Result:=LeftSpaces(Editor,Line,false);
|
|
exit;
|
|
end;
|
|
dec(LastTextY);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
initialization
|
|
{$IFNDEF SYN_LAZARUS}
|
|
SynEditClipboardFormat := RegisterClipboardFormat(SYNEDIT_CLIPBOARD_FORMAT);
|
|
{$ENDIF}
|
|
|
|
end.
|
|
|