weditor.pas 86 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Code editor template objects
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  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.
  11. **********************************************************************}
  12. unit WEditor;
  13. interface
  14. {$ifndef FPC}
  15. {$define TPUNIXLF}
  16. {$endif}
  17. uses
  18. Objects,Drivers,Views,Commands;
  19. const
  20. cmFileNameChanged = 51234;
  21. cmASCIIChar = 51235;
  22. cmClearLineHighlights = 51236;
  23. {$ifdef FPC}
  24. EditorTextBufSize = 32768;
  25. MaxLineLength = 255;
  26. MaxLineCount = 16380;
  27. {$else}
  28. EditorTextBufSize = 4096;
  29. MaxLineLength = 255;
  30. MaxLineCount = 16380;
  31. {$endif}
  32. efBackupFiles = $00000001;
  33. efInsertMode = $00000002;
  34. efAutoIndent = $00000004;
  35. efUseTabCharacters = $00000008;
  36. efBackSpaceUnindents = $00000010;
  37. efPersistentBlocks = $00000020;
  38. efSyntaxHighlight = $00000040;
  39. efBlockInsCursor = $00000080;
  40. efVerticalBlocks = $00000100;
  41. efHighlightColumn = $00000200;
  42. efHighlightRow = $00000400;
  43. efAutoBrackets = $00000800;
  44. attrAsm = 1;
  45. attrComment = 2;
  46. attrForceFull = 128;
  47. attrAll = attrAsm+attrComment;
  48. edOutOfMemory = 0;
  49. edReadError = 1;
  50. edWriteError = 2;
  51. edCreateError = 3;
  52. edSaveModify = 4;
  53. edSaveUntitled = 5;
  54. edSaveAs = 6;
  55. edFind = 7;
  56. edSearchFailed = 8;
  57. edReplace = 9;
  58. edReplacePrompt = 10;
  59. edTooManyLines = 11;
  60. edGotoLine = 12;
  61. edReplaceFile = 13;
  62. ffmOptions = $0007; ffsOptions = 0;
  63. ffmDirection = $0008; ffsDirection = 3;
  64. ffmScope = $0010; ffsScope = 4;
  65. ffmOrigin = $0020; ffsOrigin = 5;
  66. ffDoReplace = $0040;
  67. ffReplaceAll = $0080;
  68. ffCaseSensitive = $0001;
  69. ffWholeWordsOnly = $0002;
  70. ffPromptOnReplace = $0004;
  71. ffForward = $0000;
  72. ffBackward = $0008;
  73. ffGlobal = $0000;
  74. ffSelectedText = $0010;
  75. ffFromCursor = $0000;
  76. ffEntireScope = $0020;
  77. coTextColor = 0;
  78. coWhiteSpaceColor = 1;
  79. coCommentColor = 2;
  80. coReservedWordColor = 3;
  81. coIdentifierColor = 4;
  82. coStringColor = 5;
  83. coNumberColor = 6;
  84. coAssemblerColor = 7;
  85. coSymbolColor = 8;
  86. coDirectiveColor = 9;
  87. coHexNumberColor = 10;
  88. coTabColor = 11;
  89. coBreakColor = 12;
  90. coFirstColor = 0;
  91. coLastColor = coBreakColor;
  92. CIndicator = #2#3#1;
  93. CEditor = #33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49;
  94. TAB = #9;
  95. type
  96. PLine = ^TLine;
  97. TLine = record
  98. Text : PString;
  99. Format : PString;
  100. BeginsWithAsm,
  101. EndsWithAsm : boolean;
  102. IsBreakpoint : boolean;
  103. BeginsWithComment,
  104. EndsInSingleLineComment,
  105. EndsWithComment : boolean;
  106. BeginsWithDirective,
  107. EndsWithDirective : boolean;
  108. {BeginCommentType,}EndCommentType : byte;
  109. end;
  110. PLineCollection = ^TLineCollection;
  111. TLineCollection = object(TCollection)
  112. function At(Index: Integer): PLine;
  113. procedure FreeItem(Item: Pointer); virtual;
  114. end;
  115. PIndicator = ^TIndicator;
  116. TIndicator = object(TView)
  117. Location: TPoint;
  118. Modified: Boolean;
  119. constructor Init(var Bounds: TRect);
  120. procedure Draw; virtual;
  121. function GetPalette: PPalette; virtual;
  122. procedure SetState(AState: Word; Enable: Boolean); virtual;
  123. procedure SetValue(ALocation: TPoint; AModified: Boolean);
  124. end;
  125. TSpecSymbolClass =
  126. (ssCommentPrefix,ssCommentSingleLinePrefix,ssCommentSuffix,ssStringPrefix,ssStringSuffix,
  127. ssDirectivePrefix,ssDirectiveSuffix,ssAsmPrefix,ssAsmSuffix);
  128. PCodeEditor = ^TCodeEditor;
  129. TCodeEditor = object(TScroller)
  130. Indicator : PIndicator;
  131. Lines : PLineCollection;
  132. SelStart : TPoint;
  133. SelEnd : TPoint;
  134. Highlight : TRect;
  135. CurPos : TPoint;
  136. CanUndo : Boolean;
  137. Modified : Boolean;
  138. IsReadOnly : Boolean;
  139. NoSelect : Boolean;
  140. Flags : longint;
  141. TabSize : integer;
  142. HighlightRow: integer;
  143. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  144. PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
  145. procedure SetFlags(AFlags: longint); virtual;
  146. procedure ConvertEvent(var Event: TEvent); virtual;
  147. procedure HandleEvent(var Event: TEvent); virtual;
  148. procedure SetState(AState: Word; Enable: Boolean); virtual;
  149. procedure Draw; virtual;
  150. procedure DrawCursor; virtual;
  151. procedure TrackCursor(Center: boolean); virtual;
  152. procedure UpdateIndicator; virtual;
  153. procedure LimitsChanged; virtual;
  154. procedure SelectionChanged; virtual;
  155. procedure HighlightChanged; virtual;
  156. procedure ScrollTo(X, Y: Integer); virtual;
  157. procedure SetInsertMode(InsertMode: boolean); virtual;
  158. procedure SetCurPtr(X, Y: Integer); virtual;
  159. procedure SetSelection(A, B: TPoint); virtual;
  160. procedure SetHighlight(A, B: TPoint); virtual;
  161. procedure SetHighlightRow(Row: integer); virtual;
  162. procedure SelectAll(Enable: boolean); virtual;
  163. function InsertFrom(Editor: PCodeEditor): Boolean; virtual;
  164. function InsertText(const S: string): Boolean; virtual;
  165. function GetPalette: PPalette; virtual;
  166. function IsClipboard: Boolean;
  167. destructor Done; virtual;
  168. public
  169. { Text & info storage abstraction }
  170. function GetLineCount: integer; virtual;
  171. function GetLineTextPos(Line,X: integer): integer;
  172. function GetDisplayTextPos(Line,X: integer): integer;
  173. function GetLineText(I: integer): string; virtual;
  174. procedure SetDisplayText(I: integer;const S: string); virtual;
  175. function GetDisplayText(I: integer): string; virtual;
  176. procedure SetLineText(I: integer;const S: string); virtual;
  177. procedure SetLineBreakState(I : integer;b : boolean);
  178. procedure GetDisplayTextFormat(I: integer;var DT,DF:string); virtual;
  179. function GetLineFormat(I: integer): string; virtual;
  180. procedure SetLineFormat(I: integer;const S: string); virtual;
  181. procedure DeleteAllLines; virtual;
  182. procedure DeleteLine(I: integer); virtual;
  183. procedure AddLine(const S: string); virtual;
  184. function GetErrorMessage: string; virtual;
  185. procedure SetErrorMessage(const S: string); virtual;
  186. private
  187. KeyState: Integer;
  188. ErrorMessage: PString;
  189. function Overwrite: boolean;
  190. function GetLine(I: integer): PLine;
  191. procedure CheckSels;
  192. function UpdateAttrs(FromLine: integer; Attrs: byte): integer;
  193. procedure DrawLines(FirstLine: integer);
  194. procedure HideHighlight;
  195. public
  196. { Syntax highlight support }
  197. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  198. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  199. function IsReservedWord(const S: string): boolean; virtual;
  200. public
  201. SearchRunCount: integer;
  202. InASCIIMode: boolean;
  203. procedure Indent; virtual;
  204. procedure CharLeft; virtual;
  205. procedure CharRight; virtual;
  206. procedure WordLeft; virtual;
  207. procedure WordRight; virtual;
  208. procedure LineStart; virtual;
  209. procedure LineEnd; virtual;
  210. procedure LineUp; virtual;
  211. procedure LineDown; virtual;
  212. procedure PageUp; virtual;
  213. procedure PageDown; virtual;
  214. procedure TextStart; virtual;
  215. procedure TextEnd; virtual;
  216. function InsertLine: Sw_integer; virtual;
  217. procedure BackSpace; virtual;
  218. procedure DelChar; virtual;
  219. procedure DelWord; virtual;
  220. procedure DelStart; virtual;
  221. procedure DelEnd; virtual;
  222. procedure DelLine; virtual;
  223. procedure InsMode; virtual;
  224. procedure StartSelect; virtual;
  225. procedure EndSelect; virtual;
  226. procedure DelSelect; virtual;
  227. procedure HideSelect; virtual;
  228. procedure CopyBlock; virtual;
  229. procedure MoveBlock; virtual;
  230. procedure AddChar(C: char); virtual;
  231. function ClipCopy: Boolean; virtual;
  232. procedure ClipCut; virtual;
  233. procedure ClipPaste; virtual;
  234. function GetCurrentWord : string;
  235. procedure Undo; virtual;
  236. procedure Find; virtual;
  237. procedure Replace; virtual;
  238. procedure DoSearchReplace; virtual;
  239. procedure GotoLine; virtual;
  240. end;
  241. PFileEditor = ^TFileEditor;
  242. TFileEditor = object(TCodeEditor)
  243. FileName: string;
  244. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  245. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  246. function Save: Boolean; virtual;
  247. function SaveAs: Boolean; virtual;
  248. function SaveAsk: Boolean; virtual;
  249. function LoadFile: boolean; virtual;
  250. function SaveFile: boolean; virtual;
  251. function Valid(Command: Word): Boolean; virtual;
  252. procedure HandleEvent(var Event: TEvent); virtual;
  253. function ShouldSave: boolean; virtual;
  254. end;
  255. TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
  256. function DefUseSyntaxHighlight(Editor: PFileEditor): boolean;
  257. function DefUseTabsPattern(Editor: PFileEditor): boolean;
  258. const
  259. DefaultCodeEditorFlags : longint =
  260. efBackupFiles+efInsertMode+efAutoIndent+efPersistentBlocks+
  261. {efUseTabCharacters+}efBackSpaceUnindents+efSyntaxHighlight;
  262. DefaultTabSize : integer = 8;
  263. ToClipCmds : TCommandSet = ([cmCut,cmCopy,cmClear]);
  264. FromClipCmds : TCommandSet = ([cmPaste]);
  265. UndoCmds : TCommandSet = ([cmUndo,cmRedo]);
  266. function StdEditorDialog(Dialog: Integer; Info: Pointer): word;
  267. const
  268. EditorDialog : TCodeEditorDialog = StdEditorDialog;
  269. Clipboard : PCodeEditor = nil;
  270. FindStr : String[80] = '';
  271. ReplaceStr : String[80] = '';
  272. FindFlags : word = ffPromptOnReplace;
  273. WhiteSpaceChars : set of char = [#0,#32,#255];
  274. TabChars : set of char = [#9];
  275. AlphaChars : set of char = ['A'..'Z','a'..'z','_'];
  276. NumberChars : set of char = ['0'..'9'];
  277. DefaultSaveExt : string[12]='.pas';
  278. UseSyntaxHighlight : function(Editor: PFileEditor): boolean = DefUseSyntaxHighlight;
  279. UseTabsPattern : function(Editor: PFileEditor): boolean = DefUseTabsPattern;
  280. implementation
  281. uses Dos,MsgBox,Dialogs,App,StdDlg,HistList,Validate;
  282. type
  283. TFindDialogRec = packed record
  284. Find: String[80];
  285. Options: Word;
  286. Direction: word;
  287. Scope: word;
  288. Origin: word;
  289. end;
  290. TReplaceDialogRec = packed record
  291. Find: String[80];
  292. Replace: String[80];
  293. Options: Word;
  294. Direction: word;
  295. Scope: word;
  296. Origin: word;
  297. end;
  298. TGotoLineDialogRec = packed record
  299. LineNo : string[5];
  300. Lines : integer;
  301. end;
  302. const
  303. kbShift = kbLeftShift+kbRightShift;
  304. const
  305. FirstKeyCount = 38;
  306. FirstKeys: array[0..FirstKeyCount * 2] of Word = (FirstKeyCount,
  307. Ord(^A), cmWordLeft, Ord(^B), cmASCIIChar, Ord(^C), cmPageDown,
  308. Ord(^D), cmCharRight, Ord(^E), cmLineUp,
  309. Ord(^F), cmWordRight, Ord(^G), cmDelChar,
  310. Ord(^H), cmBackSpace, Ord(^J), cmJumpLine,
  311. Ord(^K), $FF02, Ord(^L), cmSearchAgain,
  312. Ord(^M), cmNewLine, Ord(^Q), $FF01,
  313. Ord(^R), cmPageUp, Ord(^S), cmCharLeft,
  314. Ord(^T), cmDelWord, Ord(^U), cmUndo,
  315. Ord(^V), cmInsMode, Ord(^X), cmLineDown,
  316. Ord(^Y), cmDelLine, kbLeft, cmCharLeft,
  317. kbRight, cmCharRight, kbCtrlLeft, cmWordLeft,
  318. kbCtrlRight, cmWordRight, kbHome, cmLineStart,
  319. kbEnd, cmLineEnd, kbUp, cmLineUp,
  320. kbDown, cmLineDown, kbPgUp, cmPageUp,
  321. kbPgDn, cmPageDown, kbCtrlPgUp, cmTextStart,
  322. kbCtrlPgDn, cmTextEnd, kbIns, cmInsMode,
  323. kbDel, cmDelChar, kbShiftIns, cmPaste,
  324. kbShiftDel, cmCut, kbCtrlIns, cmCopy,
  325. kbCtrlDel, cmClear);
  326. QuickKeyCount = 10;
  327. QuickKeys: array[0..QuickKeyCount * 2] of Word = (QuickKeyCount,
  328. Ord('A'), cmReplace, Ord('C'), cmTextEnd,
  329. Ord('D'), cmLineEnd, Ord('F'), cmFind,
  330. Ord('H'), cmDelStart, Ord('R'), cmTextStart,
  331. Ord('S'), cmLineStart, Ord('Y'), cmDelEnd,
  332. Ord('G'), cmJumpLine, Ord('P'), cmReplace );
  333. BlockKeyCount = 6;
  334. BlockKeys: array[0..BlockKeyCount * 2] of Word = (BlockKeyCount,
  335. Ord('B'), cmStartSelect, Ord('C'), cmCopyBlock,
  336. Ord('H'), cmHideSelect, Ord('K'), cmEndSelect,
  337. Ord('Y'), cmDelSelect, Ord('V'), cmMoveBlock);
  338. KeyMap: array[0..2] of Pointer = (@FirstKeys, @QuickKeys, @BlockKeys);
  339. function ScanKeyMap(KeyMap: Pointer; KeyCode: Word): Word;
  340. type
  341. pword = ^word;
  342. var
  343. p : pword;
  344. count : sw_word;
  345. begin
  346. p:=keymap;
  347. count:=p^;
  348. inc(p);
  349. while (count>0) do
  350. begin
  351. if (lo(p^)=lo(keycode)) and
  352. ((hi(p^)=0) or (hi(p^)=hi(keycode))) then
  353. begin
  354. inc(p);
  355. scankeymap:=p^;
  356. exit;
  357. end;
  358. inc(p,2);
  359. dec(count);
  360. end;
  361. scankeymap:=0;
  362. end;
  363. function IsWordSeparator(C: char): boolean;
  364. begin
  365. IsWordSeparator:=C in[' ',#0,#255,':','=','''','"','.',',','/',';','$','#','(',')','<','>','^','*','+','-','?','&'];
  366. end;
  367. function IsSpace(C: char): boolean;
  368. begin
  369. IsSpace:=C in[' ',#0,#255];
  370. end;
  371. function EatIO: integer;
  372. begin
  373. EatIO:=IOResult;
  374. end;
  375. function ExistsFile(const FileName: string): boolean;
  376. var f: file;
  377. Exists: boolean;
  378. begin
  379. if FileName='' then Exists:=false else
  380. begin
  381. {$I-}
  382. Assign(f,FileName);
  383. Reset(f,1);
  384. Exists:=EatIO=0;
  385. Close(f);
  386. EatIO;
  387. {$I+}
  388. end;
  389. ExistsFile:=Exists;
  390. end;
  391. function Max(A,B: longint): longint;
  392. begin
  393. if A>B then Max:=A else Max:=B;
  394. end;
  395. function Min(A,B: longint): longint;
  396. begin
  397. if A<B then Min:=A else Min:=B;
  398. end;
  399. function StrToInt(const S: string): longint;
  400. var L: longint;
  401. C: integer;
  402. begin
  403. Val(S,L,C); if C<>0 then L:=-1;
  404. StrToInt:=L;
  405. end;
  406. function CharStr(C: char; Count: byte): string;
  407. {$ifndef FPC}
  408. var S: string;
  409. {$endif}
  410. begin
  411. {$ifdef FPC}
  412. CharStr[0]:=chr(Count);
  413. FillChar(CharStr[1],Count,C);
  414. {$else}
  415. S[0]:=chr(Count);
  416. FillChar(S[1],Count,C);
  417. CharStr:=S;
  418. {$endif}
  419. end;
  420. function RExpand(const S: string; MinLen: byte): string;
  421. begin
  422. if length(S)<MinLen then
  423. RExpand:=S+CharStr(' ',MinLen-length(S))
  424. else
  425. RExpand:=S;
  426. end;
  427. function RTrim(const S: string): string;
  428. var
  429. i : Sw_word;
  430. begin
  431. i:=Length(S);
  432. while (i>0) and (S[i] in [' ',#0,#255]) do
  433. dec(i);
  434. RTrim:=Copy(S,1,i);
  435. end;
  436. function upper(const s : string) : string;
  437. var
  438. i : Sw_word;
  439. begin
  440. for i:=1 to length(s) do
  441. if s[i] in ['a'..'z'] then
  442. upper[i]:=char(byte(s[i])-32)
  443. else
  444. upper[i]:=s[i];
  445. upper[0]:=s[0];
  446. end;
  447. function DirAndNameOf(const Path: string): string;
  448. var D: DirStr; N: NameStr; E: ExtStr;
  449. begin
  450. FSplit(Path,D,N,E);
  451. DirAndNameOf:=D+N;
  452. end;
  453. function PointOfs(P: TPoint): longint;
  454. begin
  455. PointOfs:=longint(P.Y)*MaxLineLength+P.X;
  456. end;
  457. function ExtractTabs(S: string; TabSize: Sw_integer): string;
  458. var
  459. P,PAdd: Sw_Word;
  460. begin
  461. p:=0;
  462. while p<length(s) do
  463. begin
  464. inc(p);
  465. if s[p]=#9 then
  466. begin
  467. PAdd:=TabSize-((p-1) mod TabSize);
  468. s:=copy(S,1,P-1)+CharStr(' ',PAdd)+copy(S,P+1,255);
  469. inc(P,PAdd-1);
  470. end;
  471. end;
  472. ExtractTabs:=S;
  473. end;
  474. function CompressUsingTabs(S: string; TabSize: byte): string;
  475. var TabS: string;
  476. P: byte;
  477. begin
  478. TabS:=CharStr(' ',TabSize);
  479. repeat
  480. P:=Pos(TabS,S);
  481. if P>0 then
  482. S:=copy(S,1,P-1)+TAB+copy(S,P+TabSize,255);
  483. until P=0;
  484. CompressUsingTabs:=S;
  485. end;
  486. {*****************************************************************************
  487. Forward/Backward Scanning
  488. *****************************************************************************}
  489. Const
  490. {$ifndef FPC}
  491. MaxBufLength = $7f00;
  492. NotFoundValue = -1;
  493. {$else}
  494. MaxBufLength = $7fffff00;
  495. NotFoundValue = -1;
  496. {$endif}
  497. Type
  498. Btable = Array[0..255] of Byte;
  499. Procedure BMFMakeTable(const s:string; Var t : Btable);
  500. Var
  501. x : sw_integer;
  502. begin
  503. FillChar(t,sizeof(t),length(s));
  504. For x := length(s) downto 1 do
  505. if (t[ord(s[x])] = length(s)) then
  506. t[ord(s[x])] := length(s) - x;
  507. end;
  508. function BMFScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  509. Var
  510. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  511. s2 : String;
  512. len,
  513. numb : Sw_Word;
  514. found : Boolean;
  515. begin
  516. len:=length(str);
  517. if len>size then
  518. begin
  519. BMFScan := NotFoundValue;
  520. exit;
  521. end;
  522. s2[0]:=chr(len); { sets the length to that of the search String }
  523. found:=False;
  524. numb:=pred(len);
  525. While (not found) and (numb<size) do
  526. begin
  527. { partial match }
  528. if buffer[numb] = ord(str[len]) then
  529. begin
  530. { less partial! }
  531. if buffer[numb-pred(len)] = ord(str[1]) then
  532. begin
  533. move(buffer[numb-pred(len)],s2[1],len);
  534. if (str=s2) then
  535. begin
  536. found:=true;
  537. break;
  538. end;
  539. end;
  540. inc(numb);
  541. end
  542. else
  543. inc(numb,Bt[buffer[numb]]);
  544. end;
  545. if not found then
  546. BMFScan := NotFoundValue
  547. else
  548. BMFScan := numb - pred(len);
  549. end;
  550. function BMFIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  551. Var
  552. buffer : Array[0..MaxBufLength-1] of Char Absolute block;
  553. len,
  554. numb,
  555. x : Sw_Word;
  556. found : Boolean;
  557. p : pchar;
  558. c : char;
  559. begin
  560. len:=length(str);
  561. if (len=0) or (len>size) then
  562. begin
  563. BMFIScan := NotFoundValue;
  564. exit;
  565. end;
  566. found:=False;
  567. numb:=pred(len);
  568. While (not found) and (numb<size) do
  569. begin
  570. { partial match }
  571. c:=buffer[numb];
  572. if c in ['a'..'z'] then
  573. c:=chr(ord(c)-32);
  574. if (c=str[len]) then
  575. begin
  576. { less partial! }
  577. p:=@buffer[numb-pred(len)];
  578. x:=1;
  579. while (x<=len) do
  580. begin
  581. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  582. (p^=str[x])) then
  583. break;
  584. inc(p);
  585. inc(x);
  586. end;
  587. if (x>len) then
  588. begin
  589. found:=true;
  590. break;
  591. end;
  592. inc(numb);
  593. end
  594. else
  595. inc(numb,Bt[ord(c)]);
  596. end;
  597. if not found then
  598. BMFIScan := NotFoundValue
  599. else
  600. BMFIScan := numb - pred(len);
  601. end;
  602. Procedure BMBMakeTable(const s:string; Var t : Btable);
  603. Var
  604. x : sw_integer;
  605. begin
  606. FillChar(t,sizeof(t),length(s));
  607. For x := 1 to length(s)do
  608. if (t[ord(s[x])] = length(s)) then
  609. t[ord(s[x])] := x-1;
  610. end;
  611. function BMBScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  612. Var
  613. buffer : Array[0..MaxBufLength-1] of Byte Absolute block;
  614. s2 : String;
  615. len,
  616. numb : Sw_integer;
  617. found : Boolean;
  618. begin
  619. len:=length(str);
  620. if len>size then
  621. begin
  622. BMBScan := NotFoundValue;
  623. exit;
  624. end;
  625. s2[0]:=chr(len); { sets the length to that of the search String }
  626. found:=False;
  627. numb:=size-pred(len);
  628. While (not found) and (numb>0) do
  629. begin
  630. { partial match }
  631. if buffer[numb] = ord(str[1]) then
  632. begin
  633. { less partial! }
  634. if buffer[numb+pred(len)] = ord(str[len]) then
  635. begin
  636. move(buffer[numb],s2[1],len);
  637. if (str=s2) then
  638. begin
  639. found:=true;
  640. break;
  641. end;
  642. end;
  643. dec(numb);
  644. end
  645. else
  646. dec(numb,Bt[buffer[numb]]);
  647. end;
  648. if not found then
  649. BMBScan := NotFoundValue
  650. else
  651. BMBScan := numb;
  652. end;
  653. function BMBIScan(var Block; Size: Sw_Word;const Str: String;const bt:BTable): Sw_Integer;
  654. Var
  655. buffer : Array[0..MaxBufLength-1] of Char Absolute block;
  656. len,
  657. numb,
  658. x : Sw_integer;
  659. found : Boolean;
  660. p : pchar;
  661. c : char;
  662. begin
  663. len:=length(str);
  664. if (len=0) or (len>size) then
  665. begin
  666. BMBIScan := NotFoundValue;
  667. exit;
  668. end;
  669. found:=False;
  670. numb:=size-len;
  671. While (not found) and (numb>0) do
  672. begin
  673. { partial match }
  674. c:=buffer[numb];
  675. if c in ['a'..'z'] then
  676. c:=chr(ord(c)-32);
  677. if (c=str[1]) then
  678. begin
  679. { less partial! }
  680. p:=@buffer[numb];
  681. x:=1;
  682. while (x<=len) do
  683. begin
  684. if not(((p^ in ['a'..'z']) and (chr(ord(p^)-32)=str[x])) or
  685. (p^=str[x])) then
  686. break;
  687. inc(p);
  688. inc(x);
  689. end;
  690. if (x>len) then
  691. begin
  692. found:=true;
  693. break;
  694. end;
  695. dec(numb);
  696. end
  697. else
  698. dec(numb,Bt[ord(c)]);
  699. end;
  700. if not found then
  701. BMBIScan := NotFoundValue
  702. else
  703. BMBIScan := numb;
  704. end;
  705. {*****************************************************************************
  706. PLine,TLineCollection
  707. *****************************************************************************}
  708. function NewLine(const S: string): PLine;
  709. var
  710. P: PLine;
  711. begin
  712. New(P);
  713. FillChar(P^,SizeOf(P^),0);
  714. P^.Text:=NewStr(S);
  715. NewLine:=P;
  716. end;
  717. procedure DisposeLine(P: PLine);
  718. begin
  719. if P<>nil then
  720. begin
  721. if P^.Text<>nil then DisposeStr(P^.Text);
  722. if P^.Format<>nil then DisposeStr(P^.Format);
  723. Dispose(P);
  724. end;
  725. end;
  726. function TLineCollection.At(Index: Integer): PLine;
  727. begin
  728. At:=inherited At(Index);
  729. end;
  730. procedure TLineCollection.FreeItem(Item: Pointer);
  731. begin
  732. if Item<>nil then DisposeLine(Item);
  733. end;
  734. constructor TIndicator.Init(var Bounds: TRect);
  735. begin
  736. inherited Init(Bounds);
  737. GrowMode := gfGrowLoY + gfGrowHiY;
  738. end;
  739. procedure TIndicator.Draw;
  740. var
  741. Color: Byte;
  742. Frame: Char;
  743. L: array[0..1] of Longint;
  744. S: String[15];
  745. B: TDrawBuffer;
  746. begin
  747. if (State and sfDragging = 0) and (State and sfActive <> 0) then
  748. begin
  749. Color := GetColor(1);
  750. Frame := #205;
  751. end
  752. else
  753. begin
  754. if (State and sfDragging)<>0 then
  755. Color := GetColor(2)
  756. else
  757. Color := GetColor(3);
  758. Frame := #196;
  759. end;
  760. MoveChar(B, Frame, Color, Size.X);
  761. if State and sfActive<>0 then
  762. begin
  763. if Modified then
  764. WordRec (B[0]).Lo := ord('*');
  765. L[0] := Location.Y + 1;
  766. L[1] := Location.X + 1;
  767. FormatStr(S, ' %d:%d ', L);
  768. MoveStr(B[8 - Pos(':', S)], S, Color);
  769. end;
  770. WriteBuf(0, 0, Size.X, 1, B);
  771. end;
  772. function TIndicator.GetPalette: PPalette;
  773. const
  774. P: string[Length(CIndicator)] = CIndicator;
  775. begin
  776. GetPalette := @P;
  777. end;
  778. procedure TIndicator.SetState(AState: Word; Enable: Boolean);
  779. begin
  780. inherited SetState(AState, Enable);
  781. if (AState = sfDragging) or (AState=sfActive) then
  782. DrawView;
  783. end;
  784. procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean);
  785. begin
  786. if (Location.X<>ALocation.X) or
  787. (Location.Y<>ALocation.Y) or
  788. (Modified <> AModified) then
  789. begin
  790. Location := ALocation;
  791. Modified := AModified;
  792. DrawView;
  793. end;
  794. end;
  795. {*****************************************************************************
  796. TCodeEditor
  797. *****************************************************************************}
  798. constructor TCodeEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  799. PScrollBar; AIndicator: PIndicator; AbufSize:Sw_Word);
  800. begin
  801. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  802. New(Lines, Init(500,1000));
  803. { we have always need at least 1 line }
  804. Lines^.Insert(NewLine(''));
  805. SetState(sfCursorVis,true);
  806. SetFlags(DefaultCodeEditorFlags); TabSize:=DefaultTabSize;
  807. SetHighlightRow(-1);
  808. Indicator:=AIndicator;
  809. UpdateIndicator; LimitsChanged;
  810. end;
  811. procedure TCodeEditor.SetFlags(AFlags: longint);
  812. var I: integer;
  813. begin
  814. Flags:=AFlags;
  815. SetInsertMode((Flags and efInsertMode)<>0);
  816. if (Flags and efSyntaxHighlight)<>0 then
  817. UpdateAttrs(0,attrAll) else
  818. for I:=0 to GetLineCount-1 do
  819. SetLineFormat(I,'');
  820. UpdateIndicator;
  821. DrawView;
  822. end;
  823. function TCodeEditor.GetErrorMessage: string;
  824. var S: string;
  825. begin
  826. if ErrorMessage=nil then S:='' else S:=ErrorMessage^;
  827. GetErrorMessage:=S;
  828. end;
  829. procedure TCodeEditor.SetErrorMessage(const S: string);
  830. begin
  831. if ErrorMessage<>nil then DisposeStr(ErrorMessage);
  832. ErrorMessage:=NewStr(S);
  833. DrawView;
  834. end;
  835. procedure TCodeEditor.TrackCursor(Center: boolean);
  836. var D: TPoint;
  837. begin
  838. D:=Delta;
  839. if CurPos.Y<Delta.Y then D.Y:=CurPos.Y else
  840. if CurPos.Y>Delta.Y+Size.Y-1 then D.Y:=CurPos.Y-Size.Y+1;
  841. if CurPos.X<Delta.X then D.X:=CurPos.X else
  842. if CurPos.X>Delta.X+Size.X-1 then D.X:=CurPos.X-Size.X+1;
  843. if {((Delta.X<>D.X) or (Delta.Y<>D.Y)) and }Center then
  844. begin
  845. { loose centering for debugger PM }
  846. while (CurPos.Y-D.Y)<(Size.Y div 3) do Dec(D.Y);
  847. while (CurPos.Y-D.Y)>2*(Size.Y div 3) do Inc(D.Y);
  848. end;
  849. if (Delta.X<>D.X) or (Delta.Y<>D.Y) then
  850. ScrollTo(D.X,D.Y);
  851. DrawCursor;
  852. UpdateIndicator;
  853. end;
  854. procedure TCodeEditor.ScrollTo(X, Y: Integer);
  855. begin
  856. inherited ScrollTo(X,Y);
  857. if (HScrollBar=nil) or (VScrollBar=nil) then
  858. begin Delta.X:=X; Delta.Y:=Y; end;
  859. DrawView;
  860. end;
  861. procedure TCodeEditor.UpdateIndicator;
  862. begin
  863. if Indicator<>nil then
  864. begin
  865. Indicator^.Location:=CurPos;
  866. Indicator^.Modified:=Modified;
  867. Indicator^.DrawView;
  868. end;
  869. end;
  870. procedure TCodeEditor.LimitsChanged;
  871. begin
  872. SetLimit(MaxLineLength+1,GetLineCount);
  873. end;
  874. procedure TCodeEditor.ConvertEvent(var Event: TEvent);
  875. var
  876. Key: Word;
  877. begin
  878. if Event.What = evKeyDown then
  879. begin
  880. if (GetShiftState and kbShift <> 0) and
  881. (Event.ScanCode >= $47) and (Event.ScanCode <= $51) then
  882. Event.CharCode := #0;
  883. Key := Event.KeyCode;
  884. if KeyState <> 0 then
  885. begin
  886. if (Lo(Key) >= $01) and (Lo(Key) <= $1A) then Inc(Key, $40);
  887. if (Lo(Key) >= $61) and (Lo(Key) <= $7A) then Dec(Key, $20);
  888. end;
  889. Key := ScanKeyMap(KeyMap[KeyState], Key);
  890. KeyState := 0;
  891. if Key <> 0 then
  892. if Hi(Key) = $FF then
  893. begin
  894. KeyState := Lo(Key);
  895. ClearEvent(Event);
  896. end else
  897. begin
  898. Event.What := evCommand;
  899. Event.Command := Key;
  900. end;
  901. end;
  902. end;
  903. procedure TCodeEditor.HandleEvent(var Event: TEvent);
  904. var DontClear : boolean;
  905. procedure CheckScrollBar(P: PScrollBar; var D: Sw_Integer);
  906. begin
  907. if (Event.InfoPtr = P) and (P^.Value <> D) then
  908. begin
  909. D := P^.Value;
  910. DrawView;
  911. end;
  912. end;
  913. procedure GetMousePos(var P: TPoint);
  914. begin
  915. MakeLocal(Event.Where,P);
  916. Inc(P.X,Delta.X); Inc(P.Y,Delta.Y);
  917. end;
  918. var
  919. StartP,P: TPoint;
  920. begin
  921. if (InASCIIMode=false) or (Event.What<>evKeyDown) then
  922. ConvertEvent(Event);
  923. case Event.What of
  924. evMouseDown :
  925. if MouseInView(Event.Where) then
  926. if Event.Buttons=mbLeftButton then
  927. begin
  928. GetMousePos(P);
  929. StartP:=P;
  930. SetCurPtr(P.X,P.Y);
  931. repeat
  932. GetMousePos(P);
  933. if PointOfs(P)<PointOfs(StartP)
  934. then SetSelection(P,StartP)
  935. else SetSelection(StartP,P);
  936. SetCurPtr(P.X,P.Y);
  937. DrawView;
  938. until not MouseEvent(Event, evMouseMove+evMouseAuto);
  939. DrawView;
  940. end;
  941. evKeyDown :
  942. begin
  943. if InASCIIMode and (Event.ScanCode=0) then
  944. AddChar(Event.CharCode) else
  945. begin
  946. DontClear:=false;
  947. case Event.CharCode of
  948. #9,#32..#255 :
  949. begin
  950. NoSelect:=true;
  951. AddChar(Event.CharCode);
  952. NoSelect:=false;
  953. end;
  954. else
  955. DontClear:=true;
  956. end;
  957. if not DontClear then
  958. ClearEvent(Event);
  959. end;
  960. InASCIIMode:=false;
  961. end;
  962. evCommand :
  963. begin
  964. DontClear:=false;
  965. case Event.Command of
  966. cmASCIIChar : InASCIIMode:=not InASCIIMode;
  967. cmCharLeft : CharLeft;
  968. cmCharRight : CharRight;
  969. cmWordLeft : WordLeft;
  970. cmWordRight : WordRight;
  971. cmLineStart : LineStart;
  972. cmLineEnd : LineEnd;
  973. cmLineUp : LineUp;
  974. cmLineDown : LineDown;
  975. cmPageUp : PageUp;
  976. cmPageDown : PageDown;
  977. cmTextStart : TextStart;
  978. cmTextEnd : TextEnd;
  979. cmNewLine : InsertLine;
  980. cmBackSpace : BackSpace;
  981. cmDelChar : DelChar;
  982. cmDelWord : DelWord;
  983. cmDelStart : DelStart;
  984. cmDelEnd : DelEnd;
  985. cmDelLine : DelLine;
  986. cmInsMode : InsMode;
  987. cmStartSelect : StartSelect;
  988. cmHideSelect : HideSelect;
  989. cmUpdateTitle : ;
  990. cmEndSelect : EndSelect;
  991. cmDelSelect : DelSelect;
  992. cmCopyBlock : CopyBlock;
  993. cmMoveBlock : MoveBlock;
  994. { ------ }
  995. cmFind : Find;
  996. cmReplace : Replace;
  997. cmSearchAgain : DoSearchReplace;
  998. cmJumpLine : GotoLine;
  999. { ------ }
  1000. cmCut : ClipCut;
  1001. cmCopy : ClipCopy;
  1002. cmPaste : ClipPaste;
  1003. cmUndo : Undo;
  1004. cmClear : DelSelect;
  1005. else DontClear:=true;
  1006. end;
  1007. if DontClear=false then ClearEvent(Event);
  1008. end;
  1009. evBroadcast :
  1010. case Event.Command of
  1011. cmClearLineHighlights :
  1012. SetHighlightRow(-1);
  1013. cmScrollBarChanged:
  1014. if (Event.InfoPtr = HScrollBar) or
  1015. (Event.InfoPtr = VScrollBar) then
  1016. begin
  1017. CheckScrollBar(HScrollBar, Delta.X);
  1018. CheckScrollBar(VScrollBar, Delta.Y);
  1019. end
  1020. else
  1021. Exit;
  1022. else
  1023. Exit;
  1024. end;
  1025. end;
  1026. end;
  1027. procedure TCodeEditor.Draw;
  1028. var SelectColor,
  1029. HighlightColColor,
  1030. HighlightRowColor,
  1031. ErrorMessageColor : word;
  1032. B: TDrawBuffer;
  1033. X,Y,AX,AY,MaxX: integer;
  1034. PX: TPoint;
  1035. LineCount: integer;
  1036. Line: PLine;
  1037. LineText,Format: string;
  1038. isBreak : boolean;
  1039. C: char;
  1040. FreeFormat: array[0..255] of boolean;
  1041. Color: word;
  1042. ColorTab: array[coFirstColor..coLastColor] of word;
  1043. ErrorLine: integer;
  1044. ErrorMsg: string[MaxViewWidth];
  1045. function CombineColors(Orig,Modifier: byte): byte;
  1046. var Color: byte;
  1047. begin
  1048. if (Modifier and $0f)=0 then
  1049. Color:=(Orig and $0f) or (Modifier and $f0)
  1050. else
  1051. Color:=(Orig and $f0) or (Modifier and $0f);
  1052. { do not allow invisible }
  1053. { use white as foreground in this case }
  1054. if (Color and $f) = ((Color div $10) and $7) then
  1055. Color:=(Color and $F0) or $F;
  1056. CombineColors:=Color;
  1057. end;
  1058. const NulLine : TLine = (Text: nil; Format: nil);
  1059. begin
  1060. ErrorMsg:=copy(GetErrorMessage,1,MaxViewWidth);
  1061. if ErrorMsg='' then ErrorLine:=-1 else
  1062. if (CurPos.Y-Delta.Y)<(Size.Y div 2) then ErrorLine:=Size.Y-1
  1063. else ErrorLine:=0;
  1064. LineCount:=GetLineCount;
  1065. ColorTab[coTextColor]:=GetColor(1);
  1066. ColorTab[coWhiteSpaceColor]:=GetColor(2);
  1067. ColorTab[coCommentColor]:=GetColor(3);
  1068. ColorTab[coReservedWordColor]:=GetColor(4);
  1069. ColorTab[coIdentifierColor]:=GetColor(5);
  1070. ColorTab[coStringColor]:=GetColor(6);
  1071. ColorTab[coNumberColor]:=GetColor(7);
  1072. ColorTab[coAssemblerColor]:=GetColor(8);
  1073. ColorTab[coSymbolColor]:=GetColor(9);
  1074. ColorTab[coDirectiveColor]:=GetColor(13);
  1075. ColorTab[coHexNumberColor]:=GetColor(14);
  1076. ColorTab[coTabColor]:=GetColor(15);
  1077. { break same as error }
  1078. ColorTab[coBreakColor]:=GetColor(16);
  1079. SelectColor:=GetColor(10);
  1080. HighlightColColor:=GetColor(11);
  1081. HighlightRowColor:=GetColor(12);
  1082. ErrorMessageColor:=GetColor(16);
  1083. for Y:=0 to Size.Y-1 do
  1084. if Y=ErrorLine then
  1085. begin
  1086. MoveChar(B,' ',ErrorMessageColor,Size.X);
  1087. MoveStr(B,ErrorMsg,ErrorMessageColor);
  1088. WriteLine(0,Y,Size.X,1,B);
  1089. end else
  1090. begin
  1091. AY:=Delta.Y+Y;
  1092. Color:=ColorTab[coTextColor];
  1093. FillChar(FreeFormat,SizeOf(FreeFormat),1);
  1094. MoveChar(B,' ',Color,Size.X);
  1095. if AY<LineCount then
  1096. begin
  1097. Line:=GetLine(AY);
  1098. IsBreak:=Lines^.at(AY)^.isBreakpoint;
  1099. end
  1100. else
  1101. begin
  1102. Line:=@NulLine;
  1103. IsBreak:=false;
  1104. end;
  1105. GetDisplayTextFormat(AY,LineText,Format);
  1106. { if (Flags and efSyntaxHighlight)<>0 then MaxX:=length(LineText)+1
  1107. else }MaxX:=Size.X+Delta.X;
  1108. for X:=1 to Min(MaxX,255) do
  1109. begin
  1110. AX:=Delta.X+X-1;
  1111. if X<=length(LineText) then C:=LineText[X] else C:=' ';
  1112. PX.X:=AX-Delta.X; PX.Y:=AY;
  1113. if (Highlight.A.X<>Highlight.B.X) or (Highlight.A.Y<>Highlight.B.Y) then
  1114. begin
  1115. if (PointOfs(Highlight.A)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(Highlight.B)) then
  1116. begin
  1117. Color:=SelectColor;
  1118. FreeFormat[X]:=false;
  1119. end;
  1120. end else
  1121. { no highlight }
  1122. begin
  1123. if (Flags and efVerticalBlocks<>0) then
  1124. begin
  1125. if (SelStart.X<=AX) and (AX<=SelEnd.X) and
  1126. (SelStart.Y<=AY) and (AY<=SelEnd.Y) then
  1127. begin Color:=SelectColor; FreeFormat[X]:=false; end;
  1128. end else
  1129. if PointOfs(SelStart)<>PointOfs(SelEnd) then
  1130. if (PointOfs(SelStart)<=PointOfs(PX)) and (PointOfs(PX)<PointOfs(SelEnd)) then
  1131. begin Color:=SelectColor; FreeFormat[X]:=false; end;
  1132. end;
  1133. if FreeFormat[X] then
  1134. if X<=length(Format) then
  1135. {Color:=ColorTab[ord(Format[X])] else Color:=ColorTab[coTextColor];
  1136. this give BoundsCheckError with -Cr quite often PM }
  1137. Color:=ColorTab[ord(Format[X]) mod (coLastColor + 1)] else Color:=ColorTab[coTextColor];
  1138. if ( ((Flags and efHighlightRow) <>0) and
  1139. (PX.Y=CurPos.Y) ) and (HighlightRow=-1) then
  1140. begin
  1141. Color:=CombineColors(Color,HighlightRowColor);
  1142. FreeFormat[X]:=false;
  1143. end;
  1144. if ( ((Flags and efHighlightColumn)<>0) and (PX.X=CurPos.X) ) then
  1145. begin
  1146. Color:=CombineColors(Color,HighlightColColor);
  1147. FreeFormat[X]:=false;
  1148. end;
  1149. if HighlightRow=AY then
  1150. begin
  1151. Color:=CombineColors(Color,HighlightRowColor);
  1152. FreeFormat[X]:=false;
  1153. end;
  1154. if isbreak then
  1155. begin
  1156. Color:=ColorTab[coBreakColor];
  1157. FreeFormat[X]:=false;
  1158. end;
  1159. if (0<=X-1-Delta.X) and (X-1-Delta.X<MaxViewWidth) then
  1160. MoveChar(B[X-1-Delta.X],C,Color,1);
  1161. end;
  1162. WriteLine(0,Y,Size.X,1,B);
  1163. end;
  1164. DrawCursor;
  1165. end;
  1166. procedure TCodeEditor.DrawCursor;
  1167. begin
  1168. SetCursor(CurPos.X-Delta.X,CurPos.Y-Delta.Y);
  1169. SetState(sfCursorIns,Overwrite);
  1170. end;
  1171. function TCodeEditor.Overwrite: boolean;
  1172. begin
  1173. Overwrite:=(Flags and efInsertMode)=0;
  1174. end;
  1175. function TCodeEditor.GetLineCount: integer;
  1176. begin
  1177. GetLineCount:=Lines^.Count;
  1178. end;
  1179. function TCodeEditor.GetLine(I: integer): PLine;
  1180. begin
  1181. GetLine:=Lines^.At(I);
  1182. end;
  1183. function TCodeEditor.GetLineTextPos(Line,X: integer): integer;
  1184. var
  1185. S: string;
  1186. rx,i : Sw_integer;
  1187. begin
  1188. S:=GetLineText(Line);
  1189. i:=0;
  1190. rx:=0;
  1191. while (RX<X) and (i<Length(s)) do
  1192. begin
  1193. inc(i);
  1194. inc(rx);
  1195. if s[i]=#9 then
  1196. inc(rx,TabSize-(rx mod tabsize));
  1197. end;
  1198. if RX<X then Inc(I,X-RX);
  1199. GetLineTextPos:=i;
  1200. end;
  1201. function TCodeEditor.GetDisplayTextPos(Line,X: integer): integer;
  1202. var
  1203. S: string;
  1204. L: PLine;
  1205. rx,i : Sw_integer;
  1206. begin
  1207. S:='';
  1208. if Line<Lines^.Count then
  1209. begin
  1210. L:=Lines^.At(Line);
  1211. if assigned(L^.Text) then
  1212. S:=L^.Text^;
  1213. end;
  1214. i:=0;
  1215. rx:=0;
  1216. while (i<X) and (i<Length(s)) do
  1217. begin
  1218. inc(i);
  1219. inc(rx);
  1220. if s[i]=#9 then
  1221. inc(rx,TabSize-(rx mod tabsize));
  1222. end;
  1223. GetDisplayTextPos:=rx;
  1224. end;
  1225. function TCodeEditor.GetLineText(I: integer): string;
  1226. var
  1227. L : PLine;
  1228. begin
  1229. GetLineText:='';
  1230. if I<Lines^.Count then
  1231. begin
  1232. L:=Lines^.At(I);
  1233. if assigned(L^.Text) then
  1234. GetLineText:=L^.Text^;
  1235. end;
  1236. end;
  1237. procedure TCodeEditor.SetLineText(I: integer;const S: string);
  1238. var
  1239. L : PLine;
  1240. AddCount : Sw_Integer;
  1241. begin
  1242. AddCount:=0;
  1243. while (Lines^.Count<I+1) do
  1244. begin
  1245. Lines^.Insert(NewLine(''));
  1246. Inc(AddCount);
  1247. end;
  1248. if AddCount>0 then
  1249. LimitsChanged;
  1250. L:=Lines^.At(I);
  1251. if assigned(L^.Text) then
  1252. DisposeStr(L^.Text);
  1253. L^.Text:=NewStr(S);
  1254. end;
  1255. procedure TCodeEditor.SetLineBreakState(I : integer;b : boolean);
  1256. var PL : PLine;
  1257. begin
  1258. if (i>0) and (i<=Lines^.Count) then
  1259. PL:=Lines^.At(i-1)
  1260. else
  1261. exit;
  1262. if assigned(PL) then
  1263. PL^.isbreakpoint:=b;
  1264. DrawView;
  1265. end;
  1266. function TCodeEditor.GetDisplayText(I: integer): string;
  1267. begin
  1268. GetDisplayText:=ExtractTabs(GetLineText(I),TabSize);
  1269. end;
  1270. procedure TCodeEditor.GetDisplayTextFormat(I: integer;var DT,DF:string);
  1271. var
  1272. L : PLine;
  1273. P,PAdd : SW_Integer;
  1274. begin
  1275. DF:='';
  1276. DT:='';
  1277. if I<Lines^.Count then
  1278. begin
  1279. L:=Lines^.At(I);
  1280. if assigned(L^.Text) then
  1281. begin
  1282. if assigned(L^.Format)=false then DF:='' else
  1283. DF:=L^.Format^;
  1284. DT:=L^.Text^;
  1285. p:=0;
  1286. while p<length(DT) do
  1287. begin
  1288. inc(p);
  1289. if DT[p]=#9 then
  1290. begin
  1291. PAdd:=TabSize-((p-1) mod TabSize);
  1292. DF:=copy(DF,1,P-1)+CharStr(DF[p],PAdd)+copy(DF,P+1,255);
  1293. DT:=copy(DT,1,P-1)+CharStr(' ',PAdd)+copy(DT,P+1,255);
  1294. inc(P,PAdd-1);
  1295. end;
  1296. end;
  1297. end;
  1298. end;
  1299. end;
  1300. procedure TCodeEditor.SetDisplayText(I: integer;const S: string);
  1301. begin
  1302. if ((Flags and efUseTabCharacters)<>0) and (TabSize>0) then
  1303. SetLineText(I,CompressUsingTabs(S,TabSize))
  1304. else
  1305. SetLineText(I,S);
  1306. end;
  1307. function TCodeEditor.GetLineFormat(I: integer): string;
  1308. var P: PLine;
  1309. S: string;
  1310. begin
  1311. if I<GetLineCount then P:=Lines^.At(I) else P:=nil;
  1312. if (P=nil) or (P^.Format=nil) then S:='' else
  1313. S:=P^.Format^;
  1314. GetLineFormat:=S;
  1315. end;
  1316. procedure TCodeEditor.SetLineFormat(I: integer;const S: string);
  1317. var P: PLine;
  1318. begin
  1319. if I<GetLineCount then
  1320. begin
  1321. P:=Lines^.At(I);
  1322. if P^.Format<>nil then DisposeStr(P^.Format);
  1323. P^.Format:=NewStr(S);
  1324. end;
  1325. end;
  1326. procedure TCodeEditor.DeleteAllLines;
  1327. begin
  1328. if Assigned(Lines) then
  1329. Lines^.FreeAll;
  1330. end;
  1331. procedure TCodeEditor.DeleteLine(I: integer);
  1332. begin
  1333. Lines^.AtFree(I);
  1334. end;
  1335. procedure TCodeEditor.AddLine(const S: string);
  1336. begin
  1337. Lines^.Insert(NewLine(S));
  1338. end;
  1339. function TCodeEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  1340. begin
  1341. GetSpecSymbolCount:=0;
  1342. end;
  1343. function TCodeEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  1344. begin
  1345. GetSpecSymbol:='';
  1346. Abstract;
  1347. end;
  1348. function TCodeEditor.IsReservedWord(const S: string): boolean;
  1349. begin
  1350. IsReservedWord:=false;
  1351. end;
  1352. procedure TCodeEditor.Indent;
  1353. var S, PreS: string;
  1354. Shift: integer;
  1355. begin
  1356. S:=GetLineText(CurPos.Y);
  1357. if CurPos.Y>0 then
  1358. PreS:=RTrim(GetLineText(CurPos.Y-1))
  1359. else
  1360. PreS:='';
  1361. if CurPos.X>=length(PreS) then
  1362. Shift:=TabSize
  1363. else
  1364. begin
  1365. Shift:=1;
  1366. while (CurPos.X+Shift<length(PreS)) and (PreS[CurPos.X+Shift]<>' ') do
  1367. Inc(Shift);
  1368. end;
  1369. SetLineText(CurPos.Y,RExpand(copy(S,1,CurPos.X+1),CurPos.X+1)+CharStr(' ',Shift)+copy(S,CurPos.X+2,255));
  1370. SetCurPtr(CurPos.X+Shift,CurPos.Y);
  1371. UpdateAttrs(CurPos.Y,attrAll);
  1372. DrawLines(CurPos.Y);
  1373. Modified:=true;
  1374. UpdateIndicator;
  1375. end;
  1376. procedure TCodeEditor.CharLeft;
  1377. begin
  1378. if CurPos.X>0 then
  1379. begin
  1380. if (Flags and efUseTabCharacters)<>0 then
  1381. SetCurPtr(GetDisplayTextPos(CurPos.Y,GetLineTextPos(CurPos.Y,CurPos.X)-1),CurPos.Y)
  1382. else
  1383. SetCurPtr(CurPos.X-1,CurPos.Y);
  1384. end;
  1385. end;
  1386. procedure TCodeEditor.CharRight;
  1387. var
  1388. X : Sw_integer;
  1389. begin
  1390. if CurPos.X<MaxLineLength then
  1391. begin
  1392. if (Flags and efUseTabCharacters)<>0 then
  1393. begin
  1394. X:=GetDisplayTextPos(CurPos.Y,GetLineTextPos(CurPos.Y,CurPos.X)+1);
  1395. if X>CurPos.X then
  1396. SetCurPtr(X,CurPos.Y)
  1397. else
  1398. SetCurPtr(CurPos.X+1,CurPos.Y);
  1399. end
  1400. else
  1401. SetCurPtr(CurPos.X+1,CurPos.Y);
  1402. end;
  1403. end;
  1404. procedure TCodeEditor.WordLeft;
  1405. var X, Y: integer;
  1406. Line: string;
  1407. GotIt,FoundNonSeparator: boolean;
  1408. begin
  1409. X:=CurPos.X;
  1410. Y:=CurPos.Y;
  1411. GotIt:=false;
  1412. FoundNonSeparator:=false;
  1413. while (Y>=0) do
  1414. begin
  1415. if Y=CurPos.Y then
  1416. begin
  1417. X:=length(GetDisplayText(Y));
  1418. if CurPos.X<X then
  1419. X:=CurPos.X; Dec(X);
  1420. if (X=-1) then
  1421. begin
  1422. Dec(Y);
  1423. if Y>=0 then
  1424. X:=length(GetDisplayText(Y));
  1425. Break;
  1426. end;
  1427. end
  1428. else
  1429. X:=length(GetDisplayText(Y))-1;
  1430. Line:=GetDisplayText(Y);
  1431. while (X>=0) and (GotIt=false) do
  1432. begin
  1433. if FoundNonSeparator then
  1434. begin
  1435. if IsWordSeparator(Line[X+1]) then
  1436. begin
  1437. Inc(X);
  1438. GotIt:=true;
  1439. Break;
  1440. end;
  1441. end
  1442. else
  1443. if not IsWordSeparator(Line[X+1]) then
  1444. FoundNonSeparator:=true;
  1445. Dec(X);
  1446. if (X=0) and (IsWordSeparator(Line[1])=false) then
  1447. begin
  1448. GotIt:=true;
  1449. Break;
  1450. end;
  1451. end;
  1452. if GotIt then
  1453. Break;
  1454. X:=0;
  1455. Dec(Y);
  1456. if Y>=0 then
  1457. begin
  1458. X:=length(GetDisplayText(Y));
  1459. Break;
  1460. end;
  1461. end;
  1462. if Y<0 then Y:=0; if X<0 then X:=0;
  1463. SetCurPtr(X,Y);
  1464. end;
  1465. procedure TCodeEditor.WordRight;
  1466. var X, Y: integer;
  1467. Line: string;
  1468. GotIt: boolean;
  1469. begin
  1470. X:=CurPos.X; Y:=CurPos.Y; GotIt:=false;
  1471. while (Y<GetLineCount) do
  1472. begin
  1473. if Y=CurPos.Y then
  1474. begin
  1475. X:=CurPos.X; Inc(X);
  1476. if (X>length(GetDisplayText(Y))-1) then
  1477. begin Inc(Y); X:=0; end;
  1478. end else X:=0;
  1479. Line:=GetDisplayText(Y);
  1480. while (X<=length(Line)+1) and (GotIt=false) and (Line<>'') do
  1481. begin
  1482. if X=length(Line)+1 then begin GotIt:=true; Dec(X); Break end;
  1483. if IsWordSeparator(Line[X]) then
  1484. begin
  1485. while (Y<GetLineCount) and
  1486. (X<=length(Line)) and (IsWordSeparator(Line[X])) do
  1487. begin
  1488. Inc(X);
  1489. if X>=length(Line) then
  1490. begin GotIt:=true; Dec(X); Break; end;
  1491. end;
  1492. if (GotIt=false) and (X<length(Line)) then
  1493. begin
  1494. Dec(X);
  1495. GotIt:=true;
  1496. Break;
  1497. end;
  1498. end;
  1499. Inc(X);
  1500. end;
  1501. if GotIt then Break;
  1502. X:=0;
  1503. Inc(Y);
  1504. if (Y<GetLineCount) then
  1505. begin
  1506. Line:=GetDisplayText(Y);
  1507. if (Line<>'') and (IsWordSeparator(Line[1])=false) then Break;
  1508. end;
  1509. end;
  1510. if Y=GetLineCount then Y:=GetLineCount-1;
  1511. SetCurPtr(X,Y);
  1512. end;
  1513. procedure TCodeEditor.LineStart;
  1514. begin
  1515. SetCurPtr(0,CurPos.Y);
  1516. end;
  1517. procedure TCodeEditor.LineEnd;
  1518. begin
  1519. if CurPos.Y<GetLineCount then
  1520. SetCurPtr(length(GetDisplayText(CurPos.Y)),CurPos.Y)
  1521. else
  1522. SetCurPtr(0,CurPos.Y);
  1523. end;
  1524. procedure TCodeEditor.LineUp;
  1525. begin
  1526. if CurPos.Y>0 then
  1527. SetCurPtr(CurPos.X,CurPos.Y-1);
  1528. end;
  1529. procedure TCodeEditor.LineDown;
  1530. begin
  1531. if CurPos.Y<GetLineCount-1 then
  1532. SetCurPtr(CurPos.X,CurPos.Y+1);
  1533. end;
  1534. procedure TCodeEditor.PageUp;
  1535. begin
  1536. ScrollTo(Delta.X,Max(Delta.Y-Size.Y,0));
  1537. SetCurPtr(CurPos.X,Max(0,CurPos.Y-(Size.Y)));
  1538. end;
  1539. procedure TCodeEditor.PageDown;
  1540. begin
  1541. ScrollTo(Delta.X,Min(Delta.Y+Size.Y,GetLineCount-1));
  1542. SetCurPtr(CurPos.X,Min(GetLineCount-1,CurPos.Y+(Size.Y{-1})));
  1543. end;
  1544. procedure TCodeEditor.TextStart;
  1545. begin
  1546. SetCurPtr(0,0);
  1547. end;
  1548. procedure TCodeEditor.TextEnd;
  1549. begin
  1550. SetCurPtr(length(GetDisplayText(GetLineCount-1)),GetLineCount-1);
  1551. end;
  1552. function TCodeEditor.InsertLine: Sw_integer;
  1553. var
  1554. SelBack,Ind: Sw_integer;
  1555. S,IndentStr: string;
  1556. procedure CalcIndent(LineOver: Sw_integer);
  1557. begin
  1558. if (LineOver<0) or (LineOver>GetLineCount) then Ind:=0 else
  1559. begin
  1560. IndentStr:=GetLineText(LineOver);
  1561. Ind:=0;
  1562. while (Ind<length(IndentStr)) and (IndentStr[Ind+1]=' ') do
  1563. Inc(Ind);
  1564. end;
  1565. IndentStr:=CharStr(' ',Ind);
  1566. end;
  1567. begin
  1568. if IsReadOnly then
  1569. begin
  1570. InsertLine:=-1;
  1571. Exit;
  1572. end;
  1573. if CurPos.Y<GetLineCount then
  1574. S:=GetLineText(CurPos.Y)
  1575. else
  1576. S:='';
  1577. if Overwrite=false then
  1578. begin
  1579. SelBack:=0;
  1580. if GetLineCount>0 then
  1581. begin
  1582. S:=GetDisplayText(CurPos.Y);
  1583. SelBack:=length(S)-SelEnd.X;
  1584. SetDisplayText(CurPos.Y,RTrim(S));
  1585. CalcIndent(CurPos.Y);
  1586. Lines^.AtInsert(CurPos.Y+1,NewLine(IndentStr+copy(S,CurPos.X+1,255)));
  1587. end
  1588. else
  1589. begin
  1590. CalcIndent(0);
  1591. Lines^.Insert(NewLine(IndentStr));
  1592. end;
  1593. LimitsChanged;
  1594. SetDisplayText(CurPos.Y,copy(S,1,CurPos.X-1+1));
  1595. if PointOfs(SelStart)<>PointOfs(SelEnd) then { !!! check it - it's buggy !!! }
  1596. begin
  1597. SelEnd.Y:=CurPos.Y+1;
  1598. SelEnd.X:=length(GetLineText(CurPos.Y+1))-SelBack;
  1599. end;
  1600. UpdateAttrs(CurPos.Y,attrAll);
  1601. SetCurPtr(Ind,CurPos.Y+1);
  1602. end
  1603. else
  1604. begin
  1605. if CurPos.Y=GetLineCount-1 then
  1606. CalcIndent(CurPos.Y);
  1607. Lines^.Insert(NewLine(IndentStr));
  1608. LimitsChanged;
  1609. SetCurPtr(Ind,CurPos.Y+1);
  1610. end;
  1611. DrawLines(CurPos.Y);
  1612. end;
  1613. procedure TCodeEditor.BackSpace;
  1614. var S,PreS: string;
  1615. RX,CP: Sw_integer;
  1616. begin
  1617. if IsReadOnly then Exit;
  1618. if CurPos.X=0 then
  1619. begin
  1620. if CurPos.Y>0 then
  1621. begin
  1622. S:=GetLineText(CurPos.Y-1);
  1623. SetLineText(CurPos.Y-1,S+GetLineText(CurPos.Y));
  1624. Lines^.AtDelete(CurPos.Y);
  1625. LimitsChanged;
  1626. SetCurPtr(length(S),CurPos.Y-1);
  1627. end;
  1628. end
  1629. else
  1630. begin
  1631. S:=GetLineText(CurPos.Y);
  1632. RX:=GetLineTextPos(CurPos.Y,CurPos.X);
  1633. CP:=RX-1;
  1634. if (Flags and efBackspaceUnindents)<>0 then
  1635. begin
  1636. if CurPos.Y>0 then
  1637. PreS:=GetLineText(CurPos.Y)
  1638. else
  1639. PreS:='';
  1640. PreS:=RExpand(PreS,255);
  1641. while (CP>0) and (S[CP]=' ') and (PreS[CP]<>' ') do
  1642. Dec(CP);
  1643. end;
  1644. SetLineText(CurPos.Y,copy(S,1,CP)+copy(S,RX+1,255));
  1645. SetCurPtr(GetDisplayTextPos(CurPos.Y,CP),CurPos.Y);
  1646. end;
  1647. UpdateAttrs(CurPos.Y,attrAll);
  1648. DrawLines(CurPos.Y);
  1649. Modified:=true;
  1650. UpdateIndicator;
  1651. end;
  1652. procedure TCodeEditor.DelChar;
  1653. var S: string;
  1654. begin
  1655. if IsReadOnly then Exit;
  1656. S:=GetLineText(CurPos.Y);
  1657. if CurPos.X=length(S) then
  1658. begin
  1659. if CurPos.Y<GetLineCount-1 then
  1660. begin
  1661. SetLineText(CurPos.Y,S+GetLineText(CurPos.Y+1));
  1662. DeleteLine(CurPos.Y+1);
  1663. LimitsChanged;
  1664. end;
  1665. end
  1666. else
  1667. begin
  1668. Delete(S,CurPos.X+1,1);
  1669. SetLineText(CurPos.Y,S);
  1670. end;
  1671. UpdateAttrs(CurPos.Y,attrAll);
  1672. DrawLines(CurPos.Y);
  1673. Modified:=true;
  1674. UpdateIndicator;
  1675. end;
  1676. procedure TCodeEditor.DelWord;
  1677. begin
  1678. if IsReadOnly then Exit;
  1679. Modified:=true;
  1680. UpdateIndicator;
  1681. end;
  1682. procedure TCodeEditor.DelStart;
  1683. begin
  1684. if IsReadOnly then Exit;
  1685. Modified:=true;
  1686. UpdateIndicator;
  1687. end;
  1688. procedure TCodeEditor.DelEnd;
  1689. var S: string;
  1690. begin
  1691. if IsReadOnly then Exit;
  1692. S:=GetLineText(CurPos.Y);
  1693. if (S<>'') and (CurPos.X<>length(S)) then
  1694. begin
  1695. SetLineText(CurPos.Y,copy(S,1,CurPos.X));
  1696. UpdateAttrs(CurPos.Y,attrAll);
  1697. DrawLines(CurPos.Y);
  1698. Modified:=true;
  1699. UpdateIndicator;
  1700. end;
  1701. end;
  1702. procedure TCodeEditor.DelLine;
  1703. begin
  1704. if IsReadOnly then Exit;
  1705. if GetLineCount>0 then
  1706. begin
  1707. DeleteLine(CurPos.Y);
  1708. LimitsChanged;
  1709. SetCurPtr(0,CurPos.Y);
  1710. UpdateAttrs(Max(0,CurPos.Y-1),attrAll);
  1711. DrawLines(CurPos.Y);
  1712. Modified:=true;
  1713. UpdateIndicator;
  1714. end;
  1715. end;
  1716. procedure TCodeEditor.InsMode;
  1717. begin
  1718. SetInsertMode(Overwrite);
  1719. end;
  1720. procedure TCodeEditor.StartSelect;
  1721. begin
  1722. if (PointOfs(SelStart)=PointOfs(SelEnd)) then
  1723. SetSelection(SelStart,Limit);
  1724. SetSelection(CurPos,SelEnd);
  1725. if PointOfs(SelEnd)<PointOfs(SelStart) then
  1726. SetSelection(SelStart,SelStart);
  1727. CheckSels;
  1728. DrawView;
  1729. end;
  1730. function TCodeEditor.GetCurrentWord : string;
  1731. const WordChars = ['A'..'Z','a'..'z','0'..'9','_'];
  1732. var P : TPoint;
  1733. S : String;
  1734. StartPos,EndPos : byte;
  1735. begin
  1736. P:=CurPos;
  1737. S:=GetLineText(P.Y);
  1738. StartPos:=P.X+1;
  1739. EndPos:=StartPos;
  1740. if not (S[StartPos] in WordChars) then
  1741. GetCurrentWord:=''
  1742. else
  1743. begin
  1744. While (StartPos>0) and (S[StartPos-1] in WordChars) do
  1745. Dec(StartPos);
  1746. While (EndPos<Length(S)) and (S[EndPos+1] in WordChars) do
  1747. Inc(EndPos);
  1748. GetCurrentWord:=Copy(S,StartPos,EndPos-StartPos+1);
  1749. end;
  1750. end;
  1751. procedure TCodeEditor.EndSelect;
  1752. var P: TPoint;
  1753. begin
  1754. P:=CurPos; P.X:=Min(SelEnd.X,length(GetLineText(SelEnd.Y))); CheckSels;
  1755. SetSelection(SelStart,P);
  1756. DrawView;
  1757. end;
  1758. procedure TCodeEditor.DelSelect;
  1759. var LineDelta, LineCount, CurLine: Sw_integer;
  1760. StartX,EndX,LastX: Sw_integer;
  1761. S: string;
  1762. begin
  1763. if IsReadOnly then Exit;
  1764. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  1765. LineCount:=(SelEnd.Y-SelStart.Y)+1;
  1766. LineDelta:=0; LastX:=CurPos.X;
  1767. CurLine:=SelStart.Y;
  1768. while (LineDelta<LineCount) do
  1769. begin
  1770. S:=GetDisplayText(CurLine);
  1771. if LineDelta=0 then StartX:=SelStart.X else StartX:=0;
  1772. if LineDelta=LineCount-1 then EndX:=SelEnd.X else EndX:=length(S);
  1773. if (LineDelta<LineCount-1) and
  1774. ( (StartX=0) and (EndX>=length(S)) )
  1775. then begin
  1776. DeleteLine(CurLine);
  1777. if CurLine>0 then LastX:=length(GetDisplayText(CurLine-1))
  1778. else LastX:=0;
  1779. end
  1780. else begin
  1781. SetDisplayText(CurLine,copy(S,1,StartX)+copy(S,EndX+1,255));
  1782. LastX:=StartX;
  1783. if (StartX=0) and (0<LineDelta) and
  1784. not(((LineDelta=LineCount-1) and (StartX=0) and (StartX=EndX))) then
  1785. begin
  1786. S:=GetDisplayText(CurLine-1);
  1787. SetDisplayText(CurLine-1,S+GetLineText(CurLine));
  1788. DeleteLine(CurLine);
  1789. LastX:=length(S);
  1790. end else
  1791. Inc(CurLine);
  1792. end;
  1793. Inc(LineDelta);
  1794. end;
  1795. SetCurPtr(LastX,CurLine-1);
  1796. HideSelect;
  1797. UpdateAttrs(CurPos.Y,attrAll);
  1798. DrawLines(CurPos.Y);
  1799. Modified:=true;
  1800. UpdateIndicator;
  1801. end;
  1802. procedure TCodeEditor.HideSelect;
  1803. begin
  1804. SetSelection(CurPos,CurPos);
  1805. end;
  1806. procedure TCodeEditor.CopyBlock;
  1807. var Temp: PCodeEditor;
  1808. R: TRect;
  1809. begin
  1810. if IsReadOnly then Exit;
  1811. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  1812. GetExtent(R);
  1813. New(Temp, Init(R, nil, nil, nil,0));
  1814. Temp^.InsertFrom(@Self);
  1815. InsertFrom(Temp);
  1816. Dispose(Temp, Done);
  1817. end;
  1818. procedure TCodeEditor.MoveBlock;
  1819. var Temp: PCodeEditor;
  1820. R: TRect;
  1821. OldPos: TPoint;
  1822. begin
  1823. if IsReadOnly then Exit;
  1824. if (SelStart.X=SelEnd.X) and (SelStart.Y=SelEnd.Y) then Exit;
  1825. GetExtent(R);
  1826. New(Temp, Init(R, nil, nil, nil,0));
  1827. Temp^.InsertFrom(@Self);
  1828. OldPos:=CurPos; Dec(OldPos.Y,Temp^.GetLineCount-1);
  1829. DelSelect;
  1830. SetCurPtr(OldPos.X,OldPos.Y);
  1831. InsertFrom(Temp);
  1832. Dispose(Temp, Done);
  1833. end;
  1834. procedure TCodeEditor.AddChar(C: char);
  1835. const OpenBrackets : string[10] = '[({';
  1836. CloseBrackets : string[10] = '])}';
  1837. var S: string;
  1838. BI: byte;
  1839. RX : Sw_integer;
  1840. begin
  1841. if IsReadOnly then Exit;
  1842. S:=GetLineText(CurPos.Y);
  1843. RX:=GetLineTextPos(CurPos.Y,CurPos.X);
  1844. if Overwrite and (RX<length(S)) then
  1845. SetLineText(CurPos.Y,copy(S,1,RX)+C+copy(S,RX+2,255))
  1846. else
  1847. SetLineText(CurPos.Y,RExpand(copy(S,1,RX),RX)+C+copy(S,RX+1,255));
  1848. Curpos.X:=GetDisplayTextPos(CurPos.Y,RX);
  1849. if PointOfs(SelStart)<>PointOfs(SelEnd) then
  1850. if (CurPos.Y=SelEnd.Y) and (CurPos.X<SelEnd.X) then
  1851. Inc(SelEnd.X);
  1852. CharRight;
  1853. BI:=Pos(C,OpenBrackets);
  1854. if ((Flags and efAutoBrackets)<>0) and (BI>0) then
  1855. begin
  1856. AddChar(CloseBrackets[BI]);
  1857. SetCurPtr(CurPos.X-1,CurPos.Y);
  1858. end;
  1859. UpdateAttrs(CurPos.Y,attrAll);
  1860. DrawLines(CurPos.Y);
  1861. Modified:=true;
  1862. UpdateIndicator;
  1863. end;
  1864. function TCodeEditor.ClipCopy: Boolean;
  1865. var OK: boolean;
  1866. begin
  1867. OK:=Clipboard<>nil;
  1868. if OK then OK:=Clipboard^.InsertFrom(@Self);
  1869. ClipCopy:=OK;
  1870. end;
  1871. procedure TCodeEditor.ClipCut;
  1872. begin
  1873. if IsReadOnly then Exit;
  1874. if Clipboard<>nil then
  1875. if Clipboard^.InsertFrom(@Self) then
  1876. begin
  1877. DelSelect;
  1878. Modified:=true;
  1879. UpdateIndicator;
  1880. end;
  1881. end;
  1882. procedure TCodeEditor.ClipPaste;
  1883. begin
  1884. if IsReadOnly then Exit;
  1885. if Clipboard<>nil then
  1886. begin
  1887. InsertFrom(Clipboard);
  1888. Modified:=true;
  1889. UpdateIndicator;
  1890. end;
  1891. end;
  1892. procedure TCodeEditor.Undo;
  1893. begin
  1894. end;
  1895. procedure TCodeEditor.GotoLine;
  1896. var
  1897. GotoRec: TGotoLineDialogRec;
  1898. begin
  1899. with GotoRec do
  1900. begin
  1901. LineNo:='1';
  1902. Lines:=GetLineCount;
  1903. if EditorDialog(edGotoLine, @GotoRec) <> cmCancel then
  1904. begin
  1905. SetCurPtr(0,StrToInt(LineNo)-1);
  1906. TrackCursor(true);
  1907. end;
  1908. end;
  1909. end;
  1910. procedure TCodeEditor.Find;
  1911. var
  1912. FindRec: TFindDialogRec;
  1913. DoConf: boolean;
  1914. begin
  1915. with FindRec do
  1916. begin
  1917. Find := FindStr;
  1918. if GetCurrentWord<>'' then
  1919. Find:=GetCurrentWord;
  1920. Options := (FindFlags and ffmOptions) shr ffsOptions;
  1921. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  1922. Scope := (FindFlags and ffmScope) shr ffsScope;
  1923. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  1924. DoConf:= (FindFlags and ffPromptOnReplace)<>0;
  1925. if EditorDialog(edFind, @FindRec) <> cmCancel then
  1926. begin
  1927. FindStr := Find;
  1928. FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
  1929. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  1930. FindFlags := FindFlags and not ffDoReplace;
  1931. if DoConf then
  1932. FindFlags := (FindFlags or ffPromptOnReplace);
  1933. SearchRunCount:=0;
  1934. DoSearchReplace;
  1935. end;
  1936. end;
  1937. end;
  1938. procedure TCodeEditor.Replace;
  1939. var
  1940. ReplaceRec: TReplaceDialogRec;
  1941. Re: word;
  1942. begin
  1943. if IsReadOnly then Exit;
  1944. with ReplaceRec do
  1945. begin
  1946. Find := FindStr;
  1947. if GetCurrentWord<>'' then
  1948. Find:=GetCurrentWord;
  1949. Replace := ReplaceStr;
  1950. Options := (FindFlags and ffmOptions) shr ffsOptions;
  1951. Direction := (FindFlags and ffmDirection) shr ffsDirection;
  1952. Scope := (FindFlags and ffmScope) shr ffsScope;
  1953. Origin := (FindFlags and ffmOrigin) shr ffsOrigin;
  1954. Re:=EditorDialog(edReplace, @ReplaceRec);
  1955. if Re <> cmCancel then
  1956. begin
  1957. FindStr := Find;
  1958. ReplaceStr := Replace;
  1959. FindFlags := (Options shl ffsOptions) or (Direction shl ffsDirection) or
  1960. (Scope shl ffsScope) or (Origin shl ffsOrigin);
  1961. FindFlags := FindFlags or ffDoReplace;
  1962. if Re = cmYes then
  1963. FindFlags := FindFlags or ffReplaceAll;
  1964. SearchRunCount:=0;
  1965. DoSearchReplace;
  1966. end;
  1967. end;
  1968. end;
  1969. procedure TCodeEditor.DoSearchReplace;
  1970. var S: string;
  1971. DX,DY,P,Y,X: integer;
  1972. Count: integer;
  1973. Found,CanExit: boolean;
  1974. SForward,DoReplace,DoReplaceAll: boolean;
  1975. LeftOK,RightOK: boolean;
  1976. FoundCount: integer;
  1977. A,B: TPoint;
  1978. AreaStart,AreaEnd: TPoint;
  1979. CanReplace,Confirm: boolean;
  1980. Re: word;
  1981. IFindStr : string;
  1982. BT : BTable;
  1983. function ContainsText(const SubS:string;var S: string; Start: Sw_word): Sw_integer;
  1984. var
  1985. P: Sw_Integer;
  1986. begin
  1987. if Start<=0 then
  1988. P:=0
  1989. else
  1990. begin
  1991. if SForward then
  1992. begin
  1993. if FindFlags and ffCaseSensitive<>0 then
  1994. P:=BMFScan(S[Start],length(s)+1-Start,FindStr,Bt)+1
  1995. else
  1996. P:=BMFIScan(S[Start],length(s)+1-Start,IFindStr,Bt)+1;
  1997. if P>0 then
  1998. Inc(P,Start-1);
  1999. end
  2000. else
  2001. begin
  2002. if start>length(s) then
  2003. start:=length(s);
  2004. if FindFlags and ffCaseSensitive<>0 then
  2005. P:=BMBScan(S[1],Start,FindStr,Bt)+1
  2006. else
  2007. P:=BMBIScan(S[1],Start,IFindStr,Bt)+1;
  2008. end;
  2009. end;
  2010. ContainsText:=P;
  2011. end;
  2012. function InArea(X,Y: integer): boolean;
  2013. begin
  2014. InArea:=((AreaStart.Y=Y) and (AreaStart.X<=X)) or
  2015. ((AreaStart.Y<Y) and (Y<AreaEnd.Y)) or
  2016. ((AreaEnd.Y=Y) and (X<=AreaEnd.X));
  2017. end;
  2018. begin
  2019. Inc(SearchRunCount);
  2020. SForward:=(FindFlags and ffmDirection)=ffForward;
  2021. DoReplace:=(FindFlags and ffDoReplace)<>0;
  2022. Confirm:=(FindFlags and ffPromptOnReplace)<>0;
  2023. DoReplaceAll:=(FindFlags and ffReplaceAll)<>0;
  2024. Count:=GetLineCount; FoundCount:=0;
  2025. if SForward then
  2026. DY:=1
  2027. else
  2028. DY:=-1;
  2029. DX:=DY;
  2030. if (FindFlags and ffmScope)=ffGlobal then
  2031. begin
  2032. AreaStart.X:=0;
  2033. AreaStart.Y:=0;
  2034. AreaEnd.X:=length(GetDisplayText(Count-1));
  2035. AreaEnd.Y:=Count-1;
  2036. end
  2037. else
  2038. begin
  2039. AreaStart:=SelStart;
  2040. AreaEnd:=SelEnd;
  2041. end;
  2042. X:=CurPos.X-DX;
  2043. Y:=CurPos.Y;;
  2044. if SearchRunCount=1 then
  2045. if (FindFlags and ffmOrigin)=ffEntireScope then
  2046. if SForward then
  2047. begin
  2048. X:=AreaStart.X-1;
  2049. Y:=AreaStart.Y;
  2050. end
  2051. else
  2052. begin
  2053. X:=AreaEnd.X+1;
  2054. Y:=AreaEnd.Y;
  2055. end;
  2056. if FindFlags and ffCaseSensitive<>0 then
  2057. begin
  2058. if SForward then
  2059. BMFMakeTable(FindStr,bt)
  2060. else
  2061. BMBMakeTable(FindStr,bt);
  2062. end
  2063. else
  2064. begin
  2065. IFindStr:=Upper(FindStr);
  2066. if SForward then
  2067. BMFMakeTable(IFindStr,bt)
  2068. else
  2069. BMBMakeTable(IFindStr,bt);
  2070. end;
  2071. inc(X,DX);
  2072. CanExit:=false;
  2073. if DoReplace and (Confirm=false) and (Owner<>nil) then
  2074. Owner^.Lock;
  2075. if InArea(X,Y) then
  2076. repeat
  2077. S:=GetDisplayText(Y);
  2078. P:=ContainsText(FindStr,S,X+1);
  2079. Found:=P<>0;
  2080. if Found then
  2081. begin
  2082. A.X:=P-1;
  2083. A.Y:=Y;
  2084. B.Y:=Y;
  2085. B.X:=A.X+length(FindStr);
  2086. end;
  2087. Found:=Found and InArea(A.X,A.Y);
  2088. if Found and ((FindFlags and ffWholeWordsOnly)<>0) then
  2089. begin
  2090. LeftOK:=(A.X<=0) or (not( (S[A.X] in AlphaChars) or (S[A.X] in NumberChars) ));
  2091. RightOK:=(B.X>=length(S)) or (not( (S[B.X+1] in AlphaChars) or (S[B.X+1] in NumberChars) ));
  2092. Found:=LeftOK and RightOK;
  2093. end;
  2094. if Found then
  2095. Inc(FoundCount);
  2096. if Found then
  2097. begin
  2098. if SForward then
  2099. SetCurPtr(B.X,B.Y)
  2100. else
  2101. SetCurPtr(A.X,A.Y);
  2102. TrackCursor(true);
  2103. SetHighlight(A,B);
  2104. if (DoReplace=false) then CanExit:=true else
  2105. begin
  2106. if Confirm=false then CanReplace:=true else
  2107. begin
  2108. Re:=EditorDialog(edReplacePrompt,@CurPos);
  2109. case Re of
  2110. cmYes :
  2111. CanReplace:=true;
  2112. cmNo :
  2113. CanReplace:=false;
  2114. else {cmCancel}
  2115. begin
  2116. CanReplace:=false;
  2117. CanExit:=true;
  2118. end;
  2119. end;
  2120. end;
  2121. if CanReplace then
  2122. begin
  2123. if Owner<>nil then
  2124. Owner^.Lock;
  2125. SetSelection(A,B);
  2126. DelSelect;
  2127. InsertText(ReplaceStr);
  2128. if Owner<>nil then
  2129. Owner^.UnLock;
  2130. end;
  2131. if (DoReplaceAll=false) then
  2132. CanExit:=true;
  2133. end;
  2134. end;
  2135. if CanExit=false then
  2136. begin
  2137. inc(Y,DY);
  2138. if SForward then
  2139. X:=0
  2140. else
  2141. X:=254;
  2142. CanExit:=(Y>=Count) or (Y<0);
  2143. end;
  2144. if not CanExit then
  2145. CanExit:=not InArea(X,Y);
  2146. until CanExit;
  2147. if (FoundCount=0) or (DoReplace) then
  2148. SetHighlight(CurPos,CurPos);
  2149. if DoReplace and (Confirm=false) and (Owner<>nil) then
  2150. Owner^.UnLock;
  2151. if (FoundCount=0) then
  2152. EditorDialog(edSearchFailed,nil);
  2153. end;
  2154. procedure TCodeEditor.SetInsertMode(InsertMode: boolean);
  2155. begin
  2156. if InsertMode then Flags:=Flags or efInsertMode
  2157. else Flags:=Flags and (not efInsertMode);
  2158. DrawCursor;
  2159. end;
  2160. procedure TCodeEditor.SetCurPtr(X,Y: integer);
  2161. var OldPos,OldSEnd,OldSStart: TPoint;
  2162. Extended: boolean;
  2163. begin
  2164. X:=Max(0,Min(MaxLineLength+1,X));
  2165. Y:=Max(0,Min(GetLineCount-1,Y));
  2166. OldPos:=CurPos;
  2167. OldSEnd:=SelEnd;
  2168. OldSStart:=SelStart;
  2169. CurPos.X:=X;
  2170. CurPos.Y:=Y;
  2171. TrackCursor(false);
  2172. if (NoSelect=false) and ((GetShiftState and kbShift)<>0) then
  2173. begin
  2174. CheckSels;
  2175. Extended:=false;
  2176. if PointOfs(OldPos)=PointOfs(SelStart) then
  2177. begin SetSelection(CurPos,SelEnd); Extended:=true; end;
  2178. CheckSels;
  2179. if Extended=false then
  2180. if PointOfs(OldPos)=PointOfs(SelEnd) then
  2181. begin SetSelection(SelStart,CurPos); Extended:=true; end;
  2182. CheckSels;
  2183. if (Extended=false) then
  2184. if PointOfs(OldPos)<=PointOfs(CurPos)
  2185. then begin SetSelection(OldPos,CurPos); Extended:=true; end
  2186. else begin SetSelection(CurPos,OldPos); Extended:=true; end;
  2187. DrawView;
  2188. end else
  2189. if (Flags and efPersistentBlocks)=0 then
  2190. begin HideSelect; DrawView; end;
  2191. if PointOfs(SelStart)=PointOfs(SelEnd) then
  2192. SetSelection(CurPos,CurPos);
  2193. if (Flags and (efHighlightColumn+efHighlightRow))<>0 then
  2194. DrawView;
  2195. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and
  2196. ((Highlight.A.X<>HighLight.B.X) or (Highlight.A.Y<>HighLight.B.Y)) then
  2197. HideHighlight;
  2198. if (OldPos.Y<>CurPos.Y) and (0<=OldPos.Y) and (OldPos.Y<GetLineCount) then
  2199. SetLineText(OldPos.Y,RTrim(GetLineText(OldPos.Y)));
  2200. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (GetErrorMessage<>'') then
  2201. SetErrorMessage('');
  2202. if ((CurPos.X<>OldPos.X) or (CurPos.Y<>OldPos.Y)) and (HighlightRow<>-1) then
  2203. SetHighlightRow(-1);
  2204. end;
  2205. procedure TCodeEditor.CheckSels;
  2206. begin
  2207. if (SelStart.Y>SelEnd.Y) or
  2208. ( (SelStart.Y=SelEnd.Y) and (SelStart.X>SelEnd.X) ) then
  2209. SetSelection(SelEnd,SelStart);
  2210. end;
  2211. function TCodeEditor.UpdateAttrs(FromLine: integer; Attrs: byte): integer;
  2212. type
  2213. TCharClass = (ccWhiteSpace,ccTab,ccAlpha,ccNumber,ccSymbol);
  2214. var
  2215. SymbolIndex: Sw_integer;
  2216. CurrentCommentType : Byte;
  2217. LastCC: TCharClass;
  2218. InAsm,InComment,InSingleLineComment,InDirective,InString: boolean;
  2219. X,ClassStart: Sw_integer;
  2220. SymbolConcat: string;
  2221. LineText,Format: string;
  2222. function MatchSymbol(const What, S: string): boolean;
  2223. var Match: boolean;
  2224. begin
  2225. Match:=false;
  2226. if length(What)>=length(S) then
  2227. if copy(What,1+length(What)-length(S),length(S))=S then
  2228. Match:=true;
  2229. MatchSymbol:=Match;
  2230. end;
  2231. var MatchedSymbol: boolean;
  2232. MatchingSymbol: string;
  2233. function MatchesAnySpecSymbol(const What: string; SClass: TSpecSymbolClass; PartialMatch: boolean): boolean;
  2234. var S: string;
  2235. I: Sw_integer;
  2236. Match,Found: boolean;
  2237. begin
  2238. Found:=false;
  2239. if What<>'' then
  2240. for I:=1 to GetSpecSymbolCount(SClass) do
  2241. begin
  2242. SymbolIndex:=I;
  2243. S:=GetSpecSymbol(SClass,I-1);
  2244. if PartialMatch then Match:=MatchSymbol(What,S)
  2245. else Match:=What=S;
  2246. if Match then
  2247. begin MatchingSymbol:=S; Found:=true; Break; end;
  2248. end;
  2249. MatchedSymbol:=MatchedSymbol or Found;
  2250. MatchesAnySpecSymbol:=Found;
  2251. end;
  2252. function IsCommentPrefix: boolean;
  2253. begin
  2254. IsCommentPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentPrefix,true);
  2255. end;
  2256. function IsSingleLineCommentPrefix: boolean;
  2257. begin
  2258. IsSingleLineCommentPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssCommentSingleLinePrefix,true);
  2259. end;
  2260. function IsCommentSuffix: boolean;
  2261. begin
  2262. IsCommentSuffix:=(MatchesAnySpecSymbol(SymbolConcat,ssCommentSuffix,true))
  2263. and (CurrentCommentType=SymbolIndex);
  2264. end;
  2265. function IsStringPrefix: boolean;
  2266. begin
  2267. IsStringPrefix:=MatchesAnySpecSymbol(SymbolConcat,ssStringPrefix,true);
  2268. end;
  2269. function IsStringSuffix: boolean;
  2270. begin
  2271. IsStringSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssStringSuffix,true);
  2272. end;
  2273. function IsDirectivePrefix: boolean;
  2274. begin
  2275. IsDirectivePrefix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectivePrefix,true);
  2276. end;
  2277. function IsDirectiveSuffix: boolean;
  2278. begin
  2279. IsDirectiveSuffix:=MatchesAnySpecSymbol(SymbolConcat,ssDirectiveSuffix,true);
  2280. end;
  2281. function IsAsmPrefix(const WordS: string): boolean;
  2282. begin
  2283. IsAsmPrefix:=MatchesAnySpecSymbol(WordS,ssAsmPrefix,false);
  2284. end;
  2285. function IsAsmSuffix(const WordS: string): boolean;
  2286. begin
  2287. IsAsmSuffix:=MatchesAnySpecSymbol(WordS,ssAsmSuffix,false);
  2288. end;
  2289. function GetCharClass(C: char): TCharClass;
  2290. var CC: TCharClass;
  2291. begin
  2292. if C in WhiteSpaceChars then CC:=ccWhiteSpace else
  2293. if C in TabChars then CC:=ccTab else
  2294. if C in AlphaChars then CC:=ccAlpha else
  2295. if C in NumberChars then CC:=ccNumber else
  2296. CC:=ccSymbol;
  2297. GetCharClass:=CC;
  2298. end;
  2299. procedure FormatWord(SClass: TCharClass; StartX:Sw_integer;EndX: Sw_integer);
  2300. var
  2301. C: byte;
  2302. WordS: string;
  2303. begin
  2304. C:=0;
  2305. WordS:=copy(LineText,StartX,EndX-StartX+1);
  2306. if IsAsmSuffix(WordS) and (InAsm=true) and (InComment=false) and
  2307. (InString=false) and (InDirective=false) then InAsm:=false;
  2308. if InDirective then C:=coDirectiveColor else
  2309. if InComment then C:=coCommentColor else
  2310. if InString then C:=coStringColor else
  2311. if InAsm then C:=coAssemblerColor else
  2312. case SClass of
  2313. ccWhiteSpace : C:=coWhiteSpaceColor;
  2314. ccTab : C:=coTabColor;
  2315. ccNumber : if copy(WordS,1,1)='$' then
  2316. C:=coHexNumberColor
  2317. else
  2318. C:=coNumberColor;
  2319. ccSymbol : C:=coSymbolColor;
  2320. ccAlpha :
  2321. begin
  2322. if IsReservedWord(WordS) then
  2323. C:=coReservedWordColor
  2324. else
  2325. C:=coIdentifierColor;
  2326. end;
  2327. end;
  2328. if EndX+1>=StartX then
  2329. FillChar(Format[StartX],EndX+1-StartX,C);
  2330. if IsAsmPrefix(WordS) and
  2331. (InAsm=false) and (InComment=false) and (InDirective=false) then
  2332. InAsm:=true;
  2333. end;
  2334. procedure ProcessChar(C: char);
  2335. var CC: TCharClass;
  2336. EX: Sw_integer;
  2337. begin
  2338. CC:=GetCharClass(C);
  2339. if ( (CC<>LastCC) and
  2340. ( (CC<>ccAlpha) or (LastCC<>ccNumber) ) and
  2341. ( (CC<>ccNumber) or (LastCC<>ccAlpha) )
  2342. ) or
  2343. (X>length(LineText)) or (CC=ccSymbol) then
  2344. begin
  2345. MatchedSymbol:=false;
  2346. EX:=X-1;
  2347. if (CC=ccSymbol) then
  2348. begin
  2349. if length(SymbolConcat)>=High(SymbolConcat) then
  2350. Delete(SymbolConcat,1,1);
  2351. SymbolConcat:=SymbolConcat+C;
  2352. end;
  2353. case CC of
  2354. ccSymbol :
  2355. if IsCommentSuffix and (InComment) then
  2356. Inc(EX) else
  2357. if IsStringSuffix and (InString) then
  2358. Inc(EX) else
  2359. if IsDirectiveSuffix and (InDirective) then
  2360. Inc(EX);
  2361. end;
  2362. if (C='$') and (MatchedSymbol=false) and (IsDirectivePrefix=false) then
  2363. CC:=ccNumber;
  2364. if CC<>ccSymbol then SymbolConcat:='';
  2365. FormatWord(LastCC,ClassStart,EX);
  2366. ClassStart:=EX+1;
  2367. case CC of
  2368. ccAlpha : ;
  2369. ccNumber :
  2370. if (LastCC<>ccAlpha) then;
  2371. ccSymbol :
  2372. if IsDirectivePrefix {and (InComment=false)} and (InDirective=false) then
  2373. begin InDirective:=true; InComment:=false; Dec(ClassStart,length(MatchingSymbol)-1); end else
  2374. if IsDirectiveSuffix and (InComment=false) and (InDirective=true) then
  2375. InDirective:=false else
  2376. if IsCommentPrefix and (InComment=false) and (InString=false) then
  2377. begin
  2378. InComment:=true;
  2379. CurrentCommentType:=SymbolIndex;
  2380. InSingleLineComment:=IsSingleLineCommentPrefix;
  2381. {InString:=false; }
  2382. Dec(ClassStart,length(MatchingSymbol)-1);
  2383. end
  2384. else if IsCommentSuffix and (InComment) then
  2385. begin InComment:=false; InString:=false; end else
  2386. if IsStringPrefix and (InComment=false) and (InString=false) then
  2387. begin InString:=true; Dec(ClassStart,length(MatchingSymbol)-1); end else
  2388. if IsStringSuffix and (InComment=false) and (InString=true) then
  2389. InString:=false;
  2390. end;
  2391. if MatchedSymbol and (InComment=false) then
  2392. SymbolConcat:='';
  2393. LastCC:=CC;
  2394. end;
  2395. end;
  2396. var CurLine: Sw_integer;
  2397. Line,NextLine,PrevLine,OldLine: PLine;
  2398. begin
  2399. if ((Flags and efSyntaxHighlight)=0) or (FromLine>=GetLineCount) then
  2400. begin
  2401. SetLineFormat(FromLine,'');
  2402. UpdateAttrs:=GetLineCount-1;
  2403. Exit;
  2404. end;
  2405. CurLine:=FromLine;
  2406. if CurLine>0 then PrevLine:=Lines^.At(CurLine-1) else PrevLine:=nil;
  2407. repeat
  2408. Line:=Lines^.At(CurLine);
  2409. if PrevLine<>nil then
  2410. begin
  2411. InAsm:=PrevLine^.EndsWithAsm;
  2412. InComment:=PrevLine^.EndsWithComment and not PrevLine^.EndsInSingleLineComment;
  2413. CurrentCommentType:=PrevLine^.EndCommentType;
  2414. InDirective:=PrevLine^.EndsWithDirective;
  2415. end
  2416. else
  2417. begin
  2418. InAsm:=false;
  2419. InComment:=false;
  2420. CurrentCommentType:=0;
  2421. InDirective:=false;
  2422. end;
  2423. OldLine:=Line;
  2424. Line^.BeginsWithAsm:=InAsm;
  2425. Line^.BeginsWithComment:=InComment;
  2426. Line^.BeginsWithDirective:=InDirective;
  2427. LineText:=GetLineText(CurLine);
  2428. Format:=CharStr(chr(coTextColor),length(LineText));
  2429. LastCC:=ccWhiteSpace;
  2430. ClassStart:=1;
  2431. SymbolConcat:='';
  2432. InString:=false;
  2433. if LineText<>'' then
  2434. begin
  2435. for X:=1 to length(LineText) do
  2436. ProcessChar(LineText[X]);
  2437. inc(X);
  2438. ProcessChar(' ');
  2439. end;
  2440. SetLineFormat(CurLine,Format);
  2441. Line^.EndsWithAsm:=InAsm;
  2442. Line^.EndsWithComment:=InComment;
  2443. Line^.EndsInSingleLineComment:=InSingleLineComment;
  2444. Line^.EndCommentType:=CurrentCommentType;
  2445. Line^.EndsWithDirective:=InDirective;
  2446. Inc(CurLine);
  2447. if CurLine>=GetLineCount then
  2448. Break;
  2449. NextLine:=Lines^.At(CurLine);
  2450. if (Attrs and attrForceFull)=0 then
  2451. if (InAsm=false) and (NextLine^.BeginsWithAsm=false) and
  2452. (InComment=false) and (NextLine^.BeginsWithComment=false) and
  2453. (InDirective=false) and (NextLine^.BeginsWithDirective=false) and
  2454. (OldLine^.EndsWithComment=Line^.EndsWithComment) and
  2455. (OldLine^.EndsWithAsm=Line^.EndsWithAsm) and
  2456. (OldLine^.EndsWithDirective=Line^.EndsWithDirective) and
  2457. (NextLine^.BeginsWithAsm=Line^.EndsWithAsm) and
  2458. (NextLine^.BeginsWithComment=Line^.EndsWithComment) and
  2459. (NextLine^.BeginsWithDirective=Line^.EndsWithDirective) and
  2460. (NextLine^.Format<>nil)
  2461. then Break;
  2462. PrevLine:=Line;
  2463. until false;
  2464. UpdateAttrs:=CurLine;
  2465. end;
  2466. procedure TCodeEditor.DrawLines(FirstLine: integer);
  2467. begin
  2468. DrawView;
  2469. end;
  2470. function TCodeEditor.InsertText(const S: string): Boolean;
  2471. var I: integer;
  2472. begin
  2473. for I:=1 to length(S) do
  2474. AddChar(S[I]);
  2475. InsertText:=true;
  2476. end;
  2477. function TCodeEditor.InsertFrom(Editor: PCodeEditor): Boolean;
  2478. var OK: boolean;
  2479. LineDelta,LineCount: Sw_integer;
  2480. StartPos,DestPos: TPoint;
  2481. LineStartX,LineEndX: Sw_integer;
  2482. S,OrigS: string;
  2483. VerticalBlock: boolean;
  2484. SEnd: TPoint;
  2485. begin
  2486. OK:=(Editor^.SelStart.X<>Editor^.SelEnd.X) or (Editor^.SelStart.Y<>Editor^.SelEnd.Y);
  2487. if OK then
  2488. begin
  2489. StartPos:=CurPos; DestPos:=CurPos;
  2490. VerticalBlock:=(Editor^.Flags and efVerticalBlocks)<>0;
  2491. LineDelta:=0; LineCount:=(Editor^.SelEnd.Y-Editor^.SelStart.Y)+1;
  2492. OK:=GetLineCount<MaxLineCount;
  2493. while OK and (LineDelta<LineCount) do
  2494. begin
  2495. if (LineDelta<LineCount-1) and (VerticalBlock=false) then
  2496. if (LineDelta<>0) or (Editor^.SelEnd.X=0) then
  2497. begin Lines^.AtInsert(DestPos.Y,NewLine('')); LimitsChanged; end;
  2498. if (LineDelta=0) or VerticalBlock
  2499. then LineStartX:=Editor^.SelStart.X else LineStartX:=0;
  2500. if (LineDelta=LineCount-1) or VerticalBlock
  2501. then LineEndX:=Editor^.SelEnd.X-1 else LineEndX:=255;
  2502. if LineEndX<=LineStartX then S:='' else
  2503. S:=RExpand(
  2504. copy(Editor^.GetLineText(Editor^.SelStart.Y+LineDelta),LineStartX+1,LineEndX-LineStartX+1),
  2505. Min(LineEndX-LineStartX+1,255));
  2506. if VerticalBlock=false then
  2507. begin
  2508. OrigS:=GetDisplayText(DestPos.Y);
  2509. SetLineText(DestPos.Y,RExpand(copy(OrigS,1,DestPos.X),DestPos.X)+S+copy(OrigS,DestPos.X+1,255));
  2510. if LineDelta=LineCount-1 then
  2511. begin SEnd.Y:=DestPos.Y; SEnd.X:=DestPos.X+length(S); end else
  2512. begin Inc(DestPos.Y); DestPos.X:=0; end;
  2513. end else
  2514. begin
  2515. S:=RExpand(S,LineEndX-LineStartX+1);
  2516. end;
  2517. Inc(LineDelta);
  2518. OK:=GetLineCount<MaxLineCount;
  2519. end;
  2520. if OK=false then EditorDialog(edTooManyLines,nil);
  2521. UpdateAttrs(StartPos.Y,attrAll);
  2522. LimitsChanged;
  2523. SetSelection(CurPos,SEnd);
  2524. if IsClipboard then
  2525. begin Inc(DestPos.X,length(S)); SetCurPtr(DestPos.X,DestPos.Y); end;
  2526. DrawView;
  2527. end;
  2528. InsertFrom:=OK;
  2529. end;
  2530. function TCodeEditor.IsClipboard: Boolean;
  2531. begin
  2532. IsClipboard:=(Clipboard=@Self);
  2533. end;
  2534. procedure TCodeEditor.HideHighlight;
  2535. begin
  2536. SetHighlight(CurPos,CurPos);
  2537. end;
  2538. procedure TCodeEditor.SetSelection(A, B: TPoint);
  2539. begin
  2540. SelStart:=A; SelEnd:=B;
  2541. SelectionChanged;
  2542. end;
  2543. procedure TCodeEditor.SetHighlight(A, B: TPoint);
  2544. begin
  2545. Highlight.A:=A; Highlight.B:=B;
  2546. HighlightChanged;
  2547. end;
  2548. procedure TCodeEditor.SetHighlightRow(Row: integer);
  2549. begin
  2550. HighlightRow:=Row;
  2551. DrawView;
  2552. end;
  2553. procedure TCodeEditor.SelectAll(Enable: boolean);
  2554. var A,B: TPoint;
  2555. begin
  2556. if (Enable=false) or (GetLineCount=0) then
  2557. begin A:=CurPos; B:=CurPos end else
  2558. begin A.X:=0; A.Y:=0; B.Y:=GetLineCount-1; B.X:=length(GetLineText(B.Y)); end;
  2559. SetSelection(A,B);
  2560. DrawView;
  2561. end;
  2562. procedure TCodeEditor.SelectionChanged;
  2563. var Enable,CanPaste: boolean;
  2564. begin
  2565. Enable:=((SelStart.X<>SelEnd.X) or (SelStart.Y<>SelEnd.Y)) and (Clipboard<>nil);
  2566. SetCmdState(ToClipCmds,Enable);
  2567. CanPaste:=(Clipboard<>nil) and ((Clipboard^.SelStart.X<>Clipboard^.SelEnd.X) or
  2568. (Clipboard^.SelStart.Y<>Clipboard^.SelEnd.Y));
  2569. SetCmdState(FromClipCmds,CanPaste);
  2570. end;
  2571. procedure TCodeEditor.HighlightChanged;
  2572. begin
  2573. DrawView;
  2574. end;
  2575. procedure TCodeEditor.SetState(AState: Word; Enable: Boolean);
  2576. begin
  2577. inherited SetState(AState,Enable);
  2578. if (AState and (sfActive+sfSelected+sfFocused))<>0 then
  2579. SelectionChanged;
  2580. end;
  2581. function TCodeEditor.GetPalette: PPalette;
  2582. const P: string[length(CEditor)] = CEditor;
  2583. begin
  2584. GetPalette:=@P;
  2585. end;
  2586. destructor TCodeEditor.Done;
  2587. begin
  2588. inherited Done;
  2589. Dispose(Lines, Done);
  2590. end;
  2591. constructor TFileEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  2592. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  2593. begin
  2594. inherited Init(Bounds,AHScrollBAr,AVScrollBAr,AIndicator,0);
  2595. FileName:=AFileName;
  2596. UpdateIndicator;
  2597. Message(@Self,evBroadcast,cmFileNameChanged,@Self);
  2598. end;
  2599. function TFileEditor.LoadFile: boolean;
  2600. {$ifdef TPUNIXLF}
  2601. var
  2602. OnlyLF: boolean;
  2603. procedure readln(var t:text;var s:string);
  2604. var
  2605. c : char;
  2606. i : longint;
  2607. begin
  2608. if OnlyLF=false then system.readln(t,s) else
  2609. begin
  2610. c:=#0;
  2611. i:=0;
  2612. while (not eof(t)) and (c<>#10) do
  2613. begin
  2614. read(t,c);
  2615. if c<>#10 then
  2616. begin
  2617. inc(i);
  2618. s[i]:=c;
  2619. end;
  2620. end;
  2621. if (i>0) and (s[i]=#13) then
  2622. begin
  2623. dec(i);
  2624. OnlyLF:=false;
  2625. end;
  2626. s[0]:=chr(i);
  2627. end;
  2628. end;
  2629. {$endif}
  2630. var S: string;
  2631. OK: boolean;
  2632. f: text;
  2633. FM,Line: Sw_integer;
  2634. Buf : Pointer;
  2635. begin
  2636. DeleteAllLines;
  2637. GetMem(Buf,EditorTextBufSize);
  2638. {$I-}
  2639. FM:=FileMode; FileMode:=0;
  2640. Assign(f,FileName);
  2641. SetTextBuf(f,Buf^,EditorTextBufSize);
  2642. Reset(f);
  2643. {$ifdef TPUNIXLF}OnlyLF:=true;{$endif}
  2644. OK:=(IOResult=0);
  2645. if Eof(f) then
  2646. AddLine('')
  2647. else
  2648. begin
  2649. while OK and (Eof(f)=false) and (GetLineCount<MaxLineCount) do
  2650. begin
  2651. readln(f,S);
  2652. OK:=OK and (IOResult=0);
  2653. if OK then AddLine(S);
  2654. end;
  2655. end;
  2656. FileMode:=FM;
  2657. Close(F);
  2658. EatIO;
  2659. {$I+}
  2660. LimitsChanged;
  2661. Line:=-1;
  2662. repeat
  2663. Line:=UpdateAttrs(Line+1,attrAll+attrForceFull);
  2664. until Line>=GetLineCount-1;
  2665. TextStart;
  2666. LoadFile:=OK;
  2667. FreeMem(Buf,EditorTextBufSize);
  2668. end;
  2669. function TFileEditor.SaveFile: boolean;
  2670. var S: string;
  2671. OK: boolean;
  2672. f: text;
  2673. Line: Sw_integer;
  2674. P: PLine;
  2675. BAKName: string;
  2676. Buf : Pointer;
  2677. begin
  2678. GetMem(Buf,EditorTextBufSize);
  2679. {$I-}
  2680. if (Flags and efBackupFiles)<>0 then
  2681. begin
  2682. BAKName:=DirAndNameOf(FileName)+'.bak';
  2683. Assign(f,BAKName);
  2684. Erase(f);
  2685. EatIO;
  2686. Assign(f,FileName);
  2687. Rename(F,BAKName);
  2688. EatIO;
  2689. end;
  2690. Assign(f,FileName);
  2691. Rewrite(f);
  2692. SetTextBuf(f,Buf^,EditorTextBufSize);
  2693. OK:=(IOResult=0); Line:=0;
  2694. while OK and (Line<GetLineCount) do
  2695. begin
  2696. P:=Lines^.At(Line);
  2697. if P^.Text=nil then S:='' else S:=P^.Text^;
  2698. writeln(f,CompressUsingTabs(S,TabSize));
  2699. Inc(Line);
  2700. OK:=OK and (IOResult=0);
  2701. end;
  2702. Close(F);
  2703. EatIO;
  2704. {$I+}
  2705. if OK then begin Modified:=false; UpdateIndicator; end;
  2706. SaveFile:=OK;
  2707. FreeMem(Buf,EditorTextBufSize);
  2708. end;
  2709. function TFileEditor.ShouldSave: boolean;
  2710. begin
  2711. ShouldSave:=Modified or (FileName='');
  2712. end;
  2713. function TFileEditor.Save: Boolean;
  2714. begin
  2715. if ShouldSave=false then begin Save:=true; Exit; end;
  2716. if FileName = '' then Save := SaveAs else Save := SaveFile;
  2717. end;
  2718. function TFileEditor.SaveAs: Boolean;
  2719. begin
  2720. SaveAs := False;
  2721. if EditorDialog(edSaveAs, @FileName) <> cmCancel then
  2722. begin
  2723. FileName := FExpand(FileName);
  2724. Message(Owner, evBroadcast, cmUpdateTitle, @Self);
  2725. SaveAs := SaveFile;
  2726. if IsClipboard then FileName := '';
  2727. Message(Application,evBroadcast,cmFileNameChanged,@Self);
  2728. end;
  2729. end;
  2730. function TFileEditor.SaveAsk: boolean;
  2731. var OK: boolean;
  2732. D: Sw_integer;
  2733. begin
  2734. OK:=Modified=false;
  2735. if OK=false then
  2736. begin
  2737. if FileName = '' then D := edSaveUntitled else D := edSaveModify;
  2738. case EditorDialog(D, @FileName) of
  2739. cmYes : OK := Save;
  2740. cmNo : begin Modified := False; OK:=true; end;
  2741. cmCancel : OK := False;
  2742. end;
  2743. end;
  2744. SaveAsk:=OK;
  2745. end;
  2746. procedure TFileEditor.HandleEvent(var Event: TEvent);
  2747. var SH,B: boolean;
  2748. begin
  2749. case Event.What of
  2750. evBroadcast :
  2751. case Event.Command of
  2752. cmFileNameChanged :
  2753. if (Event.InfoPtr=nil) or (Event.InfoPtr=@Self) then
  2754. begin
  2755. B:=(Flags and efSyntaxHighlight)<>0;
  2756. SH:=UseSyntaxHighlight(@Self);
  2757. if SH<>B then
  2758. if SH then
  2759. SetFlags(Flags or efSyntaxHighlight)
  2760. else
  2761. SetFlags(Flags and not efSyntaxHighlight);
  2762. if UseTabsPattern(@Self) then
  2763. SetFlags(Flags or efUseTabCharacters);
  2764. end;
  2765. end;
  2766. end;
  2767. inherited HandleEvent(Event);
  2768. end;
  2769. function TFileEditor.Valid(Command: Word): Boolean;
  2770. var OK: boolean;
  2771. begin
  2772. OK:=inherited Valid(Command);
  2773. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  2774. if IsClipboard=false then
  2775. OK:=SaveAsk;
  2776. Valid:=OK;
  2777. end;
  2778. function CreateFindDialog: PDialog;
  2779. var R,R1,R2: TRect;
  2780. D: PDialog;
  2781. IL1: PInputLine;
  2782. CB1: PCheckBoxes;
  2783. RB1,RB2,RB3: PRadioButtons;
  2784. begin
  2785. R.Assign(0,0,56,15);
  2786. New(D, Init(R, 'Find'));
  2787. with D^ do
  2788. begin
  2789. Options:=Options or ofCentered;
  2790. GetExtent(R); R.Grow(-3,-2);
  2791. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1; R2.Copy(R); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  2792. New(IL1, Init(R2, 80));
  2793. IL1^.Data^:=FindStr;
  2794. Insert(IL1);
  2795. Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
  2796. R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  2797. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2798. New(CB1, Init(R2,
  2799. NewSItem('~C~ase sensitive',
  2800. NewSItem('~W~hole words only',
  2801. nil))));
  2802. Insert(CB1);
  2803. Insert(New(PLabel, Init(R1, 'Options', CB1)));
  2804. R1.Copy(R); Inc(R1.A.Y,2); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  2805. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2806. New(RB1, Init(R2,
  2807. NewSItem('Forwar~d~',
  2808. NewSItem('~B~ackward',
  2809. nil))));
  2810. Insert(RB1);
  2811. Insert(New(PLabel, Init(R1, 'Direction', RB1)));
  2812. R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  2813. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2814. New(RB2, Init(R2,
  2815. NewSItem('~G~lobal',
  2816. NewSItem('~S~elected text',
  2817. nil))));
  2818. Insert(RB2);
  2819. Insert(New(PLabel, Init(R1, 'Scope', RB2)));
  2820. R1.Copy(R); Inc(R1.A.Y,6); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  2821. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2822. New(RB3, Init(R2,
  2823. NewSItem('~F~rom cursor',
  2824. NewSItem('~E~ntire scope',
  2825. nil))));
  2826. Insert(RB3);
  2827. Insert(New(PLabel, Init(R1, 'Origin', RB3)));
  2828. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  2829. Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
  2830. R.Move(19,0);
  2831. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  2832. end;
  2833. IL1^.Select;
  2834. CreateFindDialog := D;
  2835. end;
  2836. function CreateReplaceDialog: PDialog;
  2837. var R,R1,R2: TRect;
  2838. D: PDialog;
  2839. IL1,IL2: PInputLine;
  2840. CB1: PCheckBoxes;
  2841. RB1,RB2,RB3: PRadioButtons;
  2842. begin
  2843. R.Assign(0,0,56,18);
  2844. New(D, Init(R, 'Replace'));
  2845. with D^ do
  2846. begin
  2847. Options:=Options or ofCentered;
  2848. GetExtent(R); R.Grow(-3,-2);
  2849. R1.Copy(R); R1.B.X:=17; R1.B.Y:=R1.A.Y+1; R2.Copy(R); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  2850. New(IL1, Init(R2, 80));
  2851. IL1^.Data^:=FindStr;
  2852. Insert(IL1);
  2853. Insert(New(PLabel, Init(R1, '~T~ext to find', IL1)));
  2854. R1.Copy(R); R1.Move(0,2); R1.B.X:=17; R1.B.Y:=R1.A.Y+1;
  2855. R2.Copy(R); R2.Move(0,2); R2.A.X:=17; R2.B.Y:=R2.A.Y+1;
  2856. New(IL2, Init(R2, 80));
  2857. IL2^.Data^:=ReplaceStr;
  2858. Insert(IL2);
  2859. Insert(New(PLabel, Init(R1, ' ~N~ew text', IL2)));
  2860. R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  2861. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+3;
  2862. New(CB1, Init(R2,
  2863. NewSItem('~C~ase sensitive',
  2864. NewSItem('~W~hole words only',
  2865. NewSItem('~P~rompt on replace',
  2866. nil)))));
  2867. Insert(CB1);
  2868. Insert(New(PLabel, Init(R1, 'Options', CB1)));
  2869. R1.Copy(R); Inc(R1.A.Y,4); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  2870. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2871. New(RB1, Init(R2,
  2872. NewSItem('Forwar~d~',
  2873. NewSItem('~B~ackward',
  2874. nil))));
  2875. Insert(RB1);
  2876. Insert(New(PLabel, Init(R1, 'Direction', RB1)));
  2877. R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.B.X:=R1.A.X+(R1.B.X-R1.A.X) div 2-1;
  2878. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2879. New(RB2, Init(R2,
  2880. NewSItem('~G~lobal',
  2881. NewSItem('~S~elected text',
  2882. nil))));
  2883. Insert(RB2);
  2884. Insert(New(PLabel, Init(R1, 'Scope', RB2)));
  2885. R1.Copy(R); Inc(R1.A.Y,9); R1.B.Y:=R1.A.Y+1; R1.A.X:=R1.B.X-(R1.B.X-R1.A.X) div 2+1;
  2886. R2.Copy(R1); R2.Move(0,1); R2.B.Y:=R2.A.Y+2;
  2887. New(RB3, Init(R2,
  2888. NewSItem('~F~rom cursor',
  2889. NewSItem('~E~ntire scope',
  2890. nil))));
  2891. Insert(RB3);
  2892. Insert(New(PLabel, Init(R1, 'Origin', RB3)));
  2893. GetExtent(R); R.Grow(-13,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10; R.Move(-10,0);
  2894. Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  2895. R.Move(11,0); R.B.X:=R.A.X+14;
  2896. Insert(New(PButton, Init(R, 'Change ~a~ll', cmYes, bfNormal)));
  2897. R.Move(15,0); R.B.X:=R.A.X+10;
  2898. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  2899. end;
  2900. IL1^.Select;
  2901. CreateReplaceDialog := D;
  2902. end;
  2903. function CreateGotoLineDialog(Info: pointer): PDialog;
  2904. var D: PDialog;
  2905. R,R1,R2: TRect;
  2906. IL: PInputLine;
  2907. begin
  2908. R.Assign(0,0,40,7);
  2909. New(D, Init(R, 'Goto line'));
  2910. with D^ do
  2911. begin
  2912. Options:=Options or ofCentered;
  2913. GetExtent(R); R.Grow(-3,-2); R.B.Y:=R.A.Y+1;
  2914. R1.Copy(R); R1.B.X:=27; R2.Copy(R); R2.A.X:=27;
  2915. New(IL, Init(R2,5));
  2916. with TGotoLineDialogRec(Info^) do
  2917. IL^.SetValidator(New(PRangeValidator, Init(1, Lines)));
  2918. Insert(IL);
  2919. Insert(New(PLabel, Init(R1, 'Enter new line ~n~umber', IL)));
  2920. GetExtent(R); R.Grow(-8,-1); R.A.Y:=R.B.Y-2; R.B.X:=R.A.X+10;
  2921. Insert(New(PButton, Init(R, 'O~K', cmOK, bfDefault)));
  2922. R.Move(15,0);
  2923. Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  2924. end;
  2925. IL^.Select;
  2926. CreateGotoLineDialog:=D;
  2927. end;
  2928. function StdEditorDialog(Dialog: Integer; Info: Pointer): Word;
  2929. var
  2930. R: TRect;
  2931. T: TPoint;
  2932. Re: word;
  2933. Name: string;
  2934. begin
  2935. case Dialog of
  2936. edOutOfMemory:
  2937. StdEditorDialog := MessageBox('Not enough memory for this operation.',
  2938. nil, mfInsertInApp+ mfError + mfOkButton);
  2939. edReadError:
  2940. StdEditorDialog := MessageBox('Error reading file %s.',
  2941. @Info, mfInsertInApp+ mfError + mfOkButton);
  2942. edWriteError:
  2943. StdEditorDialog := MessageBox('Error writing file %s.',
  2944. @Info, mfInsertInApp+ mfError + mfOkButton);
  2945. edCreateError:
  2946. StdEditorDialog := MessageBox('Error creating file %s.',
  2947. @Info, mfInsertInApp+ mfError + mfOkButton);
  2948. edSaveModify:
  2949. StdEditorDialog := MessageBox('%s has been modified. Save?',
  2950. @Info, mfInsertInApp+ mfInformation + mfYesNoCancel);
  2951. edSaveUntitled:
  2952. StdEditorDialog := MessageBox('Save untitled file?',
  2953. nil, mfInsertInApp+ mfInformation + mfYesNoCancel);
  2954. edSaveAs:
  2955. begin
  2956. Name:=PString(Info)^;
  2957. Re:=Application^.ExecuteDialog(New(PFileDialog, Init('*'+DefaultSaveExt,
  2958. 'Save file as', '~N~ame', fdOkButton, 101)), @Name);
  2959. if (Re<>cmCancel) and (Name<>PString(Info)^) then
  2960. if ExistsFile(Name) then
  2961. if EditorDialog(edReplaceFile,@Name)<>cmYes then
  2962. Re:=cmCancel;
  2963. if Re<>cmCancel then
  2964. PString(Info)^:=Name;
  2965. StdEditorDialog := Re;
  2966. end;
  2967. edGotoLine:
  2968. StdEditorDialog :=
  2969. Application^.ExecuteDialog(CreateGotoLineDialog(Info), Info);
  2970. edFind:
  2971. StdEditorDialog :=
  2972. Application^.ExecuteDialog(CreateFindDialog, Info);
  2973. edSearchFailed:
  2974. StdEditorDialog := MessageBox('Search string not found.',
  2975. nil, mfInsertInApp+ mfError + mfOkButton);
  2976. edReplace:
  2977. StdEditorDialog :=
  2978. Application^.ExecuteDialog(CreateReplaceDialog, Info);
  2979. edReplacePrompt:
  2980. begin
  2981. { Avoid placing the dialog on the same line as the cursor }
  2982. R.Assign(0, 1, 40, 8);
  2983. R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
  2984. Desktop^.MakeGlobal(R.B, T);
  2985. Inc(T.Y);
  2986. if PPoint(Info)^.Y <= T.Y then
  2987. R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
  2988. StdEditorDialog := MessageBoxRect(R, 'Replace this occurence?',
  2989. nil, mfInsertInApp+ mfYesNoCancel + mfInformation);
  2990. end;
  2991. edReplaceFile :
  2992. StdEditorDialog :=
  2993. MessageBox('File %s already exists. Overwrite?',@Info,mfInsertInApp+mfConfirmation+
  2994. mfYesButton+mfNoButton);
  2995. end;
  2996. end;
  2997. function DefUseSyntaxHighlight(Editor: PFileEditor): boolean;
  2998. begin
  2999. DefUseSyntaxHighlight:=(Editor^.Flags and efSyntaxHighlight)<>0;
  3000. end;
  3001. function DefUseTabsPattern(Editor: PFileEditor): boolean;
  3002. begin
  3003. DefUseTabsPattern:=(Editor^.Flags and efUseTabCharacters)<>0;
  3004. end;
  3005. END.
  3006. {
  3007. $Log$
  3008. Revision 1.22 1999-02-22 02:15:25 peter
  3009. + default extension for save in the editor
  3010. + Separate Text to Find for the grep dialog
  3011. * fixed redir crash with tp7
  3012. Revision 1.21 1999/02/20 15:18:33 peter
  3013. + ctrl-c capture with confirm dialog
  3014. + ascii table in the tools menu
  3015. + heapviewer
  3016. * empty file fixed
  3017. * fixed callback routines in fpdebug to have far for tp7
  3018. Revision 1.20 1999/02/18 17:27:57 pierre
  3019. * find/replace dialogs need packed records !!
  3020. Revision 1.19 1999/02/18 13:44:36 peter
  3021. * search fixed
  3022. + backward search
  3023. * help fixes
  3024. * browser updates
  3025. Revision 1.18 1999/02/15 15:12:25 pierre
  3026. + TLine remembers Comment type
  3027. Revision 1.17 1999/02/15 09:32:58 pierre
  3028. * single line comment // fix : comments intermix still wrong !!
  3029. Revision 1.16 1999/02/11 19:07:26 pierre
  3030. * GDBWindow redesigned :
  3031. normal editor apart from
  3032. that any kbEnter will send the line (for begin to cursor)
  3033. to GDB command !
  3034. GDBWindow opened in Debugger Menu
  3035. still buggy :
  3036. -echo should not be present if at end of text
  3037. -GDBWindow becomes First after each step (I don't know why !)
  3038. Revision 1.15 1999/02/09 09:29:59 pierre
  3039. * avoid invisible characters in CombineColors
  3040. Revision 1.14 1999/02/05 13:51:45 peter
  3041. * unit name of FPSwitches -> FPSwitch which is easier to use
  3042. * some fixes for tp7 compiling
  3043. Revision 1.13 1999/02/05 13:22:43 pierre
  3044. * bug that caused crash for empty files
  3045. Revision 1.12 1999/02/05 12:04:56 pierre
  3046. + 'loose' centering for debugger
  3047. Revision 1.11 1999/02/04 17:19:26 peter
  3048. * linux fixes
  3049. Revision 1.10 1999/02/04 10:13:00 pierre
  3050. + GetCurrentWord (used in Find/Replace)
  3051. + DefUseTabsPattern (pattern forcing tabs to be kept)
  3052. used for all makefiles !!
  3053. Revision 1.9 1999/01/29 10:34:33 peter
  3054. + needobjdir,needlibdir
  3055. Revision 1.8 1999/01/21 11:54:31 peter
  3056. + tools menu
  3057. + speedsearch in symbolbrowser
  3058. * working run command
  3059. Revision 1.7 1999/01/14 21:41:17 peter
  3060. * use * as modified indicator
  3061. * fixed syntax highlighting
  3062. Revision 1.6 1999/01/12 14:29:44 peter
  3063. + Implemented still missing 'switch' entries in Options menu
  3064. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  3065. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  3066. ASCII chars and inserted directly in the text.
  3067. + Added symbol browser
  3068. * splitted fp.pas to fpide.pas
  3069. Revision 1.5 1999/01/07 15:02:40 peter
  3070. * better tab support
  3071. Revision 1.4 1999/01/04 11:49:55 peter
  3072. * 'Use tab characters' now works correctly
  3073. + Syntax highlight now acts on File|Save As...
  3074. + Added a new class to syntax highlight: 'hex numbers'.
  3075. * There was something very wrong with the palette managment. Now fixed.
  3076. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  3077. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  3078. process revised
  3079. Revision 1.2 1998/12/28 15:47:55 peter
  3080. + Added user screen support, display & window
  3081. + Implemented Editor,Mouse Options dialog
  3082. + Added location of .INI and .CFG file
  3083. + Option (INI) file managment implemented (see bottom of Options Menu)
  3084. + Switches updated
  3085. + Run program
  3086. Revision 1.4 1998/12/27 12:01:23 gabor
  3087. * efXXXX constants revised for BP compatibility
  3088. * fixed column and row highlighting (needs to rewrite default palette in the INI)
  3089. Revision 1.3 1998/12/22 10:39:54 peter
  3090. + options are now written/read
  3091. + find and replace routines
  3092. }