1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185 |
- {
- This Delphi component is part of TIGCC IDE.
- Copyright (C) 2000-2004 Sebastian Reichelt
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software Foundation,
- Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- }
- {*******************************************************}
- { }
- { TSourceEdit Component v2.19 }
- { }
- { Based on TMemoComponent }
- { }
- { Copyright (c) 2000-2004 Sebastian Reichelt }
- { }
- {*******************************************************}
- unit SourceEditUnit;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Consts, ObjList, MemoComponentUnit;
- const
- SymbolChars: set of Char = ['<', '{', '[', '(', ')', ']', '}', '>', ';', ':', ',', '.', '=', '+', '-', '*', '/', '\', '|', '"', '''', '!', '?', '&', '%', '#', '@', '^', '~'];
- MaxBeginEndTextLength = 20;
- CustomStyleCheckLength = 128;
- MaxOnFlySectionLength = 128;
- SSourceEditError = 'TSourceEdit internal error';
- type
- ESourceEdit = class(Exception);
- TSyntaxColoring = class;
- TWordLists = class;
- TWordList = class;
- TCustomStyles = class;
- TCustomStyle = class;
- TSyntaxRange = class;
- TIgnoreChar = string [1];
- TParenthesisStyle = (psOpening, psClosing);
- TDebuggableRange = record
- RStart,
- REnd: Integer;
- Text,
- ClassName: string;
- end;
- TDebuggableRanges = array of TDebuggableRange;
- TSourceEdit = class(TMemoComponent)
- private
- FSyntaxColoring: TSyntaxColoring;
- FFirstSyntaxRange: TSyntaxRange;
- FLastSyntaxRange: TSyntaxRange;
- FAutoIndentIncrease: Boolean;
- FAutoIndentIncreaseStart: Char;
- FAutoIndentIncreaseEnd: Char;
- FSplitOnFly: Boolean;
- procedure CMFontChanged(var Message: TMessage); message cm_FontChanged;
- procedure WMKeyDown(var Message: TWMKeyDown); message wm_KeyDown;
- procedure SetSyntaxColoring(const Value: TSyntaxColoring);
- procedure SetSplitOnFly(const Value: Boolean);
- protected
- SyntaxStartRange,
- LastPRange: TSyntaxRange;
- LastCRange: TCustomRange;
- procedure KeyPress(var Key: Char); override;
- procedure TextChangeNotification(StartPos, OldLength, NewLength: Integer); override;
- procedure TextChangeNotificationAfter; override;
- procedure ReColor; virtual;
- procedure ReColorRange(Range: TCustomRange); virtual;
- procedure FreeAllSyntaxRanges; virtual;
- function ReplaceSyntaxRanges(NewRange: TSyntaxRange; var StartRange: TSyntaxRange): Boolean; virtual;
- function CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray; override;
- procedure OverwriteRange(Sender: TObject);
- function FindSyntaxHole: TSyntaxRange; virtual;
- function FindSyntaxOverlap: TSyntaxRange; virtual;
- function MakeDebuggableRanges: TDebuggableRanges; virtual;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange; virtual;
- function SyntaxRangeAtPosWithHint(RangePos: Integer; Hint: TSyntaxRange): TSyntaxRange; virtual;
- procedure RemoveTrSpFromString(var Str: string; IncludeLastLine: Boolean = False); override;
- property FirstSyntaxRange: TSyntaxRange read FFirstSyntaxRange write FFirstSyntaxRange;
- property LastSyntaxRange: TSyntaxRange read FLastSyntaxRange write FLastSyntaxRange;
- published
- property SyntaxColoring: TSyntaxColoring read FSyntaxColoring write SetSyntaxColoring;
- property AutoIndentIncrease: Boolean read FAutoIndentIncrease write FAutoIndentIncrease;
- property AutoIndentIncreaseStart: Char read FAutoIndentIncreaseStart write FAutoIndentIncreaseStart;
- property AutoIndentIncreaseEnd: Char read FAutoIndentIncreaseEnd write FAutoIndentIncreaseEnd;
- property SplitOnFly: Boolean read FSplitOnFly write SetSplitOnFly;
- end;
- TSyntaxRangeClass = class of TSyntaxRange;
- TSyntaxRange = class(TCustomFormattedRange)
- private
- FParenthesisLevel: Integer;
- FNextRange: TSyntaxRange;
- FPrevRange: TSyntaxRange;
- protected
- procedure SetNewParenthesisLevel; virtual;
- function GetNextParenthesisLevel: Integer; virtual;
- function GetColor: TColor; override;
- function ReplaceSyntaxRanges(var StartRange: TSyntaxRange): Boolean; virtual;
- public
- destructor Destroy; override;
- class function EqualEndings(Range1, Range2: TSyntaxRange): Boolean;
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; virtual;
- class function InsertRangeBefore(Range: TSyntaxRange; RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
- function InsertBefore(RangeClass: TSyntaxRangeClass): TSyntaxRange;
- function InsertAfter(RangeClass: TSyntaxRangeClass): TSyntaxRange;
- class function NewRangeInsertedBefore(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
- class function NewRangeInsertedAfter(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
- procedure UpdateParenthesisLevel; virtual;
- property NextParenthesisLevel: Integer read GetNextParenthesisLevel;
- property PrevRange: TSyntaxRange read FPrevRange write FPrevRange;
- property NextRange: TSyntaxRange read FNextRange write FNextRange;
- published
- property ParenthesisLevel: Integer read FParenthesisLevel write FParenthesisLevel;
- end;
- TNormalTextRange = class(TSyntaxRange)
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- end;
- TCustomStyleRange = class(TSyntaxRange)
- private
- FStyle: TCustomStyle;
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- published
- property Style: TCustomStyle read FStyle write FStyle;
- end;
- TCustomTextRange = class(TSyntaxRange)
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- end;
- TWordListRange = class(TSyntaxRange)
- private
- FWordList: TWordList;
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- published
- property WordList: TWordList read FWordList write FWordList;
- end;
- TSymbolRange = class(TSyntaxRange)
- private
- FSymbol: string;
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- published
- property Symbol: string read FSymbol write FSymbol;
- end;
- TNumberRange = class(TSyntaxRange)
- private
- FNumber: string;
- protected
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- published
- property Number: string read FNumber write FNumber;
- end;
- TParenthesisRange = class(TSyntaxRange)
- private
- FStyle: TParenthesisStyle;
- protected
- procedure SetNewParenthesisLevel; override;
- function GetNextParenthesisLevel: Integer; override;
- function GetFont: TFont; override;
- public
- function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
- procedure UpdateParenthesisLevel; override;
- published
- property Style: TParenthesisStyle read FStyle write FStyle;
- end;
- TSyntaxColoring = class(TOwnedPersistent)
- private
- FNumberColor: TColor;
- FSymbolColor: TColor;
- FCustomStyles: TCustomStyles;
- FWordLists: TWordLists;
- FEnabled: Boolean;
- FUpdateDebth: Integer;
- FParenthesisColors: TStringList;
- FSymbolCustomStyle: Boolean;
- FNumberCustomStyle: Boolean;
- FNumberStyle: TFontStyles;
- FSymbolStyle: TFontStyles;
- FParenthesisCustomStyle: Boolean;
- FParenthesisStyle: TFontStyles;
- procedure SetCustomStyles(const Value: TCustomStyles);
- procedure SetNumberColor(const Value: TColor);
- procedure SetSymbolColor(const Value: TColor);
- procedure SetWordLists(const Value: TWordLists);
- procedure SetEnabled(const Value: Boolean);
- procedure SetParenthesisColors(const Value: TStringList);
- procedure SetNumberCustomStyle(const Value: Boolean);
- procedure SetNumberStyle(const Value: TFontStyles);
- procedure SetSymbolCustomStyle(const Value: Boolean);
- procedure SetSymbolStyle(const Value: TFontStyles);
- procedure SetParenthesisCustomStyle(const Value: Boolean);
- procedure SetParenthesisStyle(const Value: TFontStyles);
- protected
- SymbolFont,
- NumberFont,
- ParenthesisFont: TFont;
- procedure ChangeNotification(Sender: TObject);
- public
- constructor Create(AOwner: TPersistent); override;
- destructor Destroy; override;
- procedure ColoringChange; virtual;
- procedure Assign(Source: TPersistent); override;
- function GetParenthesisColor(Index: Integer): TColor;
- procedure BeginUpdate; virtual;
- procedure EndUpdate; virtual;
- published
- property Enabled: Boolean read FEnabled write SetEnabled;
- property SymbolColor: TColor read FSymbolColor write SetSymbolColor;
- property SymbolStyle: TFontStyles read FSymbolStyle write SetSymbolStyle;
- property SymbolCustomStyle: Boolean read FSymbolCustomStyle write SetSymbolCustomStyle;
- property NumberColor: TColor read FNumberColor write SetNumberColor;
- property NumberStyle: TFontStyles read FNumberStyle write SetNumberStyle;
- property NumberCustomStyle: Boolean read FNumberCustomStyle write SetNumberCustomStyle;
- property WordLists: TWordLists read FWordLists write SetWordLists;
- property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
- property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
- property ParenthesisStyle: TFontStyles read FParenthesisStyle write SetParenthesisStyle;
- property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write SetParenthesisCustomStyle;
- end;
- TWordLists = class(TCollection)
- private
- FColoring: TSyntaxColoring;
- function GetItem(Index: Integer): TWordList;
- procedure SetItem(Index: Integer; Value: TWordList);
- protected
- function GetOwner: TPersistent; override;
- procedure Update(Item: TCollectionItem); override;
- public
- constructor Create(AColoring: TSyntaxColoring);
- function Add: TWordList;
- function FindList(const S: string): TWordList;
- property Items[Index: Integer]: TWordList read GetItem write SetItem; default;
- end;
- TWordList = class(TCollectionItem)
- private
- FCustomStyle: Boolean;
- FCustomColor: Boolean;
- FColor: TColor;
- FStyle: TFontStyles;
- FWords: TStringList;
- FDisplayName: string;
- FCaseSensitive: Boolean;
- procedure SetColor(const Value: TColor);
- procedure SetCustomColor(const Value: Boolean);
- procedure SetCustomStyle(const Value: Boolean);
- procedure SetStyle(const Value: TFontStyles);
- procedure SetWords(const Value: TStringList);
- procedure SetCaseSensitive(const Value: Boolean);
- protected
- Font: TFont;
- function GetDisplayName: string; override;
- procedure SetDisplayName(const Value: string); override;
- procedure ListChange; virtual;
- procedure ChangeNotification(Sender: TObject);
- public
- constructor Create(Collection: TCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- function WordInList(S: string): Boolean;
- published
- property Caption: string read FDisplayName write SetDisplayName;
- property CustomColor: Boolean read FCustomColor write SetCustomColor;
- property Color: TColor read FColor write SetColor;
- property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
- property Style: TFontStyles read FStyle write SetStyle;
- property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
- property Words: TStringList read FWords write SetWords;
- end;
- TCustomStyles = class(TCollection)
- private
- FColoring: TSyntaxColoring;
- function GetItem(Index: Integer): TCustomStyle;
- procedure SetItem(Index: Integer; Value: TCustomStyle);
- protected
- function GetOwner: TPersistent; override;
- procedure Update(Item: TCollectionItem); override;
- public
- constructor Create(AColoring: TSyntaxColoring);
- function Add: TCustomStyle;
- function FindStyle(const S: string): TCustomStyle;
- property Items[Index: Integer]: TCustomStyle read GetItem write SetItem; default;
- end;
- TCustomStyle = class(TCollectionItem)
- private
- FCustomStyle: Boolean;
- FCustomColor: Boolean;
- FEndText: string;
- FBeginText: string;
- FColor: TColor;
- FStyle: TFontStyles;
- FIgnoreChar: TIgnoreChar;
- FDisplayName: string;
- FSwitchable: Boolean;
- FLineStartOnly: Boolean;
- FIgnoreLeadingBlanks: Boolean;
- procedure SetBeginText(Value: string);
- procedure SetColor(const Value: TColor);
- procedure SetCustomColor(const Value: Boolean);
- procedure SetCustomStyle(const Value: Boolean);
- procedure SetEndText(Value: string);
- procedure SetIgnoreChar(const Value: TIgnoreChar);
- procedure SetStyle(const Value: TFontStyles);
- procedure SetSwitchable(const Value: Boolean);
- procedure SetLineStartOnly(const Value: Boolean);
- procedure SetIgnoreLeadingBlanks(const Value: Boolean);
- protected
- Font: TFont;
- function GetDisplayName: string; override;
- procedure SetDisplayName(const Value: string); override;
- procedure StyleChange; virtual;
- public
- constructor Create(Collection: TCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- published
- property Caption: string read FDisplayName write SetDisplayName;
- property CustomColor: Boolean read FCustomColor write SetCustomColor;
- property Color: TColor read FColor write SetColor;
- property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
- property Style: TFontStyles read FStyle write SetStyle;
- property BeginText: string read FBeginText write SetBeginText;
- property EndText: string read FEndText write SetEndText;
- property IgnoreChar: TIgnoreChar read FIgnoreChar write SetIgnoreChar;
- property Switchable: Boolean read FSwitchable write SetSwitchable;
- property LineStartOnly: Boolean read FLineStartOnly write SetLineStartOnly;
- property IgnoreLeadingBlanks: Boolean read FIgnoreLeadingBlanks write SetIgnoreLeadingBlanks;
- end;
- TSyntaxColoringCopy = class(TComponent)
- private
- FNumberColor: TColor;
- FSymbolColor: TColor;
- FCustomStyles: TCustomStyles;
- FWordLists: TWordLists;
- FEnabled: Boolean;
- FParenthesisColors: TStringList;
- FSymbolCustomStyle: Boolean;
- FNumberCustomStyle: Boolean;
- FNumberStyle: TFontStyles;
- FSymbolStyle: TFontStyles;
- FParenthesisCustomStyle: Boolean;
- FParenthesisStyle: TFontStyles;
- procedure SetCustomStyles(const Value: TCustomStyles);
- procedure SetParenthesisColors(const Value: TStringList);
- procedure SetWordLists(const Value: TWordLists);
- protected
- public
- procedure Assign(Source: TPersistent); override;
- published
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property Enabled: Boolean read FEnabled write FEnabled;
- property SymbolColor: TColor read FSymbolColor write FSymbolColor;
- property SymbolStyle: TFontStyles read FSymbolStyle write FSymbolStyle;
- property SymbolCustomStyle: Boolean read FSymbolCustomStyle write FSymbolCustomStyle;
- property NumberColor: TColor read FNumberColor write FNumberColor;
- property NumberStyle: TFontStyles read FNumberStyle write FNumberStyle;
- property NumberCustomStyle: Boolean read FNumberCustomStyle write FNumberCustomStyle;
- property WordLists: TWordLists read FWordLists write SetWordLists;
- property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
- property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
- property ParenthesisStyle: TFontStyles read FParenthesisStyle write FParenthesisStyle;
- property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write FParenthesisCustomStyle;
- end;
- TSectionType = (stText, stSymbol, stParenthesis, stCustomStyle);
- function CharIsWordable(Ch: Char): Boolean;
- function CharIsIdentifier(Ch: Char): Boolean;
- function CharIsExtNumber(Ch: Char): Boolean;
- function CharIsNumber(Ch: Char): Boolean;
- function CharIsSymbol(Ch: Char): Boolean;
- function CharIsParenthesis(Ch: Char): Boolean;
- procedure Register;
- implementation
- uses
- UtilsDos;
- function CharIsWordable(Ch: Char): Boolean;
- begin
- Result := CharIsIdentifier (Ch) or (Ch in ['#', '.', '+', '-']);
- end;
- function CharIsIdentifier(Ch: Char): Boolean;
- begin
- Result := Ch in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'];
- end;
- function CharIsExtNumber(Ch: Char): Boolean;
- begin
- Result := CharIsNumber (Ch) or (Ch in ['#', '.']);
- end;
- function CharIsNumber(Ch: Char): Boolean;
- begin
- Result := Ch in ['0'..'9'];
- end;
- function CharIsHexNumber(Ch: Char): Boolean;
- begin
- Result := Ch in ['A'..'F', 'a'..'f', '0'..'9'];
- end;
- function CharIsSymbol(Ch: Char): Boolean;
- begin
- Result := Ch in SymbolChars;
- end;
- function CharIsParenthesis(Ch: Char): Boolean;
- begin
- Result := Ch in ['(', ')'];
- end;
- procedure Register;
- begin
- RegisterComponents ('Edit Controls', [TSourceEdit]);
- end;
- { TSourceEdit }
- procedure TSourceEdit.CMFontChanged(var Message: TMessage);
- begin
- inherited;
- if Assigned (SyntaxColoring) then
- SyntaxColoring.ColoringChange;
- end;
- constructor TSourceEdit.Create(AOwner: TComponent);
- begin
- inherited;
- FSyntaxColoring := TSyntaxColoring.Create (Self);
- AutoIndent := True;
- FAutoIndentIncrease := False;
- FAutoIndentIncreaseStart := '{';
- FAutoIndentIncreaseEnd := '}';
- FSplitOnFly := False;
- end;
- function TSourceEdit.CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray;
- var
- RS,
- RE,
- TotalEnd: Integer;
- ExitHere: Boolean;
- procedure AddRange(R: TCustomFormattedRange; AlwaysCopy: Boolean);
- procedure UpdateRS;
- begin
- RS := RE + 1;
- if RS < Range.RStart then
- RS := Range.RStart;
- if RS < R.RStart then
- RS := R.RStart;
- end;
- procedure SetRE(NewValue: Integer);
- begin
- if NewValue < RE then
- NewValue := RE;
- RE := NewValue;
- if RE > Range.REnd then
- RE := Range.REnd;
- if RE > R.REnd then
- RE := R.REnd;
- end;
- begin
- UpdateRS;
- if Selection.RLength > 0 then begin
- SetRE (Selection.RStart - 1);
- if RE >= RS then begin
- SetLength (Result, Length (Result) + 1);
- if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
- Result [High (Result)] := TFormattedRange.Create (nil);
- with Result [High (Result)] do begin
- FreeWhenDone := True;
- Editor := Self;
- RStart := RS;
- REnd := RE;
- Font := R.Font;
- Color := Self.Color;
- end;
- end else
- Result [High (Result)] := R;
- end;
- UpdateRS;
- SetRE (Selection.REnd);
- if RE >= RS then begin
- SetLength (Result, Length (Result) + 1);
- Result [High (Result)] := TFormattedRange.Create (nil);
- with Result [High (Result)] do begin
- FreeWhenDone := True;
- Editor := Self;
- RStart := RS;
- REnd := RE;
- Font := R.Font;
- if HasFocus then begin
- Font.Color := clHighlightText;
- Color := clHighlight;
- end else
- Color := clSilver;
- end;
- end;
- UpdateRS;
- end;
- SetRE (R.REnd);
- if RE >= RS then begin
- SetLength (Result, Length (Result) + 1);
- if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
- Result [High (Result)] := TFormattedRange.Create (nil);
- with Result [High (Result)] do begin
- FreeWhenDone := True;
- Editor := Self;
- RStart := RS;
- REnd := RE;
- Font := R.Font;
- Color := Self.Color;
- end;
- end else
- Result [High (Result)] := R;
- end;
- if R.REnd >= TotalEnd then
- ExitHere := True;
- end;
- var
- I,
- J,
- LastStart: Integer;
- CurWord: string;
- IsNum: Boolean;
- WordStyle: TWordList;
- R: TCustomFormattedRange;
- begin
- if SyntaxColoring.Enabled then begin
- ExitHere := False;
- TotalEnd := Range.REnd;
- SyntaxStartRange := SyntaxRangeAtPosWithHint (Range.RStart, SyntaxStartRange);
- RE := Range.RStart - 1;
- while Assigned (SyntaxStartRange) and (SyntaxStartRange.RStart <= Range.REnd) do begin
- if SyntaxStartRange is TCustomTextRange then begin
- CurWord := '';
- LastStart := SyntaxStartRange.RStart;
- for I := SyntaxStartRange.RStart to SyntaxStartRange.REnd + 1 do begin
- if I >= LastStart then begin
- if (I <= SyntaxStartRange.REnd) and CharIsWordable (Text [I]) and ((not CharIsSymbol (Text [I]) or ((Text [I] = '.') and (((Length (CurWord) <= 0) and (I + 1 <= Length (Text)) and CharIsNumber (Text [I + 1])) or ((Length (CurWord) > 0) and CharIsExtNumber (CurWord [1])))))) then
- CurWord := CurWord + Text [I]
- else begin
- if Length (CurWord) > 0 then begin
- IsNum := CharIsExtNumber (CurWord [1]);
- if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
- IsNum := True;
- for J := 2 to Length (CurWord) do
- if not CharIsHexNumber (CurWord [J]) then begin
- IsNum := False;
- Break;
- end;
- end;
- if IsNum then begin
- if I - Length (CurWord) > LastStart then begin
- R := TNormalTextRange.Create (nil);
- with R do try
- Editor := Self;
- RStart := LastStart;
- REnd := I - Length (CurWord) - 1;
- if RLength > 0 then
- AddRange (R, True);
- finally
- Free;
- end;
- end;
- R := TNumberRange.Create (nil);
- with R as TNumberRange do try
- Editor := Self;
- RStart := I - Length (CurWord);
- REnd := I - 1;
- Number := Text;
- if RLength > 0 then
- AddRange (R, True);
- LastStart := I;
- finally
- Free;
- end;
- end else begin
- WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
- if Assigned (WordStyle) then begin
- if I - Length (CurWord) > LastStart then begin
- R := TNormalTextRange.Create (nil);
- with R do try
- Editor := Self;
- RStart := LastStart;
- REnd := I - Length (CurWord) - 1;
- if RLength > 0 then
- AddRange (R, True);
- finally
- Free;
- end;
- end;
- R := TWordListRange.Create (nil);
- with R as TWordListRange do try
- Editor := Self;
- RStart := I - Length (CurWord);
- REnd := I - 1;
- WordList := WordStyle;
- if RLength > 0 then
- AddRange (R, True);
- LastStart := I;
- finally
- Free;
- end;
- end;
- end;
- CurWord := '';
- end;
- if (I <= SyntaxStartRange.REnd) and CharIsSymbol (Text [I]) then begin
- if I > LastStart then begin
- R := TNormalTextRange.Create (nil);
- with R do try
- Editor := Self;
- RStart := LastStart;
- REnd := I - 1;
- if RLength > 0 then
- AddRange (R, True);
- finally
- Free;
- end;
- end;
- R := TSymbolRange.Create (nil);
- with R as TSymbolRange do try
- Editor := Self;
- RStart := I;
- LastStart := I;
- while (LastStart <= SyntaxStartRange.REnd) and CharIsSymbol (Self.Text [LastStart]) do
- Inc (LastStart);
- REnd := LastStart - 1;
- Symbol := Text;
- if RLength > 0 then
- AddRange (R, True);
- finally
- Free;
- end;
- end;
- if (I > SyntaxStartRange.REnd) and (I > LastStart) then begin
- R := TNormalTextRange.Create (nil);
- with R do try
- Editor := Self;
- RStart := LastStart;
- REnd := I - 1;
- LastStart := I;
- if RLength > 0 then
- AddRange (R, True);
- finally
- Free;
- end;
- end;
- end;
- if ExitHere then
- Break;
- end;
- end;
- end else
- AddRange (SyntaxStartRange, False);
- SyntaxStartRange := SyntaxStartRange.NextRange;
- end;
- end else
- Result := inherited CreateSplitRanges (Range);
- {$IFDEF SyntaxDebug}
- for I := Low (Result) + 1 to High (Result) do
- if Result[I-1].REnd + 1 <> Result[I].RStart then
- raise ESourceEdit.Create (SSourceEditError);
- {$ENDIF}
- end;
- destructor TSourceEdit.Destroy;
- begin
- if Assigned (FSyntaxColoring) then begin
- FSyntaxColoring.FUpdateDebth := 100;
- FSyntaxColoring.Free;
- end;
- inherited;
- end;
- function TSourceEdit.FindSyntaxHole: TSyntaxRange;
- begin
- Result := FirstSyntaxRange;
- if Assigned (Result) and (Result.RStart = 1) then begin
- if LastSyntaxRange.REnd <> TextLength then
- Result := LastSyntaxRange
- else
- while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd + 1 = Result.NextRange.RStart)) do
- Result := Result.NextRange;
- end;
- end;
- function TSourceEdit.FindSyntaxOverlap: TSyntaxRange;
- begin
- Result := FirstSyntaxRange;
- while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd < Result.NextRange.RStart)) do
- Result := Result.NextRange;
- end;
- procedure TSourceEdit.FreeAllSyntaxRanges;
- begin
- while Assigned (LastSyntaxRange) do
- LastSyntaxRange.Free;
- end;
- procedure TSourceEdit.KeyPress(var Key: Char);
- var
- InsS: string;
- Rs,
- BeginLn,
- FirstChr: Integer;
- begin
- if (Key = #13) and AutoIndent then
- with Selection do
- if AutoIndentIncrease and (RStart - 1 > 0) and (RStart - 1 <= TextLength) and (Self.Text [RStart - 1] = AutoIndentIncreaseStart) and (RStart - 2 > 0) and (not (Self.Text [RStart - 2] in [#9, #10, #13])) then begin
- BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
- FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
- InsS := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
- RS := RStart;
- Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
- NoSelAtPos (RS + Length (InsS));
- ScrollInView (4);
- Key := #0;
- end;
- if (Key = AutoIndentIncreaseStart) and AutoIndentIncrease then begin
- BeginLn := CellToCharIdx (TextCell (Selection.StartRowCol.Row, 1));
- FirstChr := FirstNonWhiteSpace (Copy (Text, BeginLn, Selection.RStart - BeginLn));
- if (BeginLn + FirstChr - 1 > TextLength) or (Text [BeginLn + FirstChr - 1] = #13) then begin
- InsS := Key + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
- with Selection do begin
- RS := RStart;
- Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
- NoSelAtPos (RS + Length (InsS));
- ScrollInView (4);
- end;
- Key := #0;
- end;
- end;
- inherited;
- end;
- function TSourceEdit.MakeDebuggableRanges: TDebuggableRanges;
- var
- Range: TSyntaxRange;
- begin
- Range := FirstSyntaxRange;
- while Assigned (Range) do begin
- SetLength (Result, Length (Result) + 1);
- with Result [High (Result)] do begin
- RStart := Range.RStart;
- REnd := Range.REnd;
- Text := Range.Text;
- ClassName := Range.ClassName;
- end;
- Range := Range.NextRange;
- end;
- end;
- procedure TSourceEdit.OverwriteRange(Sender: TObject);
- begin
- Sender.Free;
- end;
- procedure TSourceEdit.ReColor;
- begin
- if TextLength > 0 then begin
- Selection.HideCaret;
- FreeAllSyntaxRanges;
- ReColorRange (WholeText);
- while Assigned (LastPRange) do begin
- LastPRange.SetNewParenthesisLevel;
- LastPRange := LastPRange.NextRange;
- end;
- VisibleRange.DrawRange;
- Selection.UpdateCaretPos;
- Selection.ShowCaret;
- end;
- end;
- procedure TSourceEdit.ReColorRange(Range: TCustomRange);
- var
- LastRange: TSyntaxRange;
- KeepRunning,
- EndingsEqual: Boolean;
- SectionStart,
- SectionLength,
- WordStart,
- CurPos: Integer;
- CustomStyle,
- NewCustomStyle: TCustomStyle;
- CurChar: Char;
- SectionType: TSectionType;
- procedure ProcessSection;
- var
- I,
- J,
- LastStart: Integer;
- CurWord: string;
- IsNum: Boolean;
- WordStyle: TWordList;
- begin
- if SectionLength > 0 then begin
- case SectionType of
- stSymbol:
- with TSymbolRange (TSymbolRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := SectionStart;
- RLength := SectionLength;
- Symbol := Text;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- end;
- stParenthesis:
- with TParenthesisRange (TParenthesisRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := SectionStart;
- RLength := SectionLength;
- if Self.Text [SectionStart] in [')', '}', ']'] then
- Style := psClosing
- else
- Style := psOpening;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- end;
- stCustomStyle:
- with TCustomStyleRange (TCustomStyleRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := SectionStart;
- RLength := SectionLength;
- Style := CustomStyle;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- end;
- stText: begin
- if SplitOnFly then
- with TCustomTextRange (TCustomTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := SectionStart;
- RLength := SectionLength;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- end
- else begin
- CurWord := '';
- LastStart := SectionStart;
- for I := SectionStart to SectionStart + SectionLength do begin
- if (I < SectionStart + SectionLength) and CharIsWordable (Text [I]) then
- Insert (Text [I], CurWord, Length (CurWord) + 1)
- else begin
- if Length (CurWord) > 0 then begin
- IsNum := CharIsExtNumber (CurWord [1]);
- if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
- IsNum := True;
- for J := 2 to Length (CurWord) do
- if not CharIsHexNumber (CurWord [J]) then begin
- IsNum := False;
- Break;
- end;
- end;
- if IsNum then begin
- if I - Length (CurWord) > LastStart then
- with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := LastStart;
- REnd := I - Length (CurWord) - 1;
- if RLength > 0 then
- EndingsEqual := ReplaceSyntaxRanges (LastRange)
- else
- Free;
- end;
- with TNumberRange (TNumberRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := I - Length (CurWord);
- REnd := I - 1;
- Number := Text;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- LastStart := I;
- end;
- end else begin
- WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
- if Assigned (WordStyle) then begin
- if I - Length (CurWord) > LastStart then
- with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := LastStart;
- REnd := I - Length (CurWord) - 1;
- if RLength > 0 then
- EndingsEqual := ReplaceSyntaxRanges (LastRange)
- else
- Free;
- end;
- with TWordListRange (TWordListRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := I - Length (CurWord);
- REnd := I - 1;
- WordList := WordStyle;
- EndingsEqual := ReplaceSyntaxRanges (LastRange);
- LastStart := I;
- end;
- end;
- end;
- CurWord := '';
- end;
- if (I >= SectionStart + SectionLength) and (I > LastStart) then
- with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
- RStart := LastStart;
- REnd := I - 1;
- LastStart := I;
- if RLength > 0 then
- EndingsEqual := ReplaceSyntaxRanges (LastRange)
- else
- Free;
- end;
- end;
- end;
- end;
- end;
- end;
- end;
- end;
- procedure SetSectionType(NewType: TSectionType);
- begin
- if SplitOnFly and (NewType = stSymbol) and (SectionLength <= MaxOnFlySectionLength) then
- NewType := stText;
- if (NewType <> SectionType) or (NewType = stParenthesis) or (NewType = stCustomStyle) then begin
- if SplitOnFly and (NewType = stSymbol) then
- NewType := stText;
- ProcessSection;
- SectionStart := CurPos;
- SectionLength := 0;
- WordStart := CurPos;
- SectionType := NewType;
- end;
- end;
- function LeadingTextOnlyHasBlanks: Boolean;
- var
- I: Integer;
- begin
- Result := True;
- I := CurPos - 1;
- while I >= 1 do begin
- if Text [I] in [#10, #13] then
- Break;
- if not (Text [I] in [#9, ' ']) then begin
- Result := False;
- Break;
- end;
- Dec (I);
- end;
- end;
- var
- I,
- L,
- P1,
- P2,
- BeginPos: Integer;
- B: Boolean;
- S,
- T: string;
- begin
- if SyntaxColoring.FUpdateDebth = 0 then begin
- if SyntaxColoring.Enabled and (TextLength > 0) then begin
- Inc (SyntaxColoring.FUpdateDebth);
- LastRange := SyntaxRangeAtPos (Range.RStart - 1);
- if Assigned (LastRange) then begin
- if Assigned (LastRange.PrevRange) and (LastRange.PrevRange is TCustomStyleRange) and Assigned ((LastRange.PrevRange as TCustomStyleRange).Style) and (LastRange.PrevRange as TCustomStyleRange).Style.Switchable then
- LastRange := LastRange.PrevRange;
- if Range.RStart > LastRange.RStart then
- Range.RStart := LastRange.RStart;
- end else
- Range.RStart := 1;
- CurPos := Range.RStart;
- SectionStart := CurPos;
- SectionLength := 0;
- WordStart := CurPos;
- SectionType := stText;
- CustomStyle := nil;
- EndingsEqual := False;
- KeepRunning := False;
- while (CurPos <= TextLength) and ((CurPos <= Range.REnd + 2) or (not EndingsEqual) or KeepRunning) do begin
- EndingsEqual := False;
- CurChar := Text [CurPos];
- NewCustomStyle := SyntaxColoring.CustomStyles.FindStyle (Copy (Text, CurPos, MaxBeginEndTextLength));
- if Assigned (NewCustomStyle) and NewCustomStyle.LineStartOnly and (CurPos - 1 > 0) and (not (Text [CurPos - 1] in [#10, #13])) and ((not NewCustomStyle.IgnoreLeadingBlanks) or LeadingTextOnlyHasBlanks) then
- NewCustomStyle := nil;
- if Assigned (NewCustomStyle) and ((SectionType = stCustomStyle) and Assigned (CustomStyle) and (((NewCustomStyle = CustomStyle) and CustomStyle.Switchable) or (NewCustomStyle.EndText <> CustomStyle.EndText))) then
- NewCustomStyle := nil;
- KeepRunning := (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable and (not Assigned (NewCustomStyle));
- if KeepRunning then begin
- T := CustomStyle.EndText;
- S := Copy (Text, CurPos, Length (T));
- if (S = T) or ((T = ' ') and ((S = #9) or (S = #13))) then begin
- KeepRunning := False;
- I := CurPos - 1;
- while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
- KeepRunning := not KeepRunning;
- if Text [I] = CustomStyle.IgnoreChar then
- Dec (I)
- else
- Dec (I, 3);
- end;
- end;
- end;
- if not KeepRunning then begin
- if Assigned (NewCustomStyle) then begin
- SetSectionType (stCustomStyle);
- CustomStyle := NewCustomStyle;
- if CustomStyle.Switchable then begin
- KeepRunning := True;
- Inc (SectionLength);
- Inc (CurPos);
- end else begin
- repeat
- S := CustomStyle.EndText;
- BeginPos := CurPos + Length (CustomStyle.BeginText);
- repeat
- T := Copy (Text, BeginPos, CustomStyleCheckLength);
- P1 := Pos (S, T);
- if S = ' ' then begin
- P2 := Pos (#9, T);
- if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then
- P1 := P2;
- P2 := Pos (#13, T);
- if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then begin
- P1 := P2;
- S := #13;
- end;
- end;
- if P1 <= 0 then
- Inc (BeginPos, CustomStyleCheckLength - MaxBeginEndTextLength);
- until (P1 > 0) or (BeginPos > TextLength);
- CurPos := BeginPos + P1 + Length (S) - 2;
- B := (P1 <= 0) or (CurPos <= Length (S));
- if not B then begin
- B := True;
- I := CurPos - Length (S);
- while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
- B := not B;
- if Text [I] = CustomStyle.IgnoreChar then
- Dec (I)
- else
- Dec (I, 3);
- end;
- end;
- until B;
- if S = #13 then
- Inc (CurPos);
- if (P1 <= 0) or (CurPos <= Length (S)) or (CurPos > TextLength) then
- CurPos := TextLength;
- Inc (CurPos);
- SectionLength := CurPos - SectionStart;
- SetSectionType (stText);
- end;
- Continue;
- end else if (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable then begin
- if CustomStyle.EndText = #13 then
- L := 2
- else
- L := Length (CustomStyle.EndText);
- Inc (SectionLength, L);
- Inc (CurPos, L);
- SetSectionType (stText);
- Continue;
- end;
- if CharIsParenthesis (CurChar) then
- SetSectionType (stParenthesis)
- else if CurChar = '.' then begin
- if ((SectionType = stText) and CharIsNumber (Text [WordStart])) or ((CurPos + 1 <= TextLength) and CharIsNumber (Text [CurPos + 1])) then
- SetSectionType (stText)
- else
- SetSectionType (stSymbol);
- end else if CurChar in ['+', '-'] then begin
- if not ((CurPos - 2 >= 1) and CharIsExtNumber (Text [CurPos - 2]) and (CurPos - 1 >= 1) and (Text [CurPos - 1] in ['e', 'E', 'p', 'P'])) then
- SetSectionType (stSymbol);
- end else if CharIsSymbol (CurChar) then
- SetSectionType (stSymbol)
- else begin
- SetSectionType (stText);
- if not CharIsIdentifier (CurChar) then
- WordStart := CurPos;
- end;
- end;
- Inc (SectionLength);
- Inc (CurPos);
- end;
- Range.REnd := CurPos - 1;
- if CurPos > TextLength then
- ProcessSection;
- LastPRange := SyntaxRangeAtPosWithHint (Range.RStart, LastRange);
- Dec (SyntaxColoring.FUpdateDebth);
- end else
- FreeAllSyntaxRanges;
- end;
- {$IFDEF SyntaxDebug}
- if FindSyntaxHole <> nil then
- raise ESourceEdit.Create (SSourceEditError);
- {$ENDIF}
- end;
- procedure TSourceEdit.RemoveTrSpFromString(var Str: string;
- IncludeLastLine: Boolean);
- var
- I: Integer;
- OK: Boolean;
- begin
- if AutoIndentIncrease then begin
- OK := False;
- for I := 1 to Length (Str) do
- if not (Str [I] in [#13, #10, ' ', #9, AutoIndentIncreaseStart, AutoIndentIncreaseEnd]) then begin
- OK := True;
- break;
- end;
- end else
- OK := True;
- if OK then
- inherited;
- end;
- function TSourceEdit.ReplaceSyntaxRanges(NewRange: TSyntaxRange;
- var StartRange: TSyntaxRange): Boolean;
- var
- PrevRange: TSyntaxRange;
- begin
- Result := False;
- if not Assigned (StartRange) then
- StartRange := LastSyntaxRange;
- while Assigned (StartRange) and ((StartRange.RStart > NewRange.RStart) or (StartRange = NewRange)) do
- StartRange := StartRange.PrevRange;
- if not Assigned (StartRange) then
- StartRange := FirstSyntaxRange;
- while Assigned (StartRange) and ((StartRange.RStart < NewRange.RStart) or (StartRange = NewRange)) do
- StartRange := StartRange.NextRange;
- if (not Assigned (StartRange)) and (LastSyntaxRange <> NewRange) then
- StartRange := LastSyntaxRange;
- while Assigned (StartRange) and (StartRange <> NewRange) and ((StartRange.RStart <= NewRange.REnd) or (StartRange.REnd <= NewRange.REnd)) do begin
- Result := StartRange.EqualEndingsWith (NewRange);
- PrevRange := StartRange;
- StartRange := StartRange.NextRange;
- PrevRange.Free;
- end;
- {$IFDEF SyntaxDebug}
- if FindSyntaxOverlap <> nil then
- raise ESourceEdit.Create (SSourceEditError);
- {$ENDIF}
- end;
- procedure TSourceEdit.SetSplitOnFly(const Value: Boolean);
- begin
- if FSplitOnFly <> Value then begin
- FSplitOnFly := Value;
- ReColor;
- end;
- end;
- procedure TSourceEdit.SetSyntaxColoring(const Value: TSyntaxColoring);
- begin
- FSyntaxColoring.Assign (Value);
- end;
- function TSourceEdit.SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange;
- begin
- Result := FirstSyntaxRange;
- while Assigned (Result) and (Result.REnd < RangePos) do
- Result := Result.NextRange;
- end;
- function TSourceEdit.SyntaxRangeAtPosWithHint(RangePos: Integer;
- Hint: TSyntaxRange): TSyntaxRange;
- begin
- if Assigned (Hint) then begin
- Result := Hint;
- while Assigned (Result) and (Result.REnd >= RangePos) do
- Result := Result.PrevRange;
- if not Assigned (Result) then
- Result := FirstSyntaxRange;
- end else
- Result := FirstSyntaxRange;
- while Assigned (Result) and (Result.REnd < RangePos) do
- Result := Result.NextRange;
- end;
- procedure TSourceEdit.TextChangeNotification(StartPos, OldLength,
- NewLength: Integer);
- begin
- inherited;
- LastPRange := nil;
- LastCRange := TMCRange.Create (nil);
- with LastCRange do begin
- Editor := Self;
- RStart := StartPos;
- RLength := NewLength;
- ReColorRange (LastCRange);
- end;
- end;
- procedure TSourceEdit.TextChangeNotificationAfter;
- begin
- inherited;
- if Assigned (LastCRange) then begin
- while Assigned (LastPRange) do begin
- if LastPRange.REnd <= LastCRange.REnd then
- LastPRange.SetNewParenthesisLevel
- else
- LastPRange.UpdateParenthesisLevel;
- LastPRange := LastPRange.NextRange;
- end;
- LastCRange.DrawRange;
- LastCRange.Free;
- LastCRange := nil;
- end;
- end;
- procedure TSourceEdit.WMKeyDown(var Message: TWMKeyDown);
- var
- Shift: TShiftState;
- begin
- if Message.CharCode = vk_Tab then begin
- Shift := KeyDataToShiftState (Message.KeyData);
- if ssShift in Shift then
- ChangeIndent (-1)
- else if (Selection.RLength > 0) and (Selection.EndRowCol.Row > Selection.StartRowCol.Row) then
- ChangeIndent (1)
- else
- inherited;
- end else
- inherited;
- end;
- { TSyntaxColoring }
- procedure TSyntaxColoring.Assign(Source: TPersistent);
- begin
- if Source is TSyntaxColoring then begin
- BeginUpdate;
- FEnabled := TSyntaxColoring(Source).Enabled;
- FSymbolColor := TSyntaxColoring(Source).SymbolColor;
- FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
- FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
- FNumberColor := TSyntaxColoring(Source).NumberColor;
- FNumberStyle := TSyntaxColoring(Source).NumberStyle;
- FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
- FWordLists.Assign (TSyntaxColoring(Source).WordLists);
- FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
- FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
- FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
- FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
- EndUpdate;
- end else if Source is TSyntaxColoringCopy then begin
- BeginUpdate;
- FEnabled := TSyntaxColoringCopy(Source).Enabled;
- FSymbolColor := TSyntaxColoringCopy(Source).SymbolColor;
- FSymbolStyle := TSyntaxColoringCopy(Source).SymbolStyle;
- FSymbolCustomStyle := TSyntaxColoringCopy(Source).SymbolCustomStyle;
- FNumberColor := TSyntaxColoringCopy(Source).NumberColor;
- FNumberStyle := TSyntaxColoringCopy(Source).NumberStyle;
- FNumberCustomStyle := TSyntaxColoringCopy(Source).NumberCustomStyle;
- FWordLists.Assign (TSyntaxColoringCopy(Source).WordLists);
- FCustomStyles.Assign (TSyntaxColoringCopy(Source).CustomStyles);
- FParenthesisColors.Assign (TSyntaxColoringCopy(Source).ParenthesisColors);
- FParenthesisStyle := TSyntaxColoringCopy(Source).ParenthesisStyle;
- FParenthesisCustomStyle := TSyntaxColoringCopy(Source).ParenthesisCustomStyle;
- EndUpdate;
- end else
- inherited Assign (Source);
- end;
- procedure TSyntaxColoring.BeginUpdate;
- begin
- Inc (FUpdateDebth);
- end;
- procedure TSyntaxColoring.ChangeNotification(Sender: TObject);
- begin
- ColoringChange;
- end;
- procedure TSyntaxColoring.ColoringChange;
- var
- I: Integer;
- begin
- if FUpdateDebth = 0 then
- if Assigned (Owner) then
- if Owner is TSourceEdit then
- with Owner as TSourceEdit do begin
- with SymbolFont do begin
- Assign (Font);
- Color := SymbolColor;
- if SymbolCustomStyle then
- Style := SymbolStyle;
- end;
- with NumberFont do begin
- Assign (Font);
- Color := NumberColor;
- if NumberCustomStyle then
- Style := NumberStyle;
- end;
- with ParenthesisFont do begin
- Assign (Font);
- Color := GetParenthesisColor (0);
- if ParenthesisCustomStyle then
- Style := ParenthesisStyle;
- end;
- with WordLists do
- for I := 0 to Count - 1 do
- with Items[I].Font do begin
- Assign (Font);
- if Items[I].CustomColor then
- Color := Items[I].Color;
- if Items[I].CustomStyle then
- Style := Items[I].Style;
- end;
- with CustomStyles do
- for I := 0 to Count - 1 do
- with Items[I].Font do begin
- Assign (Font);
- if Items[I].CustomColor then
- Color := Items[I].Color;
- if Items[I].CustomStyle then
- Style := Items[I].Style;
- end;
- ReColor;
- end;
- end;
- constructor TSyntaxColoring.Create(AOwner: TPersistent);
- begin
- inherited;
- SymbolFont := TFont.Create;
- NumberFont := TFont.Create;
- ParenthesisFont := TFont.Create;
- FWordLists := TWordLists.Create (Self);
- FCustomStyles := TCustomStyles.Create (Self);
- FParenthesisColors := TStringList.Create;
- FParenthesisColors.Duplicates := dupAccept;
- FParenthesisColors.Add ('$000000');
- FParenthesisColors.OnChange := ChangeNotification;
- FNumberColor := clGreen;
- FSymbolColor := clOlive;
- FEnabled := True;
- end;
- destructor TSyntaxColoring.Destroy;
- begin
- FParenthesisColors.Free;
- FCustomStyles.Free;
- FWordLists.Free;
- NumberFont.Free;
- SymbolFont.Free;
- ParenthesisFont.Free;
- inherited;
- end;
- procedure TSyntaxColoring.EndUpdate;
- begin
- Dec (FUpdateDebth);
- if FUpdateDebth = 0 then
- ColoringChange;
- end;
- function TSyntaxColoring.GetParenthesisColor(Index: Integer): TColor;
- begin
- with ParenthesisColors do
- if (Count <= 0) or (Index < 0) then
- Result := clWindowText
- else
- try
- Result := StrToInt (Strings [Index mod Count]);
- except
- Result := clWindowText;
- end;
- end;
- procedure TSyntaxColoring.SetCustomStyles(const Value: TCustomStyles);
- begin
- FCustomStyles.Assign (Value);
- ColoringChange;
- end;
- procedure TSyntaxColoring.SetEnabled(const Value: Boolean);
- begin
- if FEnabled <> Value then begin
- FEnabled := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetNumberColor(const Value: TColor);
- begin
- if FNumberColor <> Value then begin
- FNumberColor := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetNumberCustomStyle(const Value: Boolean);
- begin
- if FNumberCustomStyle <> Value then begin
- FNumberCustomStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetNumberStyle(const Value: TFontStyles);
- begin
- if FNumberStyle <> Value then begin
- FNumberStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetParenthesisColors(const Value: TStringList);
- begin
- FParenthesisColors.Assign (Value);
- end;
- procedure TSyntaxColoring.SetParenthesisCustomStyle(const Value: Boolean);
- begin
- if FParenthesisCustomStyle <> Value then begin
- FParenthesisCustomStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetParenthesisStyle(const Value: TFontStyles);
- begin
- if FParenthesisStyle <> Value then begin
- FParenthesisStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetSymbolColor(const Value: TColor);
- begin
- if FSymbolColor <> Value then begin
- FSymbolColor := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetSymbolCustomStyle(const Value: Boolean);
- begin
- if FSymbolCustomStyle <> Value then begin
- FSymbolCustomStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetSymbolStyle(const Value: TFontStyles);
- begin
- if FSymbolStyle <> Value then begin
- FSymbolStyle := Value;
- ColoringChange;
- end;
- end;
- procedure TSyntaxColoring.SetWordLists(const Value: TWordLists);
- begin
- FWordLists.Assign (Value);
- ColoringChange;
- end;
- { TWordLists }
- function TWordLists.Add: TWordList;
- begin
- Result := TWordList (inherited Add);
- end;
- constructor TWordLists.Create(AColoring: TSyntaxColoring);
- begin
- inherited Create (TWordList);
- FColoring := AColoring;
- end;
- function TWordLists.FindList(const S: string): TWordList;
- var
- I: Integer;
- begin
- Result := nil;
- for I := 0 to Count - 1 do
- if Items[I].WordInList (S) then begin
- Result := Items [I];
- Break;
- end;
- end;
- function TWordLists.GetItem(Index: Integer): TWordList;
- begin
- Result := TWordList (inherited GetItem (Index));
- end;
- function TWordLists.GetOwner: TPersistent;
- begin
- Result := FColoring;
- end;
- procedure TWordLists.SetItem(Index: Integer; Value: TWordList);
- begin
- inherited SetItem (Index, Value);
- end;
- procedure TWordLists.Update(Item: TCollectionItem);
- begin
- if Assigned (Item) then
- TWordList(Item).ListChange
- else
- if Assigned (FColoring) then
- FColoring.ColoringChange;
- end;
- { TWordList }
- procedure TWordList.Assign(Source: TPersistent);
- begin
- if Source is TWordList then begin
- Caption := TWordList(Source).Caption;
- FCustomColor := TWordList(Source).CustomColor;
- FColor := TWordList(Source).Color;
- FCustomStyle := TWordList(Source).CustomStyle;
- FStyle := TWordList(Source).Style;
- FCaseSensitive := TWordList(Source).CaseSensitive;
- FWords.Assign (TWordList(Source).Words);
- ListChange;
- end else
- inherited Assign (Source);
- end;
- procedure TWordList.ChangeNotification(Sender: TObject);
- begin
- ListChange;
- end;
- constructor TWordList.Create(Collection: TCollection);
- begin
- inherited;
- Font := TFont.Create;
- FWords := TStringList.Create;
- FWords.Sorted := True;
- FWords.Duplicates := dupAccept;
- FWords.OnChange := ChangeNotification;
- FColor := clBlue;
- FCustomColor := True;
- FCaseSensitive := True;
- end;
- destructor TWordList.Destroy;
- begin
- FWords.Free;
- Font.Free;
- inherited;
- end;
- function TWordList.GetDisplayName: string;
- begin
- if FDisplayName = '' then
- Result := inherited GetDisplayName
- else
- Result := FDisplayName;
- end;
- procedure TWordList.ListChange;
- begin
- if Assigned (Collection) then
- with TWordLists (Collection) do
- if Assigned (FColoring) then
- FColoring.ColoringChange;
- end;
- procedure TWordList.SetCaseSensitive(const Value: Boolean);
- begin
- if FCaseSensitive <> Value then begin
- FCaseSensitive := Value;
- ListChange;
- end;
- end;
- procedure TWordList.SetColor(const Value: TColor);
- begin
- if FColor <> Value then begin
- FColor := Value;
- ListChange;
- end;
- end;
- procedure TWordList.SetCustomColor(const Value: Boolean);
- begin
- if FCustomColor <> Value then begin
- FCustomColor := Value;
- ListChange;
- end;
- end;
- procedure TWordList.SetCustomStyle(const Value: Boolean);
- begin
- if FCustomStyle <> Value then begin
- FCustomStyle := Value;
- ListChange;
- end;
- end;
- procedure TWordList.SetDisplayName(const Value: string);
- begin
- if FDisplayName <> Value then begin
- FDisplayName := Value;
- inherited;
- end;
- end;
- procedure TWordList.SetStyle(const Value: TFontStyles);
- begin
- if FStyle <> Value then begin
- FStyle := Value;
- ListChange;
- end;
- end;
- procedure TWordList.SetWords(const Value: TStringList);
- begin
- FWords.Assign (Value);
- ListChange;
- end;
- function TWordList.WordInList(S: string): Boolean;
- var
- I: Integer;
- begin
- if CaseSensitive then
- Result := Words.Find (S, I) and (I >= 0) and (I < Words.Count) and (S = Words.Strings [I])
- else
- Result := Words.Find (S, I) or ((I >= 0) and (I < Words.Count) and (UpperCase (S) = UpperCase (Words.Strings [I])));
- end;
- { TCustomStyles }
- function TCustomStyles.Add: TCustomStyle;
- begin
- Result := TCustomStyle (inherited Add);
- end;
- constructor TCustomStyles.Create(AColoring: TSyntaxColoring);
- begin
- inherited Create (TCustomStyle);
- FColoring := AColoring;
- end;
- function TCustomStyles.FindStyle(const S: string): TCustomStyle;
- var
- I: Integer;
- begin
- Result := nil;
- if S <> '' then
- for I := 0 to Count - 1 do
- if Items[I].BeginText = Copy (S, 1, Length (Items[I].BeginText)) then begin
- Result := Items [I];
- Break;
- end;
- end;
- function TCustomStyles.GetItem(Index: Integer): TCustomStyle;
- begin
- Result := TCustomStyle (inherited GetItem (Index));
- end;
- function TCustomStyles.GetOwner: TPersistent;
- begin
- Result := FColoring;
- end;
- procedure TCustomStyles.SetItem(Index: Integer; Value: TCustomStyle);
- begin
- inherited SetItem (Index, Value);
- end;
- procedure TCustomStyles.Update(Item: TCollectionItem);
- begin
- if Assigned (FColoring) then
- FColoring.ColoringChange;
- end;
- { TCustomStyle }
- procedure TCustomStyle.Assign(Source: TPersistent);
- begin
- if Source is TCustomStyle then begin
- Caption := TCustomStyle(Source).Caption;
- FCustomColor := TCustomStyle(Source).CustomColor;
- FColor := TCustomStyle(Source).Color;
- FCustomStyle := TCustomStyle(Source).CustomStyle;
- FStyle := TCustomStyle(Source).Style;
- FBeginText := TCustomStyle(Source).BeginText;
- FEndText := TCustomStyle(Source).EndText;
- FIgnoreChar := TCustomStyle(Source).IgnoreChar;
- FSwitchable := TCustomStyle(Source).Switchable;
- FLineStartOnly := TCustomStyle(Source).LineStartOnly;
- FIgnoreLeadingBlanks := TCustomStyle(Source).IgnoreLeadingBlanks;
- StyleChange;
- end else
- inherited Assign (Source);
- end;
- constructor TCustomStyle.Create(Collection: TCollection);
- begin
- inherited;
- Font := TFont.Create;
- FColor := clMaroon;
- FCustomColor := True;
- end;
- destructor TCustomStyle.Destroy;
- begin
- Font.Free;
- inherited;
- end;
- function TCustomStyle.GetDisplayName: string;
- begin
- if FDisplayName = '' then
- Result := inherited GetDisplayName
- else
- Result := FDisplayName;
- end;
- procedure TCustomStyle.SetBeginText(Value: string);
- begin
- if Value = '#13' then
- Value := #13;
- if FBeginText <> Value then begin
- FBeginText := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetColor(const Value: TColor);
- begin
- if FColor <> Value then begin
- FColor := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetCustomColor(const Value: Boolean);
- begin
- if FCustomColor <> Value then begin
- FCustomColor := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetCustomStyle(const Value: Boolean);
- begin
- if FCustomStyle <> Value then begin
- FCustomStyle := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetDisplayName(const Value: string);
- begin
- FDisplayName := Value;
- end;
- procedure TCustomStyle.SetEndText(Value: string);
- begin
- if Value = '#13' then
- Value := #13;
- if FEndText <> Value then begin
- FEndText := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetIgnoreChar(const Value: TIgnoreChar);
- begin
- if FIgnoreChar <> Value then begin
- FIgnoreChar := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetIgnoreLeadingBlanks(const Value: Boolean);
- begin
- if FIgnoreLeadingBlanks <> Value then begin
- FIgnoreLeadingBlanks := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetLineStartOnly(const Value: Boolean);
- begin
- if FLineStartOnly <> Value then begin
- FLineStartOnly := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetStyle(const Value: TFontStyles);
- begin
- if FStyle <> Value then begin
- FStyle := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.SetSwitchable(const Value: Boolean);
- begin
- if FSwitchable <> Value then begin
- FSwitchable := Value;
- StyleChange;
- end;
- end;
- procedure TCustomStyle.StyleChange;
- begin
- if Assigned (Collection) then
- with TCustomStyles (Collection) do
- if Assigned (FColoring) then
- FColoring.ColoringChange;
- end;
- { TSyntaxColoringCopy }
- procedure TSyntaxColoringCopy.Assign(Source: TPersistent);
- begin
- if Source is TSyntaxColoring then begin
- FEnabled := TSyntaxColoring(Source).Enabled;
- FSymbolColor := TSyntaxColoring(Source).SymbolColor;
- FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
- FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
- FNumberColor := TSyntaxColoring(Source).NumberColor;
- FNumberStyle := TSyntaxColoring(Source).NumberStyle;
- FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
- FWordLists.Assign (TSyntaxColoring(Source).WordLists);
- FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
- FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
- FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
- FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
- end else
- inherited Assign (Source);
- end;
- constructor TSyntaxColoringCopy.Create(AOwner: TComponent);
- begin
- inherited;
- FWordLists := TWordLists.Create (nil);
- FCustomStyles := TCustomStyles.Create (nil);
- FParenthesisColors := TStringList.Create;
- FParenthesisColors.Duplicates := dupAccept;
- FParenthesisColors.Add ('$000000');
- FNumberColor := clGreen;
- FSymbolColor := clOlive;
- FEnabled := True;
- end;
- destructor TSyntaxColoringCopy.Destroy;
- begin
- FParenthesisColors.Free;
- FCustomStyles.Free;
- FWordLists.Free;
- inherited;
- end;
- procedure TSyntaxColoringCopy.SetCustomStyles(const Value: TCustomStyles);
- begin
- FCustomStyles.Assign (Value);
- end;
- procedure TSyntaxColoringCopy.SetParenthesisColors(
- const Value: TStringList);
- begin
- FParenthesisColors.Assign (Value);
- end;
- procedure TSyntaxColoringCopy.SetWordLists(const Value: TWordLists);
- begin
- FWordLists.Assign (Value);
- end;
- { TSyntaxRange }
- destructor TSyntaxRange.Destroy;
- begin
- if Assigned (Collection) and (not (Collection as TMCRanges).FDestroying) then begin
- if Assigned (Editor) and ((Editor as TSourceEdit).SyntaxStartRange = Self) then
- (Editor as TSourceEdit).SyntaxStartRange := nil;
- if Assigned (PrevRange) then
- PrevRange.NextRange := NextRange
- else if Assigned (Editor) then
- (Editor as TSourceEdit).FirstSyntaxRange := NextRange;
- if Assigned (NextRange) then
- NextRange.PrevRange := PrevRange
- else if Assigned (Editor) then
- (Editor as TSourceEdit).LastSyntaxRange := PrevRange;
- end;
- inherited;
- end;
- class function TSyntaxRange.EqualEndings(Range1,
- Range2: TSyntaxRange): Boolean;
- begin
- Result := Assigned (Range1) and Assigned (Range2) and Range1.EqualEndingsWith (Range2);
- end;
- function TSyntaxRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := REnd = Range.REnd;
- end;
- function TSyntaxRange.GetColor: TColor;
- begin
- if Assigned (Editor) then
- Result := Editor.Color
- else
- Result := clWindow;
- end;
- function TSyntaxRange.GetNextParenthesisLevel: Integer;
- begin
- Result := ParenthesisLevel;
- end;
- function TSyntaxRange.InsertAfter(RangeClass: TSyntaxRangeClass):
- TSyntaxRange;
- begin
- Result := InsertRangeBefore (NextRange, RangeClass, Editor as TSourceEdit);
- end;
- function TSyntaxRange.InsertBefore(RangeClass: TSyntaxRangeClass):
- TSyntaxRange;
- begin
- Result := InsertRangeBefore (Self, RangeClass, Editor as TSourceEdit);
- end;
- class function TSyntaxRange.InsertRangeBefore(Range: TSyntaxRange;
- RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
- // If Range is nil, new item is inserted at the end.
- begin
- if Assigned (Editor) then begin
- Result := RangeClass.Create (Editor.TrackedRanges);
- Result.OnOverwrite := Editor.OverwriteRange;
- if Assigned (Range) then
- Result.PrevRange := Range.PrevRange
- else
- Result.PrevRange := Editor.LastSyntaxRange;
- Result.NextRange := Range;
- if Assigned (Range) then begin
- if Assigned (Range.PrevRange) then
- Range.PrevRange.NextRange := Result
- else
- Editor.FirstSyntaxRange := Result;
- end else begin
- if not Assigned (Editor.FirstSyntaxRange) then
- Editor.FirstSyntaxRange := Result;
- if Assigned (Editor.LastSyntaxRange) then
- Editor.LastSyntaxRange.NextRange := Result;
- Editor.LastSyntaxRange := Result;
- end;
- if Assigned (Range) then
- Range.PrevRange := Result;
- end else
- raise ESourceEdit.Create (SSourceEditError);
- end;
- class function TSyntaxRange.NewRangeInsertedAfter(Range: TSyntaxRange;
- Editor: TSourceEdit): TSyntaxRange;
- begin
- if Assigned (Range) then
- Result := InsertRangeBefore (Range.NextRange, Self, Editor)
- else
- Result := nil;
- end;
- class function TSyntaxRange.NewRangeInsertedBefore(Range: TSyntaxRange;
- Editor: TSourceEdit): TSyntaxRange;
- begin
- Result := InsertRangeBefore (Range, Self, Editor);
- end;
- function TSyntaxRange.ReplaceSyntaxRanges(var StartRange: TSyntaxRange):
- Boolean;
- begin
- if Assigned (Editor) and (Editor is TSourceEdit) then
- Result := TSourceEdit(Editor).ReplaceSyntaxRanges (Self, StartRange)
- else
- Result := False;
- end;
- procedure TSyntaxRange.SetNewParenthesisLevel;
- begin
- if Assigned (PrevRange) then
- ParenthesisLevel := PrevRange.NextParenthesisLevel
- else
- ParenthesisLevel := 0;
- end;
- procedure TSyntaxRange.UpdateParenthesisLevel;
- begin
- SetNewParenthesisLevel;
- end;
- { TNormalTextRange }
- function TNormalTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TNormalTextRange) and (inherited EqualEndingsWith (Range));
- end;
- function TNormalTextRange.GetFont: TFont;
- begin
- if Assigned (Editor) then
- Result := Editor.Font
- else
- Result := nil;
- end;
- { TCustomStyleRange }
- function TCustomStyleRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TCustomStyleRange) and (inherited EqualEndingsWith (Range)) and (Style = TCustomStyleRange(Range).Style);
- end;
- function TCustomStyleRange.GetFont: TFont;
- begin
- if Assigned (Style) then
- Result := Style.Font
- else
- Result := nil;
- end;
- { TWordListRange }
- function TWordListRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TWordListRange) and (inherited EqualEndingsWith (Range)) and (WordList = TWordListRange(Range).WordList);
- end;
- function TWordListRange.GetFont: TFont;
- begin
- Result := WordList.Font;
- end;
- { TSymbolRange }
- function TSymbolRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TSymbolRange) and (inherited EqualEndingsWith (Range)) and (Symbol = TSymbolRange(Range).Symbol);
- end;
- function TSymbolRange.GetFont: TFont;
- begin
- if Assigned (Editor) then begin
- with Editor as TSourceEdit do
- if SyntaxColoring.Enabled then
- Result := SyntaxColoring.SymbolFont
- else
- Result := Font;
- end else
- Result := nil;
- end;
- { TNumberRange }
- function TNumberRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TNumberRange) and (inherited EqualEndingsWith (Range)) and (Number = TNumberRange(Range).Number);
- end;
- function TNumberRange.GetFont: TFont;
- begin
- if Assigned (Editor) then begin
- with Editor as TSourceEdit do
- if SyntaxColoring.Enabled then
- Result := SyntaxColoring.NumberFont
- else
- Result := Font;
- end else
- Result := nil;
- end;
- { TParenthesisRange }
- function TParenthesisRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TParenthesisRange) and (inherited EqualEndingsWith (Range)) and (Style = TParenthesisRange(Range).Style);
- end;
- function TParenthesisRange.GetFont: TFont;
- begin
- if Assigned (Editor) then begin
- with Editor as TSourceEdit do
- if SyntaxColoring.Enabled then begin
- Result := SyntaxColoring.ParenthesisFont;
- Result.Color := SyntaxColoring.GetParenthesisColor (ParenthesisLevel - 1);
- end else
- Result := Font;
- end else
- Result := nil;
- end;
- function TParenthesisRange.GetNextParenthesisLevel: Integer;
- begin
- if Style = psOpening then
- Result := inherited GetNextParenthesisLevel
- else
- Result := inherited GetNextParenthesisLevel - 1;
- end;
- procedure TParenthesisRange.SetNewParenthesisLevel;
- begin
- if Style = psClosing then
- inherited SetNewParenthesisLevel
- else
- if Assigned (PrevRange) then
- ParenthesisLevel := PrevRange.NextParenthesisLevel + 1
- else
- ParenthesisLevel := 1;
- end;
- procedure TParenthesisRange.UpdateParenthesisLevel;
- var
- Lev: Integer;
- begin
- Lev := ParenthesisLevel;
- inherited;
- if Lev <> ParenthesisLevel then
- DrawRange;
- end;
- { TCustomTextRange }
- function TCustomTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
- begin
- Result := (Range is TCustomTextRange) and (inherited EqualEndingsWith (Range));
- end;
- function TCustomTextRange.GetFont: TFont;
- begin
- if Assigned (Editor) then
- Result := Editor.Font
- else
- Result := nil;
- end;
- end.
|