SourceEditUnit.pas 62 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185
  1. {
  2. This Delphi component is part of TIGCC IDE.
  3. Copyright (C) 2000-2004 Sebastian Reichelt
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2, or (at your option)
  7. any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software Foundation,
  14. Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  15. }
  16. {*******************************************************}
  17. { }
  18. { TSourceEdit Component v2.19 }
  19. { }
  20. { Based on TMemoComponent }
  21. { }
  22. { Copyright (c) 2000-2004 Sebastian Reichelt }
  23. { }
  24. {*******************************************************}
  25. unit SourceEditUnit;
  26. interface
  27. uses
  28. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  29. StdCtrls, Consts, ObjList, MemoComponentUnit;
  30. const
  31. SymbolChars: set of Char = ['<', '{', '[', '(', ')', ']', '}', '>', ';', ':', ',', '.', '=', '+', '-', '*', '/', '\', '|', '"', '''', '!', '?', '&', '%', '#', '@', '^', '~'];
  32. MaxBeginEndTextLength = 20;
  33. CustomStyleCheckLength = 128;
  34. MaxOnFlySectionLength = 128;
  35. SSourceEditError = 'TSourceEdit internal error';
  36. type
  37. ESourceEdit = class(Exception);
  38. TSyntaxColoring = class;
  39. TWordLists = class;
  40. TWordList = class;
  41. TCustomStyles = class;
  42. TCustomStyle = class;
  43. TSyntaxRange = class;
  44. TIgnoreChar = string [1];
  45. TParenthesisStyle = (psOpening, psClosing);
  46. TDebuggableRange = record
  47. RStart,
  48. REnd: Integer;
  49. Text,
  50. ClassName: string;
  51. end;
  52. TDebuggableRanges = array of TDebuggableRange;
  53. TSourceEdit = class(TMemoComponent)
  54. private
  55. FSyntaxColoring: TSyntaxColoring;
  56. FFirstSyntaxRange: TSyntaxRange;
  57. FLastSyntaxRange: TSyntaxRange;
  58. FAutoIndentIncrease: Boolean;
  59. FAutoIndentIncreaseStart: Char;
  60. FAutoIndentIncreaseEnd: Char;
  61. FSplitOnFly: Boolean;
  62. procedure CMFontChanged(var Message: TMessage); message cm_FontChanged;
  63. procedure WMKeyDown(var Message: TWMKeyDown); message wm_KeyDown;
  64. procedure SetSyntaxColoring(const Value: TSyntaxColoring);
  65. procedure SetSplitOnFly(const Value: Boolean);
  66. protected
  67. SyntaxStartRange,
  68. LastPRange: TSyntaxRange;
  69. LastCRange: TCustomRange;
  70. procedure KeyPress(var Key: Char); override;
  71. procedure TextChangeNotification(StartPos, OldLength, NewLength: Integer); override;
  72. procedure TextChangeNotificationAfter; override;
  73. procedure ReColor; virtual;
  74. procedure ReColorRange(Range: TCustomRange); virtual;
  75. procedure FreeAllSyntaxRanges; virtual;
  76. function ReplaceSyntaxRanges(NewRange: TSyntaxRange; var StartRange: TSyntaxRange): Boolean; virtual;
  77. function CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray; override;
  78. procedure OverwriteRange(Sender: TObject);
  79. function FindSyntaxHole: TSyntaxRange; virtual;
  80. function FindSyntaxOverlap: TSyntaxRange; virtual;
  81. function MakeDebuggableRanges: TDebuggableRanges; virtual;
  82. public
  83. constructor Create(AOwner: TComponent); override;
  84. destructor Destroy; override;
  85. function SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange; virtual;
  86. function SyntaxRangeAtPosWithHint(RangePos: Integer; Hint: TSyntaxRange): TSyntaxRange; virtual;
  87. procedure RemoveTrSpFromString(var Str: string; IncludeLastLine: Boolean = False); override;
  88. property FirstSyntaxRange: TSyntaxRange read FFirstSyntaxRange write FFirstSyntaxRange;
  89. property LastSyntaxRange: TSyntaxRange read FLastSyntaxRange write FLastSyntaxRange;
  90. published
  91. property SyntaxColoring: TSyntaxColoring read FSyntaxColoring write SetSyntaxColoring;
  92. property AutoIndentIncrease: Boolean read FAutoIndentIncrease write FAutoIndentIncrease;
  93. property AutoIndentIncreaseStart: Char read FAutoIndentIncreaseStart write FAutoIndentIncreaseStart;
  94. property AutoIndentIncreaseEnd: Char read FAutoIndentIncreaseEnd write FAutoIndentIncreaseEnd;
  95. property SplitOnFly: Boolean read FSplitOnFly write SetSplitOnFly;
  96. end;
  97. TSyntaxRangeClass = class of TSyntaxRange;
  98. TSyntaxRange = class(TCustomFormattedRange)
  99. private
  100. FParenthesisLevel: Integer;
  101. FNextRange: TSyntaxRange;
  102. FPrevRange: TSyntaxRange;
  103. protected
  104. procedure SetNewParenthesisLevel; virtual;
  105. function GetNextParenthesisLevel: Integer; virtual;
  106. function GetColor: TColor; override;
  107. function ReplaceSyntaxRanges(var StartRange: TSyntaxRange): Boolean; virtual;
  108. public
  109. destructor Destroy; override;
  110. class function EqualEndings(Range1, Range2: TSyntaxRange): Boolean;
  111. function EqualEndingsWith(Range: TSyntaxRange): Boolean; virtual;
  112. class function InsertRangeBefore(Range: TSyntaxRange; RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
  113. function InsertBefore(RangeClass: TSyntaxRangeClass): TSyntaxRange;
  114. function InsertAfter(RangeClass: TSyntaxRangeClass): TSyntaxRange;
  115. class function NewRangeInsertedBefore(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
  116. class function NewRangeInsertedAfter(Range: TSyntaxRange; Editor: TSourceEdit): TSyntaxRange;
  117. procedure UpdateParenthesisLevel; virtual;
  118. property NextParenthesisLevel: Integer read GetNextParenthesisLevel;
  119. property PrevRange: TSyntaxRange read FPrevRange write FPrevRange;
  120. property NextRange: TSyntaxRange read FNextRange write FNextRange;
  121. published
  122. property ParenthesisLevel: Integer read FParenthesisLevel write FParenthesisLevel;
  123. end;
  124. TNormalTextRange = class(TSyntaxRange)
  125. protected
  126. function GetFont: TFont; override;
  127. public
  128. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  129. end;
  130. TCustomStyleRange = class(TSyntaxRange)
  131. private
  132. FStyle: TCustomStyle;
  133. protected
  134. function GetFont: TFont; override;
  135. public
  136. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  137. published
  138. property Style: TCustomStyle read FStyle write FStyle;
  139. end;
  140. TCustomTextRange = class(TSyntaxRange)
  141. protected
  142. function GetFont: TFont; override;
  143. public
  144. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  145. end;
  146. TWordListRange = class(TSyntaxRange)
  147. private
  148. FWordList: TWordList;
  149. protected
  150. function GetFont: TFont; override;
  151. public
  152. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  153. published
  154. property WordList: TWordList read FWordList write FWordList;
  155. end;
  156. TSymbolRange = class(TSyntaxRange)
  157. private
  158. FSymbol: string;
  159. protected
  160. function GetFont: TFont; override;
  161. public
  162. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  163. published
  164. property Symbol: string read FSymbol write FSymbol;
  165. end;
  166. TNumberRange = class(TSyntaxRange)
  167. private
  168. FNumber: string;
  169. protected
  170. function GetFont: TFont; override;
  171. public
  172. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  173. published
  174. property Number: string read FNumber write FNumber;
  175. end;
  176. TParenthesisRange = class(TSyntaxRange)
  177. private
  178. FStyle: TParenthesisStyle;
  179. protected
  180. procedure SetNewParenthesisLevel; override;
  181. function GetNextParenthesisLevel: Integer; override;
  182. function GetFont: TFont; override;
  183. public
  184. function EqualEndingsWith(Range: TSyntaxRange): Boolean; override;
  185. procedure UpdateParenthesisLevel; override;
  186. published
  187. property Style: TParenthesisStyle read FStyle write FStyle;
  188. end;
  189. TSyntaxColoring = class(TOwnedPersistent)
  190. private
  191. FNumberColor: TColor;
  192. FSymbolColor: TColor;
  193. FCustomStyles: TCustomStyles;
  194. FWordLists: TWordLists;
  195. FEnabled: Boolean;
  196. FUpdateDebth: Integer;
  197. FParenthesisColors: TStringList;
  198. FSymbolCustomStyle: Boolean;
  199. FNumberCustomStyle: Boolean;
  200. FNumberStyle: TFontStyles;
  201. FSymbolStyle: TFontStyles;
  202. FParenthesisCustomStyle: Boolean;
  203. FParenthesisStyle: TFontStyles;
  204. procedure SetCustomStyles(const Value: TCustomStyles);
  205. procedure SetNumberColor(const Value: TColor);
  206. procedure SetSymbolColor(const Value: TColor);
  207. procedure SetWordLists(const Value: TWordLists);
  208. procedure SetEnabled(const Value: Boolean);
  209. procedure SetParenthesisColors(const Value: TStringList);
  210. procedure SetNumberCustomStyle(const Value: Boolean);
  211. procedure SetNumberStyle(const Value: TFontStyles);
  212. procedure SetSymbolCustomStyle(const Value: Boolean);
  213. procedure SetSymbolStyle(const Value: TFontStyles);
  214. procedure SetParenthesisCustomStyle(const Value: Boolean);
  215. procedure SetParenthesisStyle(const Value: TFontStyles);
  216. protected
  217. SymbolFont,
  218. NumberFont,
  219. ParenthesisFont: TFont;
  220. procedure ChangeNotification(Sender: TObject);
  221. public
  222. constructor Create(AOwner: TPersistent); override;
  223. destructor Destroy; override;
  224. procedure ColoringChange; virtual;
  225. procedure Assign(Source: TPersistent); override;
  226. function GetParenthesisColor(Index: Integer): TColor;
  227. procedure BeginUpdate; virtual;
  228. procedure EndUpdate; virtual;
  229. published
  230. property Enabled: Boolean read FEnabled write SetEnabled;
  231. property SymbolColor: TColor read FSymbolColor write SetSymbolColor;
  232. property SymbolStyle: TFontStyles read FSymbolStyle write SetSymbolStyle;
  233. property SymbolCustomStyle: Boolean read FSymbolCustomStyle write SetSymbolCustomStyle;
  234. property NumberColor: TColor read FNumberColor write SetNumberColor;
  235. property NumberStyle: TFontStyles read FNumberStyle write SetNumberStyle;
  236. property NumberCustomStyle: Boolean read FNumberCustomStyle write SetNumberCustomStyle;
  237. property WordLists: TWordLists read FWordLists write SetWordLists;
  238. property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
  239. property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
  240. property ParenthesisStyle: TFontStyles read FParenthesisStyle write SetParenthesisStyle;
  241. property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write SetParenthesisCustomStyle;
  242. end;
  243. TWordLists = class(TCollection)
  244. private
  245. FColoring: TSyntaxColoring;
  246. function GetItem(Index: Integer): TWordList;
  247. procedure SetItem(Index: Integer; Value: TWordList);
  248. protected
  249. function GetOwner: TPersistent; override;
  250. procedure Update(Item: TCollectionItem); override;
  251. public
  252. constructor Create(AColoring: TSyntaxColoring);
  253. function Add: TWordList;
  254. function FindList(const S: string): TWordList;
  255. property Items[Index: Integer]: TWordList read GetItem write SetItem; default;
  256. end;
  257. TWordList = class(TCollectionItem)
  258. private
  259. FCustomStyle: Boolean;
  260. FCustomColor: Boolean;
  261. FColor: TColor;
  262. FStyle: TFontStyles;
  263. FWords: TStringList;
  264. FDisplayName: string;
  265. FCaseSensitive: Boolean;
  266. procedure SetColor(const Value: TColor);
  267. procedure SetCustomColor(const Value: Boolean);
  268. procedure SetCustomStyle(const Value: Boolean);
  269. procedure SetStyle(const Value: TFontStyles);
  270. procedure SetWords(const Value: TStringList);
  271. procedure SetCaseSensitive(const Value: Boolean);
  272. protected
  273. Font: TFont;
  274. function GetDisplayName: string; override;
  275. procedure SetDisplayName(const Value: string); override;
  276. procedure ListChange; virtual;
  277. procedure ChangeNotification(Sender: TObject);
  278. public
  279. constructor Create(Collection: TCollection); override;
  280. destructor Destroy; override;
  281. procedure Assign(Source: TPersistent); override;
  282. function WordInList(S: string): Boolean;
  283. published
  284. property Caption: string read FDisplayName write SetDisplayName;
  285. property CustomColor: Boolean read FCustomColor write SetCustomColor;
  286. property Color: TColor read FColor write SetColor;
  287. property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
  288. property Style: TFontStyles read FStyle write SetStyle;
  289. property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
  290. property Words: TStringList read FWords write SetWords;
  291. end;
  292. TCustomStyles = class(TCollection)
  293. private
  294. FColoring: TSyntaxColoring;
  295. function GetItem(Index: Integer): TCustomStyle;
  296. procedure SetItem(Index: Integer; Value: TCustomStyle);
  297. protected
  298. function GetOwner: TPersistent; override;
  299. procedure Update(Item: TCollectionItem); override;
  300. public
  301. constructor Create(AColoring: TSyntaxColoring);
  302. function Add: TCustomStyle;
  303. function FindStyle(const S: string): TCustomStyle;
  304. property Items[Index: Integer]: TCustomStyle read GetItem write SetItem; default;
  305. end;
  306. TCustomStyle = class(TCollectionItem)
  307. private
  308. FCustomStyle: Boolean;
  309. FCustomColor: Boolean;
  310. FEndText: string;
  311. FBeginText: string;
  312. FColor: TColor;
  313. FStyle: TFontStyles;
  314. FIgnoreChar: TIgnoreChar;
  315. FDisplayName: string;
  316. FSwitchable: Boolean;
  317. FLineStartOnly: Boolean;
  318. FIgnoreLeadingBlanks: Boolean;
  319. procedure SetBeginText(Value: string);
  320. procedure SetColor(const Value: TColor);
  321. procedure SetCustomColor(const Value: Boolean);
  322. procedure SetCustomStyle(const Value: Boolean);
  323. procedure SetEndText(Value: string);
  324. procedure SetIgnoreChar(const Value: TIgnoreChar);
  325. procedure SetStyle(const Value: TFontStyles);
  326. procedure SetSwitchable(const Value: Boolean);
  327. procedure SetLineStartOnly(const Value: Boolean);
  328. procedure SetIgnoreLeadingBlanks(const Value: Boolean);
  329. protected
  330. Font: TFont;
  331. function GetDisplayName: string; override;
  332. procedure SetDisplayName(const Value: string); override;
  333. procedure StyleChange; virtual;
  334. public
  335. constructor Create(Collection: TCollection); override;
  336. destructor Destroy; override;
  337. procedure Assign(Source: TPersistent); override;
  338. published
  339. property Caption: string read FDisplayName write SetDisplayName;
  340. property CustomColor: Boolean read FCustomColor write SetCustomColor;
  341. property Color: TColor read FColor write SetColor;
  342. property CustomStyle: Boolean read FCustomStyle write SetCustomStyle;
  343. property Style: TFontStyles read FStyle write SetStyle;
  344. property BeginText: string read FBeginText write SetBeginText;
  345. property EndText: string read FEndText write SetEndText;
  346. property IgnoreChar: TIgnoreChar read FIgnoreChar write SetIgnoreChar;
  347. property Switchable: Boolean read FSwitchable write SetSwitchable;
  348. property LineStartOnly: Boolean read FLineStartOnly write SetLineStartOnly;
  349. property IgnoreLeadingBlanks: Boolean read FIgnoreLeadingBlanks write SetIgnoreLeadingBlanks;
  350. end;
  351. TSyntaxColoringCopy = class(TComponent)
  352. private
  353. FNumberColor: TColor;
  354. FSymbolColor: TColor;
  355. FCustomStyles: TCustomStyles;
  356. FWordLists: TWordLists;
  357. FEnabled: Boolean;
  358. FParenthesisColors: TStringList;
  359. FSymbolCustomStyle: Boolean;
  360. FNumberCustomStyle: Boolean;
  361. FNumberStyle: TFontStyles;
  362. FSymbolStyle: TFontStyles;
  363. FParenthesisCustomStyle: Boolean;
  364. FParenthesisStyle: TFontStyles;
  365. procedure SetCustomStyles(const Value: TCustomStyles);
  366. procedure SetParenthesisColors(const Value: TStringList);
  367. procedure SetWordLists(const Value: TWordLists);
  368. protected
  369. public
  370. procedure Assign(Source: TPersistent); override;
  371. published
  372. constructor Create(AOwner: TComponent); override;
  373. destructor Destroy; override;
  374. property Enabled: Boolean read FEnabled write FEnabled;
  375. property SymbolColor: TColor read FSymbolColor write FSymbolColor;
  376. property SymbolStyle: TFontStyles read FSymbolStyle write FSymbolStyle;
  377. property SymbolCustomStyle: Boolean read FSymbolCustomStyle write FSymbolCustomStyle;
  378. property NumberColor: TColor read FNumberColor write FNumberColor;
  379. property NumberStyle: TFontStyles read FNumberStyle write FNumberStyle;
  380. property NumberCustomStyle: Boolean read FNumberCustomStyle write FNumberCustomStyle;
  381. property WordLists: TWordLists read FWordLists write SetWordLists;
  382. property CustomStyles: TCustomStyles read FCustomStyles write SetCustomStyles;
  383. property ParenthesisColors: TStringList read FParenthesisColors write SetParenthesisColors;
  384. property ParenthesisStyle: TFontStyles read FParenthesisStyle write FParenthesisStyle;
  385. property ParenthesisCustomStyle: Boolean read FParenthesisCustomStyle write FParenthesisCustomStyle;
  386. end;
  387. TSectionType = (stText, stSymbol, stParenthesis, stCustomStyle);
  388. function CharIsWordable(Ch: Char): Boolean;
  389. function CharIsIdentifier(Ch: Char): Boolean;
  390. function CharIsExtNumber(Ch: Char): Boolean;
  391. function CharIsNumber(Ch: Char): Boolean;
  392. function CharIsSymbol(Ch: Char): Boolean;
  393. function CharIsParenthesis(Ch: Char): Boolean;
  394. procedure Register;
  395. implementation
  396. uses
  397. UtilsDos;
  398. function CharIsWordable(Ch: Char): Boolean;
  399. begin
  400. Result := CharIsIdentifier (Ch) or (Ch in ['#', '.', '+', '-']);
  401. end;
  402. function CharIsIdentifier(Ch: Char): Boolean;
  403. begin
  404. Result := Ch in ['A'..'Z', 'a'..'z', '0'..'9', '_', '$'];
  405. end;
  406. function CharIsExtNumber(Ch: Char): Boolean;
  407. begin
  408. Result := CharIsNumber (Ch) or (Ch in ['#', '.']);
  409. end;
  410. function CharIsNumber(Ch: Char): Boolean;
  411. begin
  412. Result := Ch in ['0'..'9'];
  413. end;
  414. function CharIsHexNumber(Ch: Char): Boolean;
  415. begin
  416. Result := Ch in ['A'..'F', 'a'..'f', '0'..'9'];
  417. end;
  418. function CharIsSymbol(Ch: Char): Boolean;
  419. begin
  420. Result := Ch in SymbolChars;
  421. end;
  422. function CharIsParenthesis(Ch: Char): Boolean;
  423. begin
  424. Result := Ch in ['(', ')'];
  425. end;
  426. procedure Register;
  427. begin
  428. RegisterComponents ('Edit Controls', [TSourceEdit]);
  429. end;
  430. { TSourceEdit }
  431. procedure TSourceEdit.CMFontChanged(var Message: TMessage);
  432. begin
  433. inherited;
  434. if Assigned (SyntaxColoring) then
  435. SyntaxColoring.ColoringChange;
  436. end;
  437. constructor TSourceEdit.Create(AOwner: TComponent);
  438. begin
  439. inherited;
  440. FSyntaxColoring := TSyntaxColoring.Create (Self);
  441. AutoIndent := True;
  442. FAutoIndentIncrease := False;
  443. FAutoIndentIncreaseStart := '{';
  444. FAutoIndentIncreaseEnd := '}';
  445. FSplitOnFly := False;
  446. end;
  447. function TSourceEdit.CreateSplitRanges(Range: TCustomRange): TFormattedRangeArray;
  448. var
  449. RS,
  450. RE,
  451. TotalEnd: Integer;
  452. ExitHere: Boolean;
  453. procedure AddRange(R: TCustomFormattedRange; AlwaysCopy: Boolean);
  454. procedure UpdateRS;
  455. begin
  456. RS := RE + 1;
  457. if RS < Range.RStart then
  458. RS := Range.RStart;
  459. if RS < R.RStart then
  460. RS := R.RStart;
  461. end;
  462. procedure SetRE(NewValue: Integer);
  463. begin
  464. if NewValue < RE then
  465. NewValue := RE;
  466. RE := NewValue;
  467. if RE > Range.REnd then
  468. RE := Range.REnd;
  469. if RE > R.REnd then
  470. RE := R.REnd;
  471. end;
  472. begin
  473. UpdateRS;
  474. if Selection.RLength > 0 then begin
  475. SetRE (Selection.RStart - 1);
  476. if RE >= RS then begin
  477. SetLength (Result, Length (Result) + 1);
  478. if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
  479. Result [High (Result)] := TFormattedRange.Create (nil);
  480. with Result [High (Result)] do begin
  481. FreeWhenDone := True;
  482. Editor := Self;
  483. RStart := RS;
  484. REnd := RE;
  485. Font := R.Font;
  486. Color := Self.Color;
  487. end;
  488. end else
  489. Result [High (Result)] := R;
  490. end;
  491. UpdateRS;
  492. SetRE (Selection.REnd);
  493. if RE >= RS then begin
  494. SetLength (Result, Length (Result) + 1);
  495. Result [High (Result)] := TFormattedRange.Create (nil);
  496. with Result [High (Result)] do begin
  497. FreeWhenDone := True;
  498. Editor := Self;
  499. RStart := RS;
  500. REnd := RE;
  501. Font := R.Font;
  502. if HasFocus then begin
  503. Font.Color := clHighlightText;
  504. Color := clHighlight;
  505. end else
  506. Color := clSilver;
  507. end;
  508. end;
  509. UpdateRS;
  510. end;
  511. SetRE (R.REnd);
  512. if RE >= RS then begin
  513. SetLength (Result, Length (Result) + 1);
  514. if AlwaysCopy or (RS <> R.RStart) or (RE <> R.REnd) then begin
  515. Result [High (Result)] := TFormattedRange.Create (nil);
  516. with Result [High (Result)] do begin
  517. FreeWhenDone := True;
  518. Editor := Self;
  519. RStart := RS;
  520. REnd := RE;
  521. Font := R.Font;
  522. Color := Self.Color;
  523. end;
  524. end else
  525. Result [High (Result)] := R;
  526. end;
  527. if R.REnd >= TotalEnd then
  528. ExitHere := True;
  529. end;
  530. var
  531. I,
  532. J,
  533. LastStart: Integer;
  534. CurWord: string;
  535. IsNum: Boolean;
  536. WordStyle: TWordList;
  537. R: TCustomFormattedRange;
  538. begin
  539. if SyntaxColoring.Enabled then begin
  540. ExitHere := False;
  541. TotalEnd := Range.REnd;
  542. SyntaxStartRange := SyntaxRangeAtPosWithHint (Range.RStart, SyntaxStartRange);
  543. RE := Range.RStart - 1;
  544. while Assigned (SyntaxStartRange) and (SyntaxStartRange.RStart <= Range.REnd) do begin
  545. if SyntaxStartRange is TCustomTextRange then begin
  546. CurWord := '';
  547. LastStart := SyntaxStartRange.RStart;
  548. for I := SyntaxStartRange.RStart to SyntaxStartRange.REnd + 1 do begin
  549. if I >= LastStart then begin
  550. 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
  551. CurWord := CurWord + Text [I]
  552. else begin
  553. if Length (CurWord) > 0 then begin
  554. IsNum := CharIsExtNumber (CurWord [1]);
  555. if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
  556. IsNum := True;
  557. for J := 2 to Length (CurWord) do
  558. if not CharIsHexNumber (CurWord [J]) then begin
  559. IsNum := False;
  560. Break;
  561. end;
  562. end;
  563. if IsNum then begin
  564. if I - Length (CurWord) > LastStart then begin
  565. R := TNormalTextRange.Create (nil);
  566. with R do try
  567. Editor := Self;
  568. RStart := LastStart;
  569. REnd := I - Length (CurWord) - 1;
  570. if RLength > 0 then
  571. AddRange (R, True);
  572. finally
  573. Free;
  574. end;
  575. end;
  576. R := TNumberRange.Create (nil);
  577. with R as TNumberRange do try
  578. Editor := Self;
  579. RStart := I - Length (CurWord);
  580. REnd := I - 1;
  581. Number := Text;
  582. if RLength > 0 then
  583. AddRange (R, True);
  584. LastStart := I;
  585. finally
  586. Free;
  587. end;
  588. end else begin
  589. WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
  590. if Assigned (WordStyle) then begin
  591. if I - Length (CurWord) > LastStart then begin
  592. R := TNormalTextRange.Create (nil);
  593. with R do try
  594. Editor := Self;
  595. RStart := LastStart;
  596. REnd := I - Length (CurWord) - 1;
  597. if RLength > 0 then
  598. AddRange (R, True);
  599. finally
  600. Free;
  601. end;
  602. end;
  603. R := TWordListRange.Create (nil);
  604. with R as TWordListRange do try
  605. Editor := Self;
  606. RStart := I - Length (CurWord);
  607. REnd := I - 1;
  608. WordList := WordStyle;
  609. if RLength > 0 then
  610. AddRange (R, True);
  611. LastStart := I;
  612. finally
  613. Free;
  614. end;
  615. end;
  616. end;
  617. CurWord := '';
  618. end;
  619. if (I <= SyntaxStartRange.REnd) and CharIsSymbol (Text [I]) then begin
  620. if I > LastStart then begin
  621. R := TNormalTextRange.Create (nil);
  622. with R do try
  623. Editor := Self;
  624. RStart := LastStart;
  625. REnd := I - 1;
  626. if RLength > 0 then
  627. AddRange (R, True);
  628. finally
  629. Free;
  630. end;
  631. end;
  632. R := TSymbolRange.Create (nil);
  633. with R as TSymbolRange do try
  634. Editor := Self;
  635. RStart := I;
  636. LastStart := I;
  637. while (LastStart <= SyntaxStartRange.REnd) and CharIsSymbol (Self.Text [LastStart]) do
  638. Inc (LastStart);
  639. REnd := LastStart - 1;
  640. Symbol := Text;
  641. if RLength > 0 then
  642. AddRange (R, True);
  643. finally
  644. Free;
  645. end;
  646. end;
  647. if (I > SyntaxStartRange.REnd) and (I > LastStart) then begin
  648. R := TNormalTextRange.Create (nil);
  649. with R do try
  650. Editor := Self;
  651. RStart := LastStart;
  652. REnd := I - 1;
  653. LastStart := I;
  654. if RLength > 0 then
  655. AddRange (R, True);
  656. finally
  657. Free;
  658. end;
  659. end;
  660. end;
  661. if ExitHere then
  662. Break;
  663. end;
  664. end;
  665. end else
  666. AddRange (SyntaxStartRange, False);
  667. SyntaxStartRange := SyntaxStartRange.NextRange;
  668. end;
  669. end else
  670. Result := inherited CreateSplitRanges (Range);
  671. {$IFDEF SyntaxDebug}
  672. for I := Low (Result) + 1 to High (Result) do
  673. if Result[I-1].REnd + 1 <> Result[I].RStart then
  674. raise ESourceEdit.Create (SSourceEditError);
  675. {$ENDIF}
  676. end;
  677. destructor TSourceEdit.Destroy;
  678. begin
  679. if Assigned (FSyntaxColoring) then begin
  680. FSyntaxColoring.FUpdateDebth := 100;
  681. FSyntaxColoring.Free;
  682. end;
  683. inherited;
  684. end;
  685. function TSourceEdit.FindSyntaxHole: TSyntaxRange;
  686. begin
  687. Result := FirstSyntaxRange;
  688. if Assigned (Result) and (Result.RStart = 1) then begin
  689. if LastSyntaxRange.REnd <> TextLength then
  690. Result := LastSyntaxRange
  691. else
  692. while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd + 1 = Result.NextRange.RStart)) do
  693. Result := Result.NextRange;
  694. end;
  695. end;
  696. function TSourceEdit.FindSyntaxOverlap: TSyntaxRange;
  697. begin
  698. Result := FirstSyntaxRange;
  699. while Assigned (Result) and ((not Assigned (Result.NextRange)) or (Result.REnd < Result.NextRange.RStart)) do
  700. Result := Result.NextRange;
  701. end;
  702. procedure TSourceEdit.FreeAllSyntaxRanges;
  703. begin
  704. while Assigned (LastSyntaxRange) do
  705. LastSyntaxRange.Free;
  706. end;
  707. procedure TSourceEdit.KeyPress(var Key: Char);
  708. var
  709. InsS: string;
  710. Rs,
  711. BeginLn,
  712. FirstChr: Integer;
  713. begin
  714. if (Key = #13) and AutoIndent then
  715. with Selection do
  716. 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
  717. BeginLn := CellToCharIdx (TextCell (StartRowCol.Row, 1));
  718. FirstChr := FirstNonWhiteSpace (Copy (Self.Text, BeginLn, RStart - BeginLn));
  719. InsS := #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
  720. RS := RStart;
  721. Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
  722. NoSelAtPos (RS + Length (InsS));
  723. ScrollInView (4);
  724. Key := #0;
  725. end;
  726. if (Key = AutoIndentIncreaseStart) and AutoIndentIncrease then begin
  727. BeginLn := CellToCharIdx (TextCell (Selection.StartRowCol.Row, 1));
  728. FirstChr := FirstNonWhiteSpace (Copy (Text, BeginLn, Selection.RStart - BeginLn));
  729. if (BeginLn + FirstChr - 1 > TextLength) or (Text [BeginLn + FirstChr - 1] = #13) then begin
  730. InsS := Key + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + #9;
  731. with Selection do begin
  732. RS := RStart;
  733. Text := InsS + #13#10 + Copy (Self.Text, BeginLn, FirstChr - 1) + AutoIndentIncreaseEnd;
  734. NoSelAtPos (RS + Length (InsS));
  735. ScrollInView (4);
  736. end;
  737. Key := #0;
  738. end;
  739. end;
  740. inherited;
  741. end;
  742. function TSourceEdit.MakeDebuggableRanges: TDebuggableRanges;
  743. var
  744. Range: TSyntaxRange;
  745. begin
  746. Range := FirstSyntaxRange;
  747. while Assigned (Range) do begin
  748. SetLength (Result, Length (Result) + 1);
  749. with Result [High (Result)] do begin
  750. RStart := Range.RStart;
  751. REnd := Range.REnd;
  752. Text := Range.Text;
  753. ClassName := Range.ClassName;
  754. end;
  755. Range := Range.NextRange;
  756. end;
  757. end;
  758. procedure TSourceEdit.OverwriteRange(Sender: TObject);
  759. begin
  760. Sender.Free;
  761. end;
  762. procedure TSourceEdit.ReColor;
  763. begin
  764. if TextLength > 0 then begin
  765. Selection.HideCaret;
  766. FreeAllSyntaxRanges;
  767. ReColorRange (WholeText);
  768. while Assigned (LastPRange) do begin
  769. LastPRange.SetNewParenthesisLevel;
  770. LastPRange := LastPRange.NextRange;
  771. end;
  772. VisibleRange.DrawRange;
  773. Selection.UpdateCaretPos;
  774. Selection.ShowCaret;
  775. end;
  776. end;
  777. procedure TSourceEdit.ReColorRange(Range: TCustomRange);
  778. var
  779. LastRange: TSyntaxRange;
  780. KeepRunning,
  781. EndingsEqual: Boolean;
  782. SectionStart,
  783. SectionLength,
  784. WordStart,
  785. CurPos: Integer;
  786. CustomStyle,
  787. NewCustomStyle: TCustomStyle;
  788. CurChar: Char;
  789. SectionType: TSectionType;
  790. procedure ProcessSection;
  791. var
  792. I,
  793. J,
  794. LastStart: Integer;
  795. CurWord: string;
  796. IsNum: Boolean;
  797. WordStyle: TWordList;
  798. begin
  799. if SectionLength > 0 then begin
  800. case SectionType of
  801. stSymbol:
  802. with TSymbolRange (TSymbolRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  803. RStart := SectionStart;
  804. RLength := SectionLength;
  805. Symbol := Text;
  806. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  807. end;
  808. stParenthesis:
  809. with TParenthesisRange (TParenthesisRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  810. RStart := SectionStart;
  811. RLength := SectionLength;
  812. if Self.Text [SectionStart] in [')', '}', ']'] then
  813. Style := psClosing
  814. else
  815. Style := psOpening;
  816. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  817. end;
  818. stCustomStyle:
  819. with TCustomStyleRange (TCustomStyleRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  820. RStart := SectionStart;
  821. RLength := SectionLength;
  822. Style := CustomStyle;
  823. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  824. end;
  825. stText: begin
  826. if SplitOnFly then
  827. with TCustomTextRange (TCustomTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  828. RStart := SectionStart;
  829. RLength := SectionLength;
  830. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  831. end
  832. else begin
  833. CurWord := '';
  834. LastStart := SectionStart;
  835. for I := SectionStart to SectionStart + SectionLength do begin
  836. if (I < SectionStart + SectionLength) and CharIsWordable (Text [I]) then
  837. Insert (Text [I], CurWord, Length (CurWord) + 1)
  838. else begin
  839. if Length (CurWord) > 0 then begin
  840. IsNum := CharIsExtNumber (CurWord [1]);
  841. if (not IsNum) and (CurWord [1] = '$') and (Length (CurWord) > 1) then begin
  842. IsNum := True;
  843. for J := 2 to Length (CurWord) do
  844. if not CharIsHexNumber (CurWord [J]) then begin
  845. IsNum := False;
  846. Break;
  847. end;
  848. end;
  849. if IsNum then begin
  850. if I - Length (CurWord) > LastStart then
  851. with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  852. RStart := LastStart;
  853. REnd := I - Length (CurWord) - 1;
  854. if RLength > 0 then
  855. EndingsEqual := ReplaceSyntaxRanges (LastRange)
  856. else
  857. Free;
  858. end;
  859. with TNumberRange (TNumberRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  860. RStart := I - Length (CurWord);
  861. REnd := I - 1;
  862. Number := Text;
  863. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  864. LastStart := I;
  865. end;
  866. end else begin
  867. WordStyle := SyntaxColoring.WordLists.FindList (CurWord);
  868. if Assigned (WordStyle) then begin
  869. if I - Length (CurWord) > LastStart then
  870. with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  871. RStart := LastStart;
  872. REnd := I - Length (CurWord) - 1;
  873. if RLength > 0 then
  874. EndingsEqual := ReplaceSyntaxRanges (LastRange)
  875. else
  876. Free;
  877. end;
  878. with TWordListRange (TWordListRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  879. RStart := I - Length (CurWord);
  880. REnd := I - 1;
  881. WordList := WordStyle;
  882. EndingsEqual := ReplaceSyntaxRanges (LastRange);
  883. LastStart := I;
  884. end;
  885. end;
  886. end;
  887. CurWord := '';
  888. end;
  889. if (I >= SectionStart + SectionLength) and (I > LastStart) then
  890. with TNormalTextRange (TNormalTextRange.NewRangeInsertedBefore (LastRange, Self)) do begin
  891. RStart := LastStart;
  892. REnd := I - 1;
  893. LastStart := I;
  894. if RLength > 0 then
  895. EndingsEqual := ReplaceSyntaxRanges (LastRange)
  896. else
  897. Free;
  898. end;
  899. end;
  900. end;
  901. end;
  902. end;
  903. end;
  904. end;
  905. end;
  906. procedure SetSectionType(NewType: TSectionType);
  907. begin
  908. if SplitOnFly and (NewType = stSymbol) and (SectionLength <= MaxOnFlySectionLength) then
  909. NewType := stText;
  910. if (NewType <> SectionType) or (NewType = stParenthesis) or (NewType = stCustomStyle) then begin
  911. if SplitOnFly and (NewType = stSymbol) then
  912. NewType := stText;
  913. ProcessSection;
  914. SectionStart := CurPos;
  915. SectionLength := 0;
  916. WordStart := CurPos;
  917. SectionType := NewType;
  918. end;
  919. end;
  920. function LeadingTextOnlyHasBlanks: Boolean;
  921. var
  922. I: Integer;
  923. begin
  924. Result := True;
  925. I := CurPos - 1;
  926. while I >= 1 do begin
  927. if Text [I] in [#10, #13] then
  928. Break;
  929. if not (Text [I] in [#9, ' ']) then begin
  930. Result := False;
  931. Break;
  932. end;
  933. Dec (I);
  934. end;
  935. end;
  936. var
  937. I,
  938. L,
  939. P1,
  940. P2,
  941. BeginPos: Integer;
  942. B: Boolean;
  943. S,
  944. T: string;
  945. begin
  946. if SyntaxColoring.FUpdateDebth = 0 then begin
  947. if SyntaxColoring.Enabled and (TextLength > 0) then begin
  948. Inc (SyntaxColoring.FUpdateDebth);
  949. LastRange := SyntaxRangeAtPos (Range.RStart - 1);
  950. if Assigned (LastRange) then begin
  951. if Assigned (LastRange.PrevRange) and (LastRange.PrevRange is TCustomStyleRange) and Assigned ((LastRange.PrevRange as TCustomStyleRange).Style) and (LastRange.PrevRange as TCustomStyleRange).Style.Switchable then
  952. LastRange := LastRange.PrevRange;
  953. if Range.RStart > LastRange.RStart then
  954. Range.RStart := LastRange.RStart;
  955. end else
  956. Range.RStart := 1;
  957. CurPos := Range.RStart;
  958. SectionStart := CurPos;
  959. SectionLength := 0;
  960. WordStart := CurPos;
  961. SectionType := stText;
  962. CustomStyle := nil;
  963. EndingsEqual := False;
  964. KeepRunning := False;
  965. while (CurPos <= TextLength) and ((CurPos <= Range.REnd + 2) or (not EndingsEqual) or KeepRunning) do begin
  966. EndingsEqual := False;
  967. CurChar := Text [CurPos];
  968. NewCustomStyle := SyntaxColoring.CustomStyles.FindStyle (Copy (Text, CurPos, MaxBeginEndTextLength));
  969. 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
  970. NewCustomStyle := nil;
  971. if Assigned (NewCustomStyle) and ((SectionType = stCustomStyle) and Assigned (CustomStyle) and (((NewCustomStyle = CustomStyle) and CustomStyle.Switchable) or (NewCustomStyle.EndText <> CustomStyle.EndText))) then
  972. NewCustomStyle := nil;
  973. KeepRunning := (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable and (not Assigned (NewCustomStyle));
  974. if KeepRunning then begin
  975. T := CustomStyle.EndText;
  976. S := Copy (Text, CurPos, Length (T));
  977. if (S = T) or ((T = ' ') and ((S = #9) or (S = #13))) then begin
  978. KeepRunning := False;
  979. I := CurPos - 1;
  980. while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
  981. KeepRunning := not KeepRunning;
  982. if Text [I] = CustomStyle.IgnoreChar then
  983. Dec (I)
  984. else
  985. Dec (I, 3);
  986. end;
  987. end;
  988. end;
  989. if not KeepRunning then begin
  990. if Assigned (NewCustomStyle) then begin
  991. SetSectionType (stCustomStyle);
  992. CustomStyle := NewCustomStyle;
  993. if CustomStyle.Switchable then begin
  994. KeepRunning := True;
  995. Inc (SectionLength);
  996. Inc (CurPos);
  997. end else begin
  998. repeat
  999. S := CustomStyle.EndText;
  1000. BeginPos := CurPos + Length (CustomStyle.BeginText);
  1001. repeat
  1002. T := Copy (Text, BeginPos, CustomStyleCheckLength);
  1003. P1 := Pos (S, T);
  1004. if S = ' ' then begin
  1005. P2 := Pos (#9, T);
  1006. if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then
  1007. P1 := P2;
  1008. P2 := Pos (#13, T);
  1009. if (P2 > 0) and ((P1 <= 0) or (P2 < P1)) then begin
  1010. P1 := P2;
  1011. S := #13;
  1012. end;
  1013. end;
  1014. if P1 <= 0 then
  1015. Inc (BeginPos, CustomStyleCheckLength - MaxBeginEndTextLength);
  1016. until (P1 > 0) or (BeginPos > TextLength);
  1017. CurPos := BeginPos + P1 + Length (S) - 2;
  1018. B := (P1 <= 0) or (CurPos <= Length (S));
  1019. if not B then begin
  1020. B := True;
  1021. I := CurPos - Length (S);
  1022. while (I >= 1) and ((Text [I] = CustomStyle.IgnoreChar) or ((CustomStyle.IgnoreChar = '\') and (Copy (Text, I - 2, 3) = '??/'))) do begin
  1023. B := not B;
  1024. if Text [I] = CustomStyle.IgnoreChar then
  1025. Dec (I)
  1026. else
  1027. Dec (I, 3);
  1028. end;
  1029. end;
  1030. until B;
  1031. if S = #13 then
  1032. Inc (CurPos);
  1033. if (P1 <= 0) or (CurPos <= Length (S)) or (CurPos > TextLength) then
  1034. CurPos := TextLength;
  1035. Inc (CurPos);
  1036. SectionLength := CurPos - SectionStart;
  1037. SetSectionType (stText);
  1038. end;
  1039. Continue;
  1040. end else if (SectionType = stCustomStyle) and Assigned (CustomStyle) and CustomStyle.Switchable then begin
  1041. if CustomStyle.EndText = #13 then
  1042. L := 2
  1043. else
  1044. L := Length (CustomStyle.EndText);
  1045. Inc (SectionLength, L);
  1046. Inc (CurPos, L);
  1047. SetSectionType (stText);
  1048. Continue;
  1049. end;
  1050. if CharIsParenthesis (CurChar) then
  1051. SetSectionType (stParenthesis)
  1052. else if CurChar = '.' then begin
  1053. if ((SectionType = stText) and CharIsNumber (Text [WordStart])) or ((CurPos + 1 <= TextLength) and CharIsNumber (Text [CurPos + 1])) then
  1054. SetSectionType (stText)
  1055. else
  1056. SetSectionType (stSymbol);
  1057. end else if CurChar in ['+', '-'] then begin
  1058. if not ((CurPos - 2 >= 1) and CharIsExtNumber (Text [CurPos - 2]) and (CurPos - 1 >= 1) and (Text [CurPos - 1] in ['e', 'E', 'p', 'P'])) then
  1059. SetSectionType (stSymbol);
  1060. end else if CharIsSymbol (CurChar) then
  1061. SetSectionType (stSymbol)
  1062. else begin
  1063. SetSectionType (stText);
  1064. if not CharIsIdentifier (CurChar) then
  1065. WordStart := CurPos;
  1066. end;
  1067. end;
  1068. Inc (SectionLength);
  1069. Inc (CurPos);
  1070. end;
  1071. Range.REnd := CurPos - 1;
  1072. if CurPos > TextLength then
  1073. ProcessSection;
  1074. LastPRange := SyntaxRangeAtPosWithHint (Range.RStart, LastRange);
  1075. Dec (SyntaxColoring.FUpdateDebth);
  1076. end else
  1077. FreeAllSyntaxRanges;
  1078. end;
  1079. {$IFDEF SyntaxDebug}
  1080. if FindSyntaxHole <> nil then
  1081. raise ESourceEdit.Create (SSourceEditError);
  1082. {$ENDIF}
  1083. end;
  1084. procedure TSourceEdit.RemoveTrSpFromString(var Str: string;
  1085. IncludeLastLine: Boolean);
  1086. var
  1087. I: Integer;
  1088. OK: Boolean;
  1089. begin
  1090. if AutoIndentIncrease then begin
  1091. OK := False;
  1092. for I := 1 to Length (Str) do
  1093. if not (Str [I] in [#13, #10, ' ', #9, AutoIndentIncreaseStart, AutoIndentIncreaseEnd]) then begin
  1094. OK := True;
  1095. break;
  1096. end;
  1097. end else
  1098. OK := True;
  1099. if OK then
  1100. inherited;
  1101. end;
  1102. function TSourceEdit.ReplaceSyntaxRanges(NewRange: TSyntaxRange;
  1103. var StartRange: TSyntaxRange): Boolean;
  1104. var
  1105. PrevRange: TSyntaxRange;
  1106. begin
  1107. Result := False;
  1108. if not Assigned (StartRange) then
  1109. StartRange := LastSyntaxRange;
  1110. while Assigned (StartRange) and ((StartRange.RStart > NewRange.RStart) or (StartRange = NewRange)) do
  1111. StartRange := StartRange.PrevRange;
  1112. if not Assigned (StartRange) then
  1113. StartRange := FirstSyntaxRange;
  1114. while Assigned (StartRange) and ((StartRange.RStart < NewRange.RStart) or (StartRange = NewRange)) do
  1115. StartRange := StartRange.NextRange;
  1116. if (not Assigned (StartRange)) and (LastSyntaxRange <> NewRange) then
  1117. StartRange := LastSyntaxRange;
  1118. while Assigned (StartRange) and (StartRange <> NewRange) and ((StartRange.RStart <= NewRange.REnd) or (StartRange.REnd <= NewRange.REnd)) do begin
  1119. Result := StartRange.EqualEndingsWith (NewRange);
  1120. PrevRange := StartRange;
  1121. StartRange := StartRange.NextRange;
  1122. PrevRange.Free;
  1123. end;
  1124. {$IFDEF SyntaxDebug}
  1125. if FindSyntaxOverlap <> nil then
  1126. raise ESourceEdit.Create (SSourceEditError);
  1127. {$ENDIF}
  1128. end;
  1129. procedure TSourceEdit.SetSplitOnFly(const Value: Boolean);
  1130. begin
  1131. if FSplitOnFly <> Value then begin
  1132. FSplitOnFly := Value;
  1133. ReColor;
  1134. end;
  1135. end;
  1136. procedure TSourceEdit.SetSyntaxColoring(const Value: TSyntaxColoring);
  1137. begin
  1138. FSyntaxColoring.Assign (Value);
  1139. end;
  1140. function TSourceEdit.SyntaxRangeAtPos(RangePos: Integer): TSyntaxRange;
  1141. begin
  1142. Result := FirstSyntaxRange;
  1143. while Assigned (Result) and (Result.REnd < RangePos) do
  1144. Result := Result.NextRange;
  1145. end;
  1146. function TSourceEdit.SyntaxRangeAtPosWithHint(RangePos: Integer;
  1147. Hint: TSyntaxRange): TSyntaxRange;
  1148. begin
  1149. if Assigned (Hint) then begin
  1150. Result := Hint;
  1151. while Assigned (Result) and (Result.REnd >= RangePos) do
  1152. Result := Result.PrevRange;
  1153. if not Assigned (Result) then
  1154. Result := FirstSyntaxRange;
  1155. end else
  1156. Result := FirstSyntaxRange;
  1157. while Assigned (Result) and (Result.REnd < RangePos) do
  1158. Result := Result.NextRange;
  1159. end;
  1160. procedure TSourceEdit.TextChangeNotification(StartPos, OldLength,
  1161. NewLength: Integer);
  1162. begin
  1163. inherited;
  1164. LastPRange := nil;
  1165. LastCRange := TMCRange.Create (nil);
  1166. with LastCRange do begin
  1167. Editor := Self;
  1168. RStart := StartPos;
  1169. RLength := NewLength;
  1170. ReColorRange (LastCRange);
  1171. end;
  1172. end;
  1173. procedure TSourceEdit.TextChangeNotificationAfter;
  1174. begin
  1175. inherited;
  1176. if Assigned (LastCRange) then begin
  1177. while Assigned (LastPRange) do begin
  1178. if LastPRange.REnd <= LastCRange.REnd then
  1179. LastPRange.SetNewParenthesisLevel
  1180. else
  1181. LastPRange.UpdateParenthesisLevel;
  1182. LastPRange := LastPRange.NextRange;
  1183. end;
  1184. LastCRange.DrawRange;
  1185. LastCRange.Free;
  1186. LastCRange := nil;
  1187. end;
  1188. end;
  1189. procedure TSourceEdit.WMKeyDown(var Message: TWMKeyDown);
  1190. var
  1191. Shift: TShiftState;
  1192. begin
  1193. if Message.CharCode = vk_Tab then begin
  1194. Shift := KeyDataToShiftState (Message.KeyData);
  1195. if ssShift in Shift then
  1196. ChangeIndent (-1)
  1197. else if (Selection.RLength > 0) and (Selection.EndRowCol.Row > Selection.StartRowCol.Row) then
  1198. ChangeIndent (1)
  1199. else
  1200. inherited;
  1201. end else
  1202. inherited;
  1203. end;
  1204. { TSyntaxColoring }
  1205. procedure TSyntaxColoring.Assign(Source: TPersistent);
  1206. begin
  1207. if Source is TSyntaxColoring then begin
  1208. BeginUpdate;
  1209. FEnabled := TSyntaxColoring(Source).Enabled;
  1210. FSymbolColor := TSyntaxColoring(Source).SymbolColor;
  1211. FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
  1212. FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
  1213. FNumberColor := TSyntaxColoring(Source).NumberColor;
  1214. FNumberStyle := TSyntaxColoring(Source).NumberStyle;
  1215. FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
  1216. FWordLists.Assign (TSyntaxColoring(Source).WordLists);
  1217. FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
  1218. FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
  1219. FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
  1220. FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
  1221. EndUpdate;
  1222. end else if Source is TSyntaxColoringCopy then begin
  1223. BeginUpdate;
  1224. FEnabled := TSyntaxColoringCopy(Source).Enabled;
  1225. FSymbolColor := TSyntaxColoringCopy(Source).SymbolColor;
  1226. FSymbolStyle := TSyntaxColoringCopy(Source).SymbolStyle;
  1227. FSymbolCustomStyle := TSyntaxColoringCopy(Source).SymbolCustomStyle;
  1228. FNumberColor := TSyntaxColoringCopy(Source).NumberColor;
  1229. FNumberStyle := TSyntaxColoringCopy(Source).NumberStyle;
  1230. FNumberCustomStyle := TSyntaxColoringCopy(Source).NumberCustomStyle;
  1231. FWordLists.Assign (TSyntaxColoringCopy(Source).WordLists);
  1232. FCustomStyles.Assign (TSyntaxColoringCopy(Source).CustomStyles);
  1233. FParenthesisColors.Assign (TSyntaxColoringCopy(Source).ParenthesisColors);
  1234. FParenthesisStyle := TSyntaxColoringCopy(Source).ParenthesisStyle;
  1235. FParenthesisCustomStyle := TSyntaxColoringCopy(Source).ParenthesisCustomStyle;
  1236. EndUpdate;
  1237. end else
  1238. inherited Assign (Source);
  1239. end;
  1240. procedure TSyntaxColoring.BeginUpdate;
  1241. begin
  1242. Inc (FUpdateDebth);
  1243. end;
  1244. procedure TSyntaxColoring.ChangeNotification(Sender: TObject);
  1245. begin
  1246. ColoringChange;
  1247. end;
  1248. procedure TSyntaxColoring.ColoringChange;
  1249. var
  1250. I: Integer;
  1251. begin
  1252. if FUpdateDebth = 0 then
  1253. if Assigned (Owner) then
  1254. if Owner is TSourceEdit then
  1255. with Owner as TSourceEdit do begin
  1256. with SymbolFont do begin
  1257. Assign (Font);
  1258. Color := SymbolColor;
  1259. if SymbolCustomStyle then
  1260. Style := SymbolStyle;
  1261. end;
  1262. with NumberFont do begin
  1263. Assign (Font);
  1264. Color := NumberColor;
  1265. if NumberCustomStyle then
  1266. Style := NumberStyle;
  1267. end;
  1268. with ParenthesisFont do begin
  1269. Assign (Font);
  1270. Color := GetParenthesisColor (0);
  1271. if ParenthesisCustomStyle then
  1272. Style := ParenthesisStyle;
  1273. end;
  1274. with WordLists do
  1275. for I := 0 to Count - 1 do
  1276. with Items[I].Font do begin
  1277. Assign (Font);
  1278. if Items[I].CustomColor then
  1279. Color := Items[I].Color;
  1280. if Items[I].CustomStyle then
  1281. Style := Items[I].Style;
  1282. end;
  1283. with CustomStyles do
  1284. for I := 0 to Count - 1 do
  1285. with Items[I].Font do begin
  1286. Assign (Font);
  1287. if Items[I].CustomColor then
  1288. Color := Items[I].Color;
  1289. if Items[I].CustomStyle then
  1290. Style := Items[I].Style;
  1291. end;
  1292. ReColor;
  1293. end;
  1294. end;
  1295. constructor TSyntaxColoring.Create(AOwner: TPersistent);
  1296. begin
  1297. inherited;
  1298. SymbolFont := TFont.Create;
  1299. NumberFont := TFont.Create;
  1300. ParenthesisFont := TFont.Create;
  1301. FWordLists := TWordLists.Create (Self);
  1302. FCustomStyles := TCustomStyles.Create (Self);
  1303. FParenthesisColors := TStringList.Create;
  1304. FParenthesisColors.Duplicates := dupAccept;
  1305. FParenthesisColors.Add ('$000000');
  1306. FParenthesisColors.OnChange := ChangeNotification;
  1307. FNumberColor := clGreen;
  1308. FSymbolColor := clOlive;
  1309. FEnabled := True;
  1310. end;
  1311. destructor TSyntaxColoring.Destroy;
  1312. begin
  1313. FParenthesisColors.Free;
  1314. FCustomStyles.Free;
  1315. FWordLists.Free;
  1316. NumberFont.Free;
  1317. SymbolFont.Free;
  1318. ParenthesisFont.Free;
  1319. inherited;
  1320. end;
  1321. procedure TSyntaxColoring.EndUpdate;
  1322. begin
  1323. Dec (FUpdateDebth);
  1324. if FUpdateDebth = 0 then
  1325. ColoringChange;
  1326. end;
  1327. function TSyntaxColoring.GetParenthesisColor(Index: Integer): TColor;
  1328. begin
  1329. with ParenthesisColors do
  1330. if (Count <= 0) or (Index < 0) then
  1331. Result := clWindowText
  1332. else
  1333. try
  1334. Result := StrToInt (Strings [Index mod Count]);
  1335. except
  1336. Result := clWindowText;
  1337. end;
  1338. end;
  1339. procedure TSyntaxColoring.SetCustomStyles(const Value: TCustomStyles);
  1340. begin
  1341. FCustomStyles.Assign (Value);
  1342. ColoringChange;
  1343. end;
  1344. procedure TSyntaxColoring.SetEnabled(const Value: Boolean);
  1345. begin
  1346. if FEnabled <> Value then begin
  1347. FEnabled := Value;
  1348. ColoringChange;
  1349. end;
  1350. end;
  1351. procedure TSyntaxColoring.SetNumberColor(const Value: TColor);
  1352. begin
  1353. if FNumberColor <> Value then begin
  1354. FNumberColor := Value;
  1355. ColoringChange;
  1356. end;
  1357. end;
  1358. procedure TSyntaxColoring.SetNumberCustomStyle(const Value: Boolean);
  1359. begin
  1360. if FNumberCustomStyle <> Value then begin
  1361. FNumberCustomStyle := Value;
  1362. ColoringChange;
  1363. end;
  1364. end;
  1365. procedure TSyntaxColoring.SetNumberStyle(const Value: TFontStyles);
  1366. begin
  1367. if FNumberStyle <> Value then begin
  1368. FNumberStyle := Value;
  1369. ColoringChange;
  1370. end;
  1371. end;
  1372. procedure TSyntaxColoring.SetParenthesisColors(const Value: TStringList);
  1373. begin
  1374. FParenthesisColors.Assign (Value);
  1375. end;
  1376. procedure TSyntaxColoring.SetParenthesisCustomStyle(const Value: Boolean);
  1377. begin
  1378. if FParenthesisCustomStyle <> Value then begin
  1379. FParenthesisCustomStyle := Value;
  1380. ColoringChange;
  1381. end;
  1382. end;
  1383. procedure TSyntaxColoring.SetParenthesisStyle(const Value: TFontStyles);
  1384. begin
  1385. if FParenthesisStyle <> Value then begin
  1386. FParenthesisStyle := Value;
  1387. ColoringChange;
  1388. end;
  1389. end;
  1390. procedure TSyntaxColoring.SetSymbolColor(const Value: TColor);
  1391. begin
  1392. if FSymbolColor <> Value then begin
  1393. FSymbolColor := Value;
  1394. ColoringChange;
  1395. end;
  1396. end;
  1397. procedure TSyntaxColoring.SetSymbolCustomStyle(const Value: Boolean);
  1398. begin
  1399. if FSymbolCustomStyle <> Value then begin
  1400. FSymbolCustomStyle := Value;
  1401. ColoringChange;
  1402. end;
  1403. end;
  1404. procedure TSyntaxColoring.SetSymbolStyle(const Value: TFontStyles);
  1405. begin
  1406. if FSymbolStyle <> Value then begin
  1407. FSymbolStyle := Value;
  1408. ColoringChange;
  1409. end;
  1410. end;
  1411. procedure TSyntaxColoring.SetWordLists(const Value: TWordLists);
  1412. begin
  1413. FWordLists.Assign (Value);
  1414. ColoringChange;
  1415. end;
  1416. { TWordLists }
  1417. function TWordLists.Add: TWordList;
  1418. begin
  1419. Result := TWordList (inherited Add);
  1420. end;
  1421. constructor TWordLists.Create(AColoring: TSyntaxColoring);
  1422. begin
  1423. inherited Create (TWordList);
  1424. FColoring := AColoring;
  1425. end;
  1426. function TWordLists.FindList(const S: string): TWordList;
  1427. var
  1428. I: Integer;
  1429. begin
  1430. Result := nil;
  1431. for I := 0 to Count - 1 do
  1432. if Items[I].WordInList (S) then begin
  1433. Result := Items [I];
  1434. Break;
  1435. end;
  1436. end;
  1437. function TWordLists.GetItem(Index: Integer): TWordList;
  1438. begin
  1439. Result := TWordList (inherited GetItem (Index));
  1440. end;
  1441. function TWordLists.GetOwner: TPersistent;
  1442. begin
  1443. Result := FColoring;
  1444. end;
  1445. procedure TWordLists.SetItem(Index: Integer; Value: TWordList);
  1446. begin
  1447. inherited SetItem (Index, Value);
  1448. end;
  1449. procedure TWordLists.Update(Item: TCollectionItem);
  1450. begin
  1451. if Assigned (Item) then
  1452. TWordList(Item).ListChange
  1453. else
  1454. if Assigned (FColoring) then
  1455. FColoring.ColoringChange;
  1456. end;
  1457. { TWordList }
  1458. procedure TWordList.Assign(Source: TPersistent);
  1459. begin
  1460. if Source is TWordList then begin
  1461. Caption := TWordList(Source).Caption;
  1462. FCustomColor := TWordList(Source).CustomColor;
  1463. FColor := TWordList(Source).Color;
  1464. FCustomStyle := TWordList(Source).CustomStyle;
  1465. FStyle := TWordList(Source).Style;
  1466. FCaseSensitive := TWordList(Source).CaseSensitive;
  1467. FWords.Assign (TWordList(Source).Words);
  1468. ListChange;
  1469. end else
  1470. inherited Assign (Source);
  1471. end;
  1472. procedure TWordList.ChangeNotification(Sender: TObject);
  1473. begin
  1474. ListChange;
  1475. end;
  1476. constructor TWordList.Create(Collection: TCollection);
  1477. begin
  1478. inherited;
  1479. Font := TFont.Create;
  1480. FWords := TStringList.Create;
  1481. FWords.Sorted := True;
  1482. FWords.Duplicates := dupAccept;
  1483. FWords.OnChange := ChangeNotification;
  1484. FColor := clBlue;
  1485. FCustomColor := True;
  1486. FCaseSensitive := True;
  1487. end;
  1488. destructor TWordList.Destroy;
  1489. begin
  1490. FWords.Free;
  1491. Font.Free;
  1492. inherited;
  1493. end;
  1494. function TWordList.GetDisplayName: string;
  1495. begin
  1496. if FDisplayName = '' then
  1497. Result := inherited GetDisplayName
  1498. else
  1499. Result := FDisplayName;
  1500. end;
  1501. procedure TWordList.ListChange;
  1502. begin
  1503. if Assigned (Collection) then
  1504. with TWordLists (Collection) do
  1505. if Assigned (FColoring) then
  1506. FColoring.ColoringChange;
  1507. end;
  1508. procedure TWordList.SetCaseSensitive(const Value: Boolean);
  1509. begin
  1510. if FCaseSensitive <> Value then begin
  1511. FCaseSensitive := Value;
  1512. ListChange;
  1513. end;
  1514. end;
  1515. procedure TWordList.SetColor(const Value: TColor);
  1516. begin
  1517. if FColor <> Value then begin
  1518. FColor := Value;
  1519. ListChange;
  1520. end;
  1521. end;
  1522. procedure TWordList.SetCustomColor(const Value: Boolean);
  1523. begin
  1524. if FCustomColor <> Value then begin
  1525. FCustomColor := Value;
  1526. ListChange;
  1527. end;
  1528. end;
  1529. procedure TWordList.SetCustomStyle(const Value: Boolean);
  1530. begin
  1531. if FCustomStyle <> Value then begin
  1532. FCustomStyle := Value;
  1533. ListChange;
  1534. end;
  1535. end;
  1536. procedure TWordList.SetDisplayName(const Value: string);
  1537. begin
  1538. if FDisplayName <> Value then begin
  1539. FDisplayName := Value;
  1540. inherited;
  1541. end;
  1542. end;
  1543. procedure TWordList.SetStyle(const Value: TFontStyles);
  1544. begin
  1545. if FStyle <> Value then begin
  1546. FStyle := Value;
  1547. ListChange;
  1548. end;
  1549. end;
  1550. procedure TWordList.SetWords(const Value: TStringList);
  1551. begin
  1552. FWords.Assign (Value);
  1553. ListChange;
  1554. end;
  1555. function TWordList.WordInList(S: string): Boolean;
  1556. var
  1557. I: Integer;
  1558. begin
  1559. if CaseSensitive then
  1560. Result := Words.Find (S, I) and (I >= 0) and (I < Words.Count) and (S = Words.Strings [I])
  1561. else
  1562. Result := Words.Find (S, I) or ((I >= 0) and (I < Words.Count) and (UpperCase (S) = UpperCase (Words.Strings [I])));
  1563. end;
  1564. { TCustomStyles }
  1565. function TCustomStyles.Add: TCustomStyle;
  1566. begin
  1567. Result := TCustomStyle (inherited Add);
  1568. end;
  1569. constructor TCustomStyles.Create(AColoring: TSyntaxColoring);
  1570. begin
  1571. inherited Create (TCustomStyle);
  1572. FColoring := AColoring;
  1573. end;
  1574. function TCustomStyles.FindStyle(const S: string): TCustomStyle;
  1575. var
  1576. I: Integer;
  1577. begin
  1578. Result := nil;
  1579. if S <> '' then
  1580. for I := 0 to Count - 1 do
  1581. if Items[I].BeginText = Copy (S, 1, Length (Items[I].BeginText)) then begin
  1582. Result := Items [I];
  1583. Break;
  1584. end;
  1585. end;
  1586. function TCustomStyles.GetItem(Index: Integer): TCustomStyle;
  1587. begin
  1588. Result := TCustomStyle (inherited GetItem (Index));
  1589. end;
  1590. function TCustomStyles.GetOwner: TPersistent;
  1591. begin
  1592. Result := FColoring;
  1593. end;
  1594. procedure TCustomStyles.SetItem(Index: Integer; Value: TCustomStyle);
  1595. begin
  1596. inherited SetItem (Index, Value);
  1597. end;
  1598. procedure TCustomStyles.Update(Item: TCollectionItem);
  1599. begin
  1600. if Assigned (FColoring) then
  1601. FColoring.ColoringChange;
  1602. end;
  1603. { TCustomStyle }
  1604. procedure TCustomStyle.Assign(Source: TPersistent);
  1605. begin
  1606. if Source is TCustomStyle then begin
  1607. Caption := TCustomStyle(Source).Caption;
  1608. FCustomColor := TCustomStyle(Source).CustomColor;
  1609. FColor := TCustomStyle(Source).Color;
  1610. FCustomStyle := TCustomStyle(Source).CustomStyle;
  1611. FStyle := TCustomStyle(Source).Style;
  1612. FBeginText := TCustomStyle(Source).BeginText;
  1613. FEndText := TCustomStyle(Source).EndText;
  1614. FIgnoreChar := TCustomStyle(Source).IgnoreChar;
  1615. FSwitchable := TCustomStyle(Source).Switchable;
  1616. FLineStartOnly := TCustomStyle(Source).LineStartOnly;
  1617. FIgnoreLeadingBlanks := TCustomStyle(Source).IgnoreLeadingBlanks;
  1618. StyleChange;
  1619. end else
  1620. inherited Assign (Source);
  1621. end;
  1622. constructor TCustomStyle.Create(Collection: TCollection);
  1623. begin
  1624. inherited;
  1625. Font := TFont.Create;
  1626. FColor := clMaroon;
  1627. FCustomColor := True;
  1628. end;
  1629. destructor TCustomStyle.Destroy;
  1630. begin
  1631. Font.Free;
  1632. inherited;
  1633. end;
  1634. function TCustomStyle.GetDisplayName: string;
  1635. begin
  1636. if FDisplayName = '' then
  1637. Result := inherited GetDisplayName
  1638. else
  1639. Result := FDisplayName;
  1640. end;
  1641. procedure TCustomStyle.SetBeginText(Value: string);
  1642. begin
  1643. if Value = '#13' then
  1644. Value := #13;
  1645. if FBeginText <> Value then begin
  1646. FBeginText := Value;
  1647. StyleChange;
  1648. end;
  1649. end;
  1650. procedure TCustomStyle.SetColor(const Value: TColor);
  1651. begin
  1652. if FColor <> Value then begin
  1653. FColor := Value;
  1654. StyleChange;
  1655. end;
  1656. end;
  1657. procedure TCustomStyle.SetCustomColor(const Value: Boolean);
  1658. begin
  1659. if FCustomColor <> Value then begin
  1660. FCustomColor := Value;
  1661. StyleChange;
  1662. end;
  1663. end;
  1664. procedure TCustomStyle.SetCustomStyle(const Value: Boolean);
  1665. begin
  1666. if FCustomStyle <> Value then begin
  1667. FCustomStyle := Value;
  1668. StyleChange;
  1669. end;
  1670. end;
  1671. procedure TCustomStyle.SetDisplayName(const Value: string);
  1672. begin
  1673. FDisplayName := Value;
  1674. end;
  1675. procedure TCustomStyle.SetEndText(Value: string);
  1676. begin
  1677. if Value = '#13' then
  1678. Value := #13;
  1679. if FEndText <> Value then begin
  1680. FEndText := Value;
  1681. StyleChange;
  1682. end;
  1683. end;
  1684. procedure TCustomStyle.SetIgnoreChar(const Value: TIgnoreChar);
  1685. begin
  1686. if FIgnoreChar <> Value then begin
  1687. FIgnoreChar := Value;
  1688. StyleChange;
  1689. end;
  1690. end;
  1691. procedure TCustomStyle.SetIgnoreLeadingBlanks(const Value: Boolean);
  1692. begin
  1693. if FIgnoreLeadingBlanks <> Value then begin
  1694. FIgnoreLeadingBlanks := Value;
  1695. StyleChange;
  1696. end;
  1697. end;
  1698. procedure TCustomStyle.SetLineStartOnly(const Value: Boolean);
  1699. begin
  1700. if FLineStartOnly <> Value then begin
  1701. FLineStartOnly := Value;
  1702. StyleChange;
  1703. end;
  1704. end;
  1705. procedure TCustomStyle.SetStyle(const Value: TFontStyles);
  1706. begin
  1707. if FStyle <> Value then begin
  1708. FStyle := Value;
  1709. StyleChange;
  1710. end;
  1711. end;
  1712. procedure TCustomStyle.SetSwitchable(const Value: Boolean);
  1713. begin
  1714. if FSwitchable <> Value then begin
  1715. FSwitchable := Value;
  1716. StyleChange;
  1717. end;
  1718. end;
  1719. procedure TCustomStyle.StyleChange;
  1720. begin
  1721. if Assigned (Collection) then
  1722. with TCustomStyles (Collection) do
  1723. if Assigned (FColoring) then
  1724. FColoring.ColoringChange;
  1725. end;
  1726. { TSyntaxColoringCopy }
  1727. procedure TSyntaxColoringCopy.Assign(Source: TPersistent);
  1728. begin
  1729. if Source is TSyntaxColoring then begin
  1730. FEnabled := TSyntaxColoring(Source).Enabled;
  1731. FSymbolColor := TSyntaxColoring(Source).SymbolColor;
  1732. FSymbolStyle := TSyntaxColoring(Source).SymbolStyle;
  1733. FSymbolCustomStyle := TSyntaxColoring(Source).SymbolCustomStyle;
  1734. FNumberColor := TSyntaxColoring(Source).NumberColor;
  1735. FNumberStyle := TSyntaxColoring(Source).NumberStyle;
  1736. FNumberCustomStyle := TSyntaxColoring(Source).NumberCustomStyle;
  1737. FWordLists.Assign (TSyntaxColoring(Source).WordLists);
  1738. FCustomStyles.Assign (TSyntaxColoring(Source).CustomStyles);
  1739. FParenthesisColors.Assign (TSyntaxColoring(Source).ParenthesisColors);
  1740. FParenthesisStyle := TSyntaxColoring(Source).ParenthesisStyle;
  1741. FParenthesisCustomStyle := TSyntaxColoring(Source).ParenthesisCustomStyle;
  1742. end else
  1743. inherited Assign (Source);
  1744. end;
  1745. constructor TSyntaxColoringCopy.Create(AOwner: TComponent);
  1746. begin
  1747. inherited;
  1748. FWordLists := TWordLists.Create (nil);
  1749. FCustomStyles := TCustomStyles.Create (nil);
  1750. FParenthesisColors := TStringList.Create;
  1751. FParenthesisColors.Duplicates := dupAccept;
  1752. FParenthesisColors.Add ('$000000');
  1753. FNumberColor := clGreen;
  1754. FSymbolColor := clOlive;
  1755. FEnabled := True;
  1756. end;
  1757. destructor TSyntaxColoringCopy.Destroy;
  1758. begin
  1759. FParenthesisColors.Free;
  1760. FCustomStyles.Free;
  1761. FWordLists.Free;
  1762. inherited;
  1763. end;
  1764. procedure TSyntaxColoringCopy.SetCustomStyles(const Value: TCustomStyles);
  1765. begin
  1766. FCustomStyles.Assign (Value);
  1767. end;
  1768. procedure TSyntaxColoringCopy.SetParenthesisColors(
  1769. const Value: TStringList);
  1770. begin
  1771. FParenthesisColors.Assign (Value);
  1772. end;
  1773. procedure TSyntaxColoringCopy.SetWordLists(const Value: TWordLists);
  1774. begin
  1775. FWordLists.Assign (Value);
  1776. end;
  1777. { TSyntaxRange }
  1778. destructor TSyntaxRange.Destroy;
  1779. begin
  1780. if Assigned (Collection) and (not (Collection as TMCRanges).FDestroying) then begin
  1781. if Assigned (Editor) and ((Editor as TSourceEdit).SyntaxStartRange = Self) then
  1782. (Editor as TSourceEdit).SyntaxStartRange := nil;
  1783. if Assigned (PrevRange) then
  1784. PrevRange.NextRange := NextRange
  1785. else if Assigned (Editor) then
  1786. (Editor as TSourceEdit).FirstSyntaxRange := NextRange;
  1787. if Assigned (NextRange) then
  1788. NextRange.PrevRange := PrevRange
  1789. else if Assigned (Editor) then
  1790. (Editor as TSourceEdit).LastSyntaxRange := PrevRange;
  1791. end;
  1792. inherited;
  1793. end;
  1794. class function TSyntaxRange.EqualEndings(Range1,
  1795. Range2: TSyntaxRange): Boolean;
  1796. begin
  1797. Result := Assigned (Range1) and Assigned (Range2) and Range1.EqualEndingsWith (Range2);
  1798. end;
  1799. function TSyntaxRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1800. begin
  1801. Result := REnd = Range.REnd;
  1802. end;
  1803. function TSyntaxRange.GetColor: TColor;
  1804. begin
  1805. if Assigned (Editor) then
  1806. Result := Editor.Color
  1807. else
  1808. Result := clWindow;
  1809. end;
  1810. function TSyntaxRange.GetNextParenthesisLevel: Integer;
  1811. begin
  1812. Result := ParenthesisLevel;
  1813. end;
  1814. function TSyntaxRange.InsertAfter(RangeClass: TSyntaxRangeClass):
  1815. TSyntaxRange;
  1816. begin
  1817. Result := InsertRangeBefore (NextRange, RangeClass, Editor as TSourceEdit);
  1818. end;
  1819. function TSyntaxRange.InsertBefore(RangeClass: TSyntaxRangeClass):
  1820. TSyntaxRange;
  1821. begin
  1822. Result := InsertRangeBefore (Self, RangeClass, Editor as TSourceEdit);
  1823. end;
  1824. class function TSyntaxRange.InsertRangeBefore(Range: TSyntaxRange;
  1825. RangeClass: TSyntaxRangeClass; Editor: TSourceEdit): TSyntaxRange;
  1826. // If Range is nil, new item is inserted at the end.
  1827. begin
  1828. if Assigned (Editor) then begin
  1829. Result := RangeClass.Create (Editor.TrackedRanges);
  1830. Result.OnOverwrite := Editor.OverwriteRange;
  1831. if Assigned (Range) then
  1832. Result.PrevRange := Range.PrevRange
  1833. else
  1834. Result.PrevRange := Editor.LastSyntaxRange;
  1835. Result.NextRange := Range;
  1836. if Assigned (Range) then begin
  1837. if Assigned (Range.PrevRange) then
  1838. Range.PrevRange.NextRange := Result
  1839. else
  1840. Editor.FirstSyntaxRange := Result;
  1841. end else begin
  1842. if not Assigned (Editor.FirstSyntaxRange) then
  1843. Editor.FirstSyntaxRange := Result;
  1844. if Assigned (Editor.LastSyntaxRange) then
  1845. Editor.LastSyntaxRange.NextRange := Result;
  1846. Editor.LastSyntaxRange := Result;
  1847. end;
  1848. if Assigned (Range) then
  1849. Range.PrevRange := Result;
  1850. end else
  1851. raise ESourceEdit.Create (SSourceEditError);
  1852. end;
  1853. class function TSyntaxRange.NewRangeInsertedAfter(Range: TSyntaxRange;
  1854. Editor: TSourceEdit): TSyntaxRange;
  1855. begin
  1856. if Assigned (Range) then
  1857. Result := InsertRangeBefore (Range.NextRange, Self, Editor)
  1858. else
  1859. Result := nil;
  1860. end;
  1861. class function TSyntaxRange.NewRangeInsertedBefore(Range: TSyntaxRange;
  1862. Editor: TSourceEdit): TSyntaxRange;
  1863. begin
  1864. Result := InsertRangeBefore (Range, Self, Editor);
  1865. end;
  1866. function TSyntaxRange.ReplaceSyntaxRanges(var StartRange: TSyntaxRange):
  1867. Boolean;
  1868. begin
  1869. if Assigned (Editor) and (Editor is TSourceEdit) then
  1870. Result := TSourceEdit(Editor).ReplaceSyntaxRanges (Self, StartRange)
  1871. else
  1872. Result := False;
  1873. end;
  1874. procedure TSyntaxRange.SetNewParenthesisLevel;
  1875. begin
  1876. if Assigned (PrevRange) then
  1877. ParenthesisLevel := PrevRange.NextParenthesisLevel
  1878. else
  1879. ParenthesisLevel := 0;
  1880. end;
  1881. procedure TSyntaxRange.UpdateParenthesisLevel;
  1882. begin
  1883. SetNewParenthesisLevel;
  1884. end;
  1885. { TNormalTextRange }
  1886. function TNormalTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1887. begin
  1888. Result := (Range is TNormalTextRange) and (inherited EqualEndingsWith (Range));
  1889. end;
  1890. function TNormalTextRange.GetFont: TFont;
  1891. begin
  1892. if Assigned (Editor) then
  1893. Result := Editor.Font
  1894. else
  1895. Result := nil;
  1896. end;
  1897. { TCustomStyleRange }
  1898. function TCustomStyleRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1899. begin
  1900. Result := (Range is TCustomStyleRange) and (inherited EqualEndingsWith (Range)) and (Style = TCustomStyleRange(Range).Style);
  1901. end;
  1902. function TCustomStyleRange.GetFont: TFont;
  1903. begin
  1904. if Assigned (Style) then
  1905. Result := Style.Font
  1906. else
  1907. Result := nil;
  1908. end;
  1909. { TWordListRange }
  1910. function TWordListRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1911. begin
  1912. Result := (Range is TWordListRange) and (inherited EqualEndingsWith (Range)) and (WordList = TWordListRange(Range).WordList);
  1913. end;
  1914. function TWordListRange.GetFont: TFont;
  1915. begin
  1916. Result := WordList.Font;
  1917. end;
  1918. { TSymbolRange }
  1919. function TSymbolRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1920. begin
  1921. Result := (Range is TSymbolRange) and (inherited EqualEndingsWith (Range)) and (Symbol = TSymbolRange(Range).Symbol);
  1922. end;
  1923. function TSymbolRange.GetFont: TFont;
  1924. begin
  1925. if Assigned (Editor) then begin
  1926. with Editor as TSourceEdit do
  1927. if SyntaxColoring.Enabled then
  1928. Result := SyntaxColoring.SymbolFont
  1929. else
  1930. Result := Font;
  1931. end else
  1932. Result := nil;
  1933. end;
  1934. { TNumberRange }
  1935. function TNumberRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1936. begin
  1937. Result := (Range is TNumberRange) and (inherited EqualEndingsWith (Range)) and (Number = TNumberRange(Range).Number);
  1938. end;
  1939. function TNumberRange.GetFont: TFont;
  1940. begin
  1941. if Assigned (Editor) then begin
  1942. with Editor as TSourceEdit do
  1943. if SyntaxColoring.Enabled then
  1944. Result := SyntaxColoring.NumberFont
  1945. else
  1946. Result := Font;
  1947. end else
  1948. Result := nil;
  1949. end;
  1950. { TParenthesisRange }
  1951. function TParenthesisRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1952. begin
  1953. Result := (Range is TParenthesisRange) and (inherited EqualEndingsWith (Range)) and (Style = TParenthesisRange(Range).Style);
  1954. end;
  1955. function TParenthesisRange.GetFont: TFont;
  1956. begin
  1957. if Assigned (Editor) then begin
  1958. with Editor as TSourceEdit do
  1959. if SyntaxColoring.Enabled then begin
  1960. Result := SyntaxColoring.ParenthesisFont;
  1961. Result.Color := SyntaxColoring.GetParenthesisColor (ParenthesisLevel - 1);
  1962. end else
  1963. Result := Font;
  1964. end else
  1965. Result := nil;
  1966. end;
  1967. function TParenthesisRange.GetNextParenthesisLevel: Integer;
  1968. begin
  1969. if Style = psOpening then
  1970. Result := inherited GetNextParenthesisLevel
  1971. else
  1972. Result := inherited GetNextParenthesisLevel - 1;
  1973. end;
  1974. procedure TParenthesisRange.SetNewParenthesisLevel;
  1975. begin
  1976. if Style = psClosing then
  1977. inherited SetNewParenthesisLevel
  1978. else
  1979. if Assigned (PrevRange) then
  1980. ParenthesisLevel := PrevRange.NextParenthesisLevel + 1
  1981. else
  1982. ParenthesisLevel := 1;
  1983. end;
  1984. procedure TParenthesisRange.UpdateParenthesisLevel;
  1985. var
  1986. Lev: Integer;
  1987. begin
  1988. Lev := ParenthesisLevel;
  1989. inherited;
  1990. if Lev <> ParenthesisLevel then
  1991. DrawRange;
  1992. end;
  1993. { TCustomTextRange }
  1994. function TCustomTextRange.EqualEndingsWith(Range: TSyntaxRange): Boolean;
  1995. begin
  1996. Result := (Range is TCustomTextRange) and (inherited EqualEndingsWith (Range));
  1997. end;
  1998. function TCustomTextRange.GetFont: TFont;
  1999. begin
  2000. if Assigned (Editor) then
  2001. Result := Editor.Font
  2002. else
  2003. Result := nil;
  2004. end;
  2005. end.