fpviews.pas 101 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Views and view-related functions for the IDE
  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 FPViews;
  13. {$i globdir.inc}
  14. interface
  15. uses
  16. Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,Gadgets,
  17. ASCIITAB,
  18. {$ifdef EDITORS}
  19. Editors,
  20. {$else}
  21. WEditor,WCEdit,
  22. {$endif}
  23. WUtils,WHelp,WHlpView,WViews,WANSI,
  24. Comphook,
  25. FPConst,FPUsrScr;
  26. type
  27. {$IFNDEF EDITORS}
  28. TEditor = TCodeEditor; PEditor = PCodeEditor;
  29. {$ENDIF}
  30. PStoreCollection = ^TStoreCollection;
  31. TStoreCollection = object(TStringCollection)
  32. function Add(const S: string): PString;
  33. end;
  34. PIntegerLine = ^TIntegerLine;
  35. TIntegerLine = object(TInputLine)
  36. constructor Init(var Bounds: TRect; AMin, AMax: longint);
  37. end;
  38. PFPHeapView = ^TFPHeapView;
  39. TFPHeapView = object(THeapView)
  40. constructor Init(var Bounds: TRect);
  41. constructor InitKb(var Bounds: TRect);
  42. procedure HandleEvent(var Event: TEvent); virtual;
  43. end;
  44. PFPClockView = ^TFPClockView;
  45. TFPClockView = object(TClockView)
  46. constructor Init(var Bounds: TRect);
  47. procedure HandleEvent(var Event: TEvent); virtual;
  48. function GetPalette: PPalette; virtual;
  49. end;
  50. TFPWindow = object(TWindow)
  51. AutoNumber: boolean;
  52. procedure HandleEvent(var Event: TEvent); virtual;
  53. procedure SetState(AState: Word; Enable: Boolean); virtual;
  54. constructor Load(var S: TStream);
  55. procedure Store(var S: TStream);
  56. procedure Update; virtual;
  57. end;
  58. PFPHelpViewer = ^TFPHelpViewer;
  59. TFPHelpViewer = object(THelpViewer)
  60. function GetLocalMenu: PMenu; virtual;
  61. function GetCommandTarget: PView; virtual;
  62. end;
  63. PFPHelpWindow = ^TFPHelpWindow;
  64. TFPHelpWindow = object(THelpWindow)
  65. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  66. destructor Done;virtual;
  67. procedure InitHelpView; virtual;
  68. procedure Show; {virtual;}
  69. procedure Hide; {virtual;}
  70. procedure HandleEvent(var Event: TEvent); virtual;
  71. function GetPalette: PPalette; virtual;
  72. constructor Load(var S: TStream);
  73. procedure Store(var S: TStream);
  74. end;
  75. PTextScroller = ^TTextScroller;
  76. TTextScroller = object(TStaticText)
  77. TopLine: integer;
  78. Speed : integer;
  79. Lines : PUnsortedStringCollection;
  80. constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  81. function GetLineCount: integer; virtual;
  82. function GetLine(I: integer): string; virtual;
  83. procedure HandleEvent(var Event: TEvent); virtual;
  84. procedure Update; virtual;
  85. procedure Reset; virtual;
  86. procedure Scroll; virtual;
  87. procedure Draw; virtual;
  88. destructor Done; virtual;
  89. private
  90. LastTT: longint;
  91. end;
  92. TAlign = (alLeft,alCenter,alRight);
  93. PFPToolTip = ^TFPToolTip;
  94. TFPToolTip = object(TView)
  95. constructor Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  96. procedure Draw; virtual;
  97. function GetText: string;
  98. procedure SetText(const AText: string);
  99. function GetAlign: TAlign;
  100. procedure SetAlign(AAlign: TAlign);
  101. function GetPalette: PPalette; virtual;
  102. destructor Done; virtual;
  103. private
  104. Text: PString;
  105. Align: TAlign;
  106. end;
  107. PSourceEditor = ^TSourceEditor;
  108. TSourceEditor = object(TFileEditor)
  109. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  110. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  111. {$ifndef EDITORS}
  112. public
  113. CodeCompleteTip: PFPToolTip;
  114. { Syntax highlight }
  115. function IsReservedWord(const S: string): boolean; virtual;
  116. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  117. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  118. { CodeTemplates }
  119. function TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean; virtual;
  120. { CodeComplete }
  121. function CompleteCodeWord(const WordS: string; var Text: string): boolean; virtual;
  122. procedure SetCodeCompleteWord(const S: string); virtual;
  123. procedure AlignCodeCompleteTip;
  124. {$endif}
  125. procedure HandleEvent(var Event: TEvent); virtual;
  126. {$ifdef DebugUndo}
  127. procedure DumpUndo;
  128. procedure UndoAll;
  129. procedure RedoAll;
  130. {$endif DebugUndo}
  131. function GetLocalMenu: PMenu; virtual;
  132. function GetCommandTarget: PView; virtual;
  133. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  134. procedure ModifiedChanged; virtual;
  135. procedure InsertOptions; virtual;
  136. end;
  137. PSourceWindow = ^TSourceWindow;
  138. TSourceWindow = object(TFPWindow)
  139. Editor : PSourceEditor;
  140. Indicator : PIndicator;
  141. constructor Init(var Bounds: TRect; AFileName: string);
  142. function GetTitle(MaxSize: sw_Integer): TTitleStr; virtual;
  143. procedure SetTitle(ATitle: string); virtual;
  144. procedure UpdateTitle; virtual;
  145. procedure HandleEvent(var Event: TEvent); virtual;
  146. procedure SetState(AState: Word; Enable: Boolean); virtual;
  147. procedure SelectInDebugSession;
  148. procedure Update; virtual;
  149. procedure UpdateCommands; virtual;
  150. function GetPalette: PPalette; virtual;
  151. constructor Load(var S: TStream);
  152. procedure Store(var S: TStream);
  153. destructor Done; virtual;
  154. end;
  155. PGDBSourceEditor = ^TGDBSourceEditor;
  156. TGDBSourceEditor = object(TSourceEditor)
  157. function InsertNewLine : Sw_integer;virtual;
  158. function Valid(Command: Word): Boolean; virtual;
  159. procedure AddLine(const S: string); virtual;
  160. procedure AddErrorLine(const S: string); virtual;
  161. private
  162. Silent,
  163. AutoRepeat,
  164. IgnoreStringAtEnd : boolean;
  165. LastCommand : String;
  166. end;
  167. PGDBWindow = ^TGDBWindow;
  168. TGDBWindow = object(TFPWindow)
  169. Editor : PGDBSourceEditor;
  170. Indicator : PIndicator;
  171. constructor Init(var Bounds: TRect);
  172. procedure WriteText(Buf : pchar;IsError : boolean);
  173. procedure WriteString(Const S : string);
  174. procedure WriteErrorString(Const S : string);
  175. procedure WriteOutputText(Buf : pchar);
  176. procedure WriteErrorText(Buf : pchar);
  177. function GetPalette: PPalette;virtual;
  178. constructor Load(var S: TStream);
  179. procedure Store(var S: TStream);
  180. destructor Done; virtual;
  181. end;
  182. PClipboardWindow = ^TClipboardWindow;
  183. TClipboardWindow = object(TSourceWindow)
  184. constructor Init;
  185. procedure Close; virtual;
  186. constructor Load(var S: TStream);
  187. procedure Store(var S: TStream);
  188. destructor Done; virtual;
  189. end;
  190. PMessageItem = ^TMessageItem;
  191. TMessageItem = object(TObject)
  192. TClass : longint;
  193. Text : PString;
  194. Module : PString;
  195. Row,Col : sw_integer;
  196. constructor Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  197. function GetText(MaxLen: Sw_integer): string; virtual;
  198. procedure Selected; virtual;
  199. function GetModuleName: string; virtual;
  200. destructor Done; virtual;
  201. end;
  202. PMessageListBox = ^TMessageListBox;
  203. TMessageListBox = object(THSListBox)
  204. Transparent : boolean;
  205. NoSelection : boolean;
  206. MaxWidth : Sw_integer;
  207. ModuleNames : PStoreCollection;
  208. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  209. procedure AddItem(P: PMessageItem); virtual;
  210. function AddModuleName(const Name: string): PString; virtual;
  211. function GetText(Item,MaxLen: Sw_Integer): String; virtual;
  212. procedure Clear; virtual;
  213. procedure TrackSource; virtual;
  214. procedure GotoSource; virtual;
  215. procedure Draw; virtual;
  216. procedure HandleEvent(var Event: TEvent); virtual;
  217. function GetLocalMenu: PMenu; virtual;
  218. constructor Load(var S: TStream);
  219. procedure Store(var S: TStream);
  220. destructor Done; virtual;
  221. end;
  222. {$ifdef OLDCOMP}
  223. PCompilerMessage = ^TCompilerMessage;
  224. TCompilerMessage = object(TMessageItem)
  225. function GetText(MaxLen: Sw_Integer): String; virtual;
  226. end;
  227. {$endif}
  228. PProgramInfoWindow = ^TProgramInfoWindow;
  229. TProgramInfoWindow = object(TDlgWindow)
  230. InfoST: PColorStaticText;
  231. LogLB : PMessageListBox;
  232. constructor Init;
  233. constructor Load(var S: TStream);
  234. procedure Store(var S: TStream);
  235. procedure AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  236. procedure ClearMessages;
  237. procedure SizeLimits(var Min, Max: TPoint); virtual;
  238. procedure Close; virtual;
  239. procedure HandleEvent(var Event: TEvent); virtual;
  240. procedure Update; virtual;
  241. destructor Done; virtual;
  242. end;
  243. PTabItem = ^TTabItem;
  244. TTabItem = record
  245. Next : PTabItem;
  246. View : PView;
  247. Dis : boolean;
  248. end;
  249. PTabDef = ^TTabDef;
  250. TTabDef = record
  251. Next : PTabDef;
  252. Name : PString;
  253. Items : PTabItem;
  254. DefItem : PView;
  255. ShortCut : char;
  256. end;
  257. PTab = ^TTab;
  258. TTab = object(TGroup)
  259. TabDefs : PTabDef;
  260. ActiveDef : integer;
  261. DefCount : word;
  262. constructor Init(var Bounds: TRect; ATabDef: PTabDef);
  263. function AtTab(Index: integer): PTabDef; virtual;
  264. procedure SelectTab(Index: integer); virtual;
  265. function TabCount: integer;
  266. procedure SelectNextTab(Forwards: boolean);
  267. function Valid(Command: Word): Boolean; virtual;
  268. procedure ChangeBounds(var Bounds: TRect); virtual;
  269. procedure HandleEvent(var Event: TEvent); virtual;
  270. function GetPalette: PPalette; virtual;
  271. procedure Draw; virtual;
  272. procedure SetState(AState: Word; Enable: Boolean); virtual;
  273. destructor Done; virtual;
  274. private
  275. InDraw: boolean;
  276. end;
  277. PScreenView = ^TScreenView;
  278. TScreenView = object(TScroller)
  279. Screen: PScreen;
  280. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  281. AScreen: PScreen);
  282. procedure Draw; virtual;
  283. procedure Update; virtual;
  284. procedure HandleEvent(var Event: TEvent); virtual;
  285. end;
  286. PScreenWindow = ^TScreenWindow;
  287. TScreenWindow = object(TFPWindow)
  288. ScreenView : PScreenView;
  289. constructor Init(AScreen: PScreen; ANumber: integer);
  290. destructor Done; virtual;
  291. end;
  292. PFPAboutDialog = ^TFPAboutDialog;
  293. TFPAboutDialog = object(TCenterDialog)
  294. constructor Init;
  295. procedure ToggleInfo;
  296. procedure HandleEvent(var Event: TEvent); virtual;
  297. private
  298. Scroller: PTextScroller;
  299. TitleST : PStaticText;
  300. end;
  301. PFPASCIIChart = ^TFPASCIIChart;
  302. TFPASCIIChart = object(TASCIIChart)
  303. constructor Init;
  304. constructor Load(var S: TStream);
  305. procedure Store(var S: TStream);
  306. procedure HandleEvent(var Event: TEvent); virtual;
  307. destructor Done; virtual;
  308. end;
  309. PVideoModeListBox = ^TVideoModeListBox;
  310. TVideoModeListBox = object(TDropDownListBox)
  311. function GetText(Item: pointer; MaxLen: sw_integer): string; virtual;
  312. end;
  313. PFPDesktop = ^TFPDesktop;
  314. TFPDesktop = object(TDesktop)
  315. constructor Init(var Bounds: TRect);
  316. procedure InitBackground; virtual;
  317. constructor Load(var S: TStream);
  318. procedure Store(var S: TStream);
  319. end;
  320. PFPMemo = ^TFPMemo;
  321. TFPMemo = object(TCodeEditor)
  322. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  323. PScrollBar; AIndicator: PIndicator);
  324. function IsReservedWord(const S: string): boolean; virtual;
  325. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  326. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  327. function GetPalette: PPalette; virtual;
  328. end;
  329. PFPCodeMemo = ^TFPCodeMemo;
  330. TFPCodeMemo = object(TFPMemo)
  331. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  332. PScrollBar; AIndicator: PIndicator);
  333. function IsReservedWord(const S: string): boolean; virtual;
  334. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  335. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  336. end;
  337. function SearchFreeWindowNo: integer;
  338. function IsWindow(P: PView): boolean;
  339. function IsThereAnyEditor: boolean;
  340. function IsThereAnyWindow: boolean;
  341. function IsThereAnyVisibleWindow: boolean;
  342. function IsThereAnyNumberedWindow: boolean;
  343. function FirstEditorWindow: PSourceWindow;
  344. function EditorWindowFile(const Name : String): PSourceWindow;
  345. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  346. procedure DisposeTabItem(P: PTabItem);
  347. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  348. procedure DisposeTabDef(P: PTabDef);
  349. function GetEditorCurWord(Editor: PEditor): string;
  350. procedure InitReservedWords;
  351. procedure DoneReservedWords;
  352. function GetReservedWordCount: integer;
  353. function GetReservedWord(Index: integer): string;
  354. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  355. function GetNextEditorBounds(var Bounds: TRect): boolean;
  356. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  357. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  358. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  359. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts: boolean): PSourceWindow;
  360. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts, ShowIt,
  361. ForceNewWindow:boolean): PSourceWindow;
  362. function SearchWindow(const Title: string): PWindow;
  363. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  364. {$ifdef VESA}
  365. procedure InitVESAScreenModes;
  366. {$endif}
  367. procedure NoDebugger;
  368. const
  369. SourceCmds : TCommandSet =
  370. ([cmSave,cmSaveAs,cmCompile,cmHide]);
  371. EditorCmds : TCommandSet =
  372. ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
  373. CompileCmds : TCommandSet =
  374. ([cmMake,cmBuild,cmRun]);
  375. CalcClipboard : extended = 0;
  376. OpenFileName : string{$ifdef GABOR}[50]{$endif} = '';
  377. OpenFileLastExt : string[12] = '*.pas';
  378. NewEditorOpened : boolean = false;
  379. var MsgParms : array[1..10] of
  380. record
  381. case byte of
  382. 0 : (Ptr : pointer);
  383. 1 : (Long: longint);
  384. end;
  385. procedure RegisterFPViews;
  386. implementation
  387. uses
  388. {$ifdef GABOR}crt,{$endif}
  389. Video,Strings,Keyboard,Memory,MsgBox,Validate,
  390. Tokens,Version,
  391. {$ifndef NODEBUG}
  392. gdbint,
  393. {$endif NODEBUG}
  394. {$ifdef VESA}Vesa,{$endif}
  395. FPString,FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp,
  396. FPTools,FPIDE,FPCodTmp,FPCodCmp;
  397. const
  398. RSourceEditor: TStreamRec = (
  399. ObjType: 1500;
  400. VmtLink: Ofs(TypeOf(TSourceEditor)^);
  401. Load: @TSourceEditor.Load;
  402. Store: @TSourceEditor.Store
  403. );
  404. RSourceWindow: TStreamRec = (
  405. ObjType: 1501;
  406. VmtLink: Ofs(TypeOf(TSourceWindow)^);
  407. Load: @TSourceWindow.Load;
  408. Store: @TSourceWindow.Store
  409. );
  410. RFPHelpViewer: TStreamRec = (
  411. ObjType: 1502;
  412. VmtLink: Ofs(TypeOf(TFPHelpViewer)^);
  413. Load: @TFPHelpViewer.Load;
  414. Store: @TFPHelpViewer.Store
  415. );
  416. RFPHelpWindow: TStreamRec = (
  417. ObjType: 1503;
  418. VmtLink: Ofs(TypeOf(TFPHelpWindow)^);
  419. Load: @TFPHelpWindow.Load;
  420. Store: @TFPHelpWindow.Store
  421. );
  422. RClipboardWindow: TStreamRec = (
  423. ObjType: 1504;
  424. VmtLink: Ofs(TypeOf(TClipboardWindow)^);
  425. Load: @TClipboardWindow.Load;
  426. Store: @TClipboardWindow.Store
  427. );
  428. RMessageListBox: TStreamRec = (
  429. ObjType: 1505;
  430. VmtLink: Ofs(TypeOf(TMessageListBox)^);
  431. Load: @TMessageListBox.Load;
  432. Store: @TMessageListBox.Store
  433. );
  434. RFPDesktop: TStreamRec = (
  435. ObjType: 1506;
  436. VmtLink: Ofs(TypeOf(TFPDesktop)^);
  437. Load: @TFPDesktop.Load;
  438. Store: @TFPDesktop.Store
  439. );
  440. RGDBSourceEditor: TStreamRec = (
  441. ObjType: 1507;
  442. VmtLink: Ofs(TypeOf(TGDBSourceEditor)^);
  443. Load: @TGDBSourceEditor.Load;
  444. Store: @TGDBSourceEditor.Store
  445. );
  446. RGDBWindow: TStreamRec = (
  447. ObjType: 1508;
  448. VmtLink: Ofs(TypeOf(TGDBWindow)^);
  449. Load: @TGDBWindow.Load;
  450. Store: @TGDBWindow.Store
  451. );
  452. RFPASCIIChart: TStreamRec = (
  453. ObjType: 1509;
  454. VmtLink: Ofs(TypeOf(TFPASCIIChart)^);
  455. Load: @TFPASCIIChart.Load;
  456. Store: @TFPASCIIChart.Store
  457. );
  458. RProgramInfoWindow: TStreamRec = (
  459. ObjType: 1510;
  460. VmtLink: Ofs(TypeOf(TProgramInfoWindow)^);
  461. Load: @TProgramInfoWindow.Load;
  462. Store: @TProgramInfoWindow.Store
  463. );
  464. const
  465. NoNameCount : integer = 0;
  466. var
  467. ReservedWords : array[1..ReservedWordMaxLen] of PStringCollection;
  468. {****************************************************************************
  469. TStoreCollection
  470. ****************************************************************************}
  471. function TStoreCollection.Add(const S: string): PString;
  472. var P: PString;
  473. Index: Sw_integer;
  474. begin
  475. if S='' then P:=nil else
  476. if Search(@S,Index) then P:=At(Index) else
  477. begin
  478. P:=NewStr(S);
  479. Insert(P);
  480. end;
  481. Add:=P;
  482. end;
  483. function IsThereAnyEditor: boolean;
  484. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  485. begin
  486. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  487. end;
  488. begin
  489. IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
  490. end;
  491. function IsThereAnyHelpWindow: boolean;
  492. begin
  493. IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
  494. end;
  495. function IsThereAnyNumberedWindow: boolean;
  496. var _Is: boolean;
  497. begin
  498. _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
  499. _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
  500. IsThereAnyNumberedWindow:=_Is;
  501. end;
  502. function IsWindow(P: PView): boolean;
  503. var OK: boolean;
  504. begin
  505. OK:=false;
  506. if (P^.HelpCtx=hcSourceWindow) or
  507. (P^.HelpCtx=hcHelpWindow) or
  508. (P^.HelpCtx=hcClipboardWindow) or
  509. (P^.HelpCtx=hcCalcWindow) or
  510. (P^.HelpCtx=hcInfoWindow) or
  511. (P^.HelpCtx=hcBrowserWindow) or
  512. (P^.HelpCtx=hcMessagesWindow) or
  513. (P^.HelpCtx=hcGDBWindow) or
  514. (P^.HelpCtx=hcBreakpointListWindow) or
  515. (P^.HelpCtx=hcASCIITableWindow)
  516. then
  517. OK:=true;
  518. IsWindow:=OK;
  519. end;
  520. function IsThereAnyWindow: boolean;
  521. function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
  522. begin
  523. CheckIt:=IsWindow(P);
  524. end;
  525. begin
  526. IsThereAnyWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  527. end;
  528. function IsThereAnyVisibleWindow: boolean;
  529. function CheckIt(P: PView): boolean; {$ifndef FPC}far;{$endif}
  530. begin
  531. CheckIt:=IsWindow(P) and P^.GetState(sfVisible);
  532. end;
  533. begin
  534. IsThereAnyVisibleWindow:=Desktop^.FirstThat(@CheckIt)<>nil;
  535. end;
  536. function FirstEditorWindow: PSourceWindow;
  537. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  538. begin
  539. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  540. end;
  541. begin
  542. FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
  543. end;
  544. function EditorWindowFile(const Name : String): PSourceWindow;
  545. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  546. begin
  547. EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
  548. {$ifdef linux}
  549. (PSourceWindow(P)^.Editor^.FileName=Name);
  550. {$else}
  551. (UpcaseStr(PSourceWindow(P)^.Editor^.FileName)=UpcaseStr(Name));
  552. {$endif def linux}
  553. end;
  554. begin
  555. EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
  556. end;
  557. function GetEditorCurWord(Editor: PEditor): string;
  558. var S: string;
  559. PS,PE: byte;
  560. function Trim(S: string): string;
  561. const TrimChars : set of char = [#0,#9,' ',#255];
  562. begin
  563. while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
  564. while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
  565. Trim:=S;
  566. end;
  567. const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
  568. begin
  569. with Editor^ do
  570. begin
  571. {$ifdef EDITORS}
  572. S:='';
  573. {$else}
  574. S:=GetLineText(CurPos.Y);
  575. PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
  576. PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
  577. S:=Trim(copy(S,PS+1,PE-PS));
  578. {$endif}
  579. end;
  580. GetEditorCurWord:=S;
  581. end;
  582. {*****************************************************************************
  583. Tab
  584. *****************************************************************************}
  585. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  586. var P: PTabItem;
  587. begin
  588. New(P); FillChar(P^,SizeOf(P^),0);
  589. P^.Next:=ANext; P^.View:=AView;
  590. NewTabItem:=P;
  591. end;
  592. procedure DisposeTabItem(P: PTabItem);
  593. begin
  594. if P<>nil then
  595. begin
  596. if P^.View<>nil then Dispose(P^.View, Done);
  597. Dispose(P);
  598. end;
  599. end;
  600. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  601. var P: PTabDef;
  602. x: byte;
  603. begin
  604. New(P);
  605. P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
  606. x:=pos('~',AName);
  607. if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
  608. else P^.ShortCut:=#0;
  609. P^.DefItem:=ADefItem;
  610. NewTabDef:=P;
  611. end;
  612. procedure DisposeTabDef(P: PTabDef);
  613. var PI,X: PTabItem;
  614. begin
  615. DisposeStr(P^.Name);
  616. PI:=P^.Items;
  617. while PI<>nil do
  618. begin
  619. X:=PI^.Next;
  620. DisposeTabItem(PI);
  621. PI:=X;
  622. end;
  623. Dispose(P);
  624. end;
  625. {*****************************************************************************
  626. Reserved Words
  627. *****************************************************************************}
  628. function GetReservedWordCount: integer;
  629. var
  630. Count,I: integer;
  631. begin
  632. Count:=0;
  633. for I:=ord(Low(tToken)) to ord(High(tToken)) do
  634. with TokenInfo^[TToken(I)] do
  635. if (str<>'') and (str[1] in['A'..'Z']) then
  636. Inc(Count);
  637. GetReservedWordCount:=Count;
  638. end;
  639. function GetReservedWord(Index: integer): string;
  640. var
  641. Count,Idx,I: integer;
  642. S: string;
  643. begin
  644. Idx:=-1;
  645. Count:=-1;
  646. I:=ord(Low(tToken));
  647. while (I<=ord(High(tToken))) and (Idx=-1) do
  648. with TokenInfo^[TToken(I)] do
  649. begin
  650. if (str<>'') and (str[1] in['A'..'Z']) then
  651. begin
  652. Inc(Count);
  653. if Count=Index then
  654. Idx:=I;
  655. end;
  656. Inc(I);
  657. end;
  658. if Idx=-1 then
  659. S:=''
  660. else
  661. S:=TokenInfo^[TToken(Idx)].str;
  662. GetReservedWord:=S;
  663. end;
  664. procedure InitReservedWords;
  665. var WordS: string;
  666. Idx,I: integer;
  667. begin
  668. InitTokens;
  669. for I:=Low(ReservedWords) to High(ReservedWords) do
  670. New(ReservedWords[I], Init(50,10));
  671. for I:=1 to GetReservedWordCount do
  672. begin
  673. WordS:=GetReservedWord(I-1); Idx:=length(WordS);
  674. ReservedWords[Idx]^.Insert(NewStr(WordS));
  675. end;
  676. end;
  677. procedure DoneReservedWords;
  678. var I: integer;
  679. begin
  680. for I:=Low(ReservedWords) to High(ReservedWords) do
  681. if assigned(ReservedWords[I]) then
  682. begin
  683. dispose(ReservedWords[I],done);
  684. ReservedWords[I]:=nil;
  685. end;
  686. DoneTokens;
  687. end;
  688. function IsFPReservedWord(S: string): boolean;
  689. var _Is: boolean;
  690. Idx,Item: sw_integer;
  691. begin
  692. Idx:=length(S); _Is:=false;
  693. if (Low(ReservedWords)<=Idx) and (Idx<=High(ReservedWords)) and
  694. (ReservedWords[Idx]<>nil) and (ReservedWords[Idx]^.Count<>0) then
  695. begin
  696. S:=UpcaseStr(S);
  697. _Is:=ReservedWords[Idx]^.Search(@S,Item);
  698. end;
  699. IsFPReservedWord:=_Is;
  700. end;
  701. {*****************************************************************************
  702. SearchWindow
  703. *****************************************************************************}
  704. function SearchWindowWithNo(No: integer): PWindow;
  705. var P: PSourceWindow;
  706. begin
  707. P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
  708. if pointer(P)=pointer(Desktop) then P:=nil;
  709. SearchWindowWithNo:=P;
  710. end;
  711. function SearchWindow(const Title: string): PWindow;
  712. function Match(P: PView): boolean; {$ifndef FPC}far;{$endif}
  713. var W: PWindow;
  714. OK: boolean;
  715. begin
  716. W:=nil;
  717. { we have a crash here because of the TStatusLine
  718. that can also have one of these values
  719. but is not a Window object PM }
  720. if IsWindow(P) then
  721. W:=PWindow(P);
  722. OK:=(W<>nil);
  723. if OK then
  724. begin
  725. OK:=CompareText(W^.GetTitle(255),Title)=0;
  726. end;
  727. Match:=OK;
  728. end;
  729. var W: PView;
  730. begin
  731. { W:=Application^.FirstThat(@Match);
  732. This is wrong because TStatusLine is also considered PM }
  733. W:=Desktop^.FirstThat(@Match);
  734. { But why do we need to check all ??
  735. Probably because of the ones which were not inserted into
  736. Desktop as the Messages view
  737. Exactly. Some windows are inserted directly in the Application and not
  738. in the Desktop. btw. Does TStatusLine.HelpCtx really change? Why?
  739. Only GetHelpCtx should return different values depending on the
  740. focused view (and it's helpctx), but TStatusLine's HelpCtx field
  741. shouldn't change... Gabor
  742. if Assigned(W)=false then W:=Desktop^.FirstThat(@Match);}
  743. SearchWindow:=PWindow(W);
  744. end;
  745. function SearchFreeWindowNo: integer;
  746. var No: integer;
  747. begin
  748. No:=1;
  749. while (No<100) and (SearchWindowWithNo(No)<>nil) do
  750. Inc(No);
  751. if No=100 then No:=0;
  752. SearchFreeWindowNo:=No;
  753. end;
  754. {*****************************************************************************
  755. TIntegerLine
  756. *****************************************************************************}
  757. constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
  758. begin
  759. if inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1)=false then
  760. Fail;
  761. Validator:=New(PRangeValidator, Init(AMin, AMax));
  762. end;
  763. {*****************************************************************************
  764. SourceEditor
  765. *****************************************************************************}
  766. {$ifndef EDITORS}
  767. function SearchCoreForFileName(const AFileName: string): PCodeEditorCore;
  768. var EC: PCodeEditorCore;
  769. function Check(P: PView): boolean; {$ifndef FPC}far;{$endif}
  770. var OK: boolean;
  771. begin
  772. OK:=P^.HelpCtx=hcSourceWindow;
  773. if OK then
  774. with PSourceWindow(P)^ do
  775. if CompareText(Editor^.FileName,AFileName)=0 then
  776. begin
  777. EC:=Editor^.Core;
  778. end;
  779. Check:=OK;
  780. end;
  781. begin
  782. EC:=nil;
  783. Desktop^.FirstThat(@Check);
  784. SearchCoreForFileName:=EC;
  785. end;
  786. constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  787. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  788. var EC: PCodeEditorCore;
  789. begin
  790. EC:=SearchCoreForFileName(AFileName);
  791. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,EC,AFileName);
  792. SetStoreUndo(true);
  793. end;
  794. function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  795. var Count: integer;
  796. begin
  797. case SpecClass of
  798. ssCommentPrefix : Count:=3;
  799. ssCommentSingleLinePrefix : Count:=1;
  800. ssCommentSuffix : Count:=2;
  801. ssStringPrefix : Count:=1;
  802. ssStringSuffix : Count:=1;
  803. ssAsmPrefix : Count:=1;
  804. ssAsmSuffix : Count:=1;
  805. ssDirectivePrefix : Count:=1;
  806. ssDirectiveSuffix : Count:=1;
  807. end;
  808. GetSpecSymbolCount:=Count;
  809. end;
  810. function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  811. var S: string[20];
  812. begin
  813. case SpecClass of
  814. ssCommentPrefix :
  815. case Index of
  816. 0 : S:='{';
  817. 1 : S:='(*';
  818. 2 : S:='//';
  819. end;
  820. ssCommentSingleLinePrefix :
  821. case Index of
  822. 0 : S:='//';
  823. end;
  824. ssCommentSuffix :
  825. case Index of
  826. 0 : S:='}';
  827. 1 : S:='*)';
  828. end;
  829. ssStringPrefix :
  830. S:='''';
  831. ssStringSuffix :
  832. S:='''';
  833. ssAsmPrefix :
  834. S:='asm';
  835. ssAsmSuffix :
  836. S:='end';
  837. ssDirectivePrefix :
  838. S:='{$';
  839. ssDirectiveSuffix :
  840. S:='}';
  841. end;
  842. GetSpecSymbol:=S;
  843. end;
  844. function TSourceEditor.IsReservedWord(const S: string): boolean;
  845. begin
  846. IsReservedWord:=IsFPReservedWord(S);
  847. end;
  848. function TSourceEditor.TranslateCodeTemplate(const Shortcut: string; ALines: PUnsortedStringCollection): boolean;
  849. begin
  850. TranslateCodeTemplate:=FPTranslateCodeTemplate(ShortCut,ALines);
  851. end;
  852. function TSourceEditor.CompleteCodeWord(const WordS: string; var Text: string): boolean;
  853. begin
  854. CompleteCodeWord:=FPCompleteCodeWord(WordS,Text);
  855. end;
  856. procedure TSourceEditor.SetCodeCompleteWord(const S: string);
  857. var R: TRect;
  858. begin
  859. inherited SetCodeCompleteWord(S);
  860. if S='' then
  861. begin
  862. if Assigned(CodeCompleteTip) then Dispose(CodeCompleteTip, Done);
  863. CodeCompleteTip:=nil;
  864. end
  865. else
  866. begin
  867. R.Assign(0,0,20,1);
  868. if Assigned(CodeCompleteTip)=false then
  869. begin
  870. New(CodeCompleteTip, Init(R, S, alCenter));
  871. CodeCompleteTip^.Hide;
  872. Application^.Insert(CodeCompleteTip);
  873. end
  874. else
  875. CodeCompleteTip^.SetText(S);
  876. AlignCodeCompleteTip;
  877. end;
  878. end;
  879. procedure TSourceEditor.AlignCodeCompleteTip;
  880. var P: TPoint;
  881. S: string;
  882. R: TRect;
  883. begin
  884. if Assigned(CodeCompleteTip)=false then Exit;
  885. S:=CodeCompleteTip^.GetText;
  886. P.Y:=CurPos.Y;
  887. { determine the center of current word fragment }
  888. P.X:=CurPos.X-(length(GetCodeCompleteFrag) div 2);
  889. { calculate position for centering the complete word over/below the current }
  890. P.X:=P.X-(length(S) div 2);
  891. P.X:=P.X-Delta.X;
  892. P.Y:=P.Y-Delta.Y;
  893. MakeGlobal(P,P);
  894. if Assigned(CodeCompleteTip^.Owner) then
  895. CodeCompleteTip^.Owner^.MakeLocal(P,P);
  896. { ensure that the tooltip stays in screen }
  897. P.X:=Min(Max(0,P.X),ScreenWidth-length(S)-2-1);
  898. { align it vertically }
  899. if P.Y>round(ScreenHeight*3/4) then
  900. Dec(P.Y)
  901. else
  902. Inc(P.Y);
  903. R.Assign(P.X,P.Y,P.X+1+length(S)+1,P.Y+1);
  904. CodeCompleteTip^.Locate(R);
  905. if CodeCompleteTip^.GetState(sfVisible)=false then
  906. CodeCompleteTip^.Show;
  907. end;
  908. {$endif EDITORS}
  909. procedure TSourceEditor.ModifiedChanged;
  910. begin
  911. inherited ModifiedChanged;
  912. if (@Self<>Clipboard) and GetModified then
  913. EditorModified:=true;
  914. end;
  915. procedure TSourceEditor.InsertOptions;
  916. var C: PUnsortedStringCollection;
  917. Y: sw_integer;
  918. S: string;
  919. begin
  920. Lock;
  921. New(C, Init(10,10));
  922. GetCompilerOptionLines(C);
  923. if C^.Count>0 then
  924. begin
  925. for Y:=0 to C^.Count-1 do
  926. begin
  927. S:=C^.At(Y)^;
  928. InsertLine(Y,S);
  929. end;
  930. AdjustSelectionPos(0,0,0,C^.Count);
  931. UpdateAttrs(0,attrAll);
  932. DrawLines(0);
  933. SetModified(true);
  934. end;
  935. Dispose(C, Done);
  936. UnLock;
  937. end;
  938. function TSourceEditor.GetLocalMenu: PMenu;
  939. var M: PMenu;
  940. begin
  941. M:=NewMenu(
  942. NewItem(menu_edit_cut,menu_key_edit_cut,kbShiftDel,cmCut,hcCut,
  943. NewItem(menu_edit_copy,menu_key_edit_copy,kbCtrlIns,cmCopy,hcCopy,
  944. NewItem(menu_edit_paste,menu_key_edit_paste,kbShiftIns,cmPaste,hcPaste,
  945. NewItem(menu_edit_clear,menu_key_edit_clear,kbCtrlDel,cmClear,hcClear,
  946. NewLine(
  947. NewItem(menu_srclocal_openfileatcursor,'',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
  948. NewItem(menu_srclocal_browseatcursor,'',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
  949. NewItem(menu_srclocal_topicsearch,menu_key_help_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  950. NewLine(
  951. NewItem(menu_srclocal_options,'',kbNoKey,cmEditorOptions,hcEditorOptions,
  952. nil)))))))))));
  953. GetLocalMenu:=M;
  954. end;
  955. function TSourceEditor.GetCommandTarget: PView;
  956. begin
  957. GetCommandTarget:=@Self;
  958. end;
  959. function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  960. var MV: PAdvancedMenuPopup;
  961. begin
  962. New(MV, Init(Bounds,M));
  963. CreateLocalMenuView:=MV;
  964. end;
  965. {$ifdef DebugUndo}
  966. procedure TSourceEditor.DumpUndo;
  967. var
  968. i : sw_integer;
  969. begin
  970. ClearToolMessages;
  971. AddToolCommand('UndoList Dump');
  972. for i:=0 to Core^.UndoList^.count-1 do
  973. with Core^.UndoList^.At(i)^ do
  974. begin
  975. if is_grouped_action then
  976. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  977. else
  978. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y+1)+':'+IntToStr(StartPos.X+1)+
  979. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
  980. end;
  981. if Core^.RedoList^.count>0 then
  982. AddToolCommand('RedoList Dump');
  983. for i:=0 to Core^.RedoList^.count-1 do
  984. with Core^.RedoList^.At(i)^ do
  985. begin
  986. if is_grouped_action then
  987. AddToolMessage('','Group '+ActionString[action]+' '+IntToStr(ActionCount)+' elementary actions',0,0)
  988. else
  989. AddToolMessage('',ActionString[action]+' '+IntToStr(StartPos.Y)+':'+IntToStr(StartPos.X+1)+
  990. ' '+IntToStr(EndPos.Y+1)+':'+IntToStr(EndPos.X+1)+' "'+GetStr(Text)+'"',0,0);
  991. end;
  992. UpdateToolMessages;
  993. if Assigned(MessagesWindow) then
  994. MessagesWindow^.Focus;
  995. end;
  996. procedure TSourceEditor.UndoAll;
  997. begin
  998. While Core^.UndoList^.count>0 do
  999. Undo;
  1000. end;
  1001. procedure TSourceEditor.RedoAll;
  1002. begin
  1003. While Core^.RedoList^.count>0 do
  1004. Redo;
  1005. end;
  1006. {$endif DebugUndo}
  1007. procedure TSourceEditor.HandleEvent(var Event: TEvent);
  1008. var DontClear: boolean;
  1009. S: string;
  1010. begin
  1011. TranslateMouseClick(@Self,Event);
  1012. case Event.What of
  1013. evKeyDown :
  1014. begin
  1015. DontClear:=false;
  1016. case Event.KeyCode of
  1017. kbCtrlEnter :
  1018. Message(@Self,evCommand,cmOpenAtCursor,nil);
  1019. else DontClear:=true;
  1020. end;
  1021. if not DontClear then ClearEvent(Event);
  1022. end;
  1023. end;
  1024. inherited HandleEvent(Event);
  1025. case Event.What of
  1026. evCommand :
  1027. begin
  1028. DontClear:=false;
  1029. case Event.Command of
  1030. {$ifdef DebugUndo}
  1031. cmDumpUndo : DumpUndo;
  1032. cmUndoAll : UndoAll;
  1033. cmRedoAll : RedoAll;
  1034. {$endif DebugUndo}
  1035. cmBrowseAtCursor:
  1036. begin
  1037. S:=LowerCaseStr(GetEditorCurWord(@Self));
  1038. OpenOneSymbolBrowser(S);
  1039. end;
  1040. cmOpenAtCursor :
  1041. begin
  1042. S:=LowerCaseStr(GetEditorCurWord(@Self));
  1043. OpenFileName:=S+'.pp'+ListSeparator+
  1044. S+'.pas'+ListSeparator+
  1045. S+'.inc';
  1046. Message(Application,evCommand,cmOpen,nil);
  1047. end;
  1048. cmEditorOptions :
  1049. Message(Application,evCommand,cmEditorOptions,@Self);
  1050. cmHelp :
  1051. Message(@Self,evCommand,cmHelpTopicSearch,@Self);
  1052. cmHelpTopicSearch :
  1053. HelpTopicSearch(@Self);
  1054. else DontClear:=true;
  1055. end;
  1056. if not DontClear then ClearEvent(Event);
  1057. end;
  1058. end;
  1059. end;
  1060. constructor TFPHeapView.Init(var Bounds: TRect);
  1061. begin
  1062. if inherited Init(Bounds)=false then Fail;
  1063. Options:=Options or gfGrowHiX or gfGrowHiY;
  1064. EventMask:=EventMask or evIdle;
  1065. GrowMode:=gfGrowAll;
  1066. end;
  1067. constructor TFPHeapView.InitKb(var Bounds: TRect);
  1068. begin
  1069. if inherited InitKb(Bounds)=false then Fail;
  1070. Options:=Options or gfGrowHiX or gfGrowHiY;
  1071. EventMask:=EventMask or evIdle;
  1072. GrowMode:=gfGrowAll;
  1073. end;
  1074. procedure TFPHeapView.HandleEvent(var Event: TEvent);
  1075. begin
  1076. case Event.What of
  1077. evIdle :
  1078. Update;
  1079. end;
  1080. inherited HandleEvent(Event);
  1081. end;
  1082. constructor TFPClockView.Init(var Bounds: TRect);
  1083. begin
  1084. inherited Init(Bounds);
  1085. EventMask:=EventMask or evIdle;
  1086. end;
  1087. procedure TFPClockView.HandleEvent(var Event: TEvent);
  1088. begin
  1089. case Event.What of
  1090. evIdle :
  1091. Update;
  1092. end;
  1093. inherited HandleEvent(Event);
  1094. end;
  1095. function TFPClockView.GetPalette: PPalette;
  1096. const P: string[length(CFPClockView)] = CFPClockView;
  1097. begin
  1098. GetPalette:=@P;
  1099. end;
  1100. procedure TFPWindow.SetState(AState: Word; Enable: Boolean);
  1101. begin
  1102. inherited SetState(AState,Enable);
  1103. if AutoNumber then
  1104. if (AState and (sfVisible+sfExposed))<>0 then
  1105. if GetState(sfVisible+sfExposed) then
  1106. begin
  1107. if Number=0 then
  1108. Number:=SearchFreeWindowNo;
  1109. ReDraw;
  1110. end
  1111. else
  1112. Number:=0;
  1113. end;
  1114. procedure TFPWindow.Update;
  1115. begin
  1116. ReDraw;
  1117. end;
  1118. procedure TFPWindow.HandleEvent(var Event: TEvent);
  1119. begin
  1120. case Event.What of
  1121. evBroadcast :
  1122. case Event.Command of
  1123. cmUpdate :
  1124. Update;
  1125. cmSearchWindow+1..cmSearchWindow+99 :
  1126. if (Event.Command-cmSearchWindow=Number) then
  1127. ClearEvent(Event);
  1128. end;
  1129. end;
  1130. inherited HandleEvent(Event);
  1131. end;
  1132. constructor TFPWindow.Load(var S: TStream);
  1133. begin
  1134. inherited Load(S);
  1135. S.Read(AutoNumber,SizeOf(AutoNumber));
  1136. end;
  1137. procedure TFPWindow.Store(var S: TStream);
  1138. begin
  1139. inherited Store(S);
  1140. S.Write(AutoNumber,SizeOf(AutoNumber));
  1141. end;
  1142. function TFPHelpViewer.GetLocalMenu: PMenu;
  1143. var M: PMenu;
  1144. begin
  1145. M:=NewMenu(
  1146. NewItem(menu_hlplocal_contents,'',kbNoKey,cmHelpContents,hcHelpContents,
  1147. NewItem(menu_hlplocal_index,menu_key_hlplocal_index,kbShiftF1,cmHelpIndex,hcHelpIndex,
  1148. NewItem(menu_hlplocal_topicsearch,menu_key_hlplocal_topicsearch,kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  1149. NewItem(menu_hlplocal_prevtopic,menu_key_hlplocal_prevtopic,kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
  1150. NewLine(
  1151. NewItem(menu_hlplocal_copy,menu_key_hlplocal_copy,kbCtrlIns,cmCopy,hcCopy,
  1152. nil)))))));
  1153. GetLocalMenu:=M;
  1154. end;
  1155. function TFPHelpViewer.GetCommandTarget: PView;
  1156. begin
  1157. GetCommandTarget:=Application;
  1158. end;
  1159. constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
  1160. AContext: THelpCtx; ANumber: Integer);
  1161. begin
  1162. inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
  1163. HelpCtx:=hcHelpWindow;
  1164. HideOnClose:=true;
  1165. end;
  1166. destructor TFPHelpWindow.Done;
  1167. begin
  1168. if HelpWindow=@Self then
  1169. HelpWindow:=nil;
  1170. Inherited Done;
  1171. end;
  1172. procedure TFPHelpWindow.InitHelpView;
  1173. var R: TRect;
  1174. begin
  1175. GetExtent(R); R.Grow(-1,-1);
  1176. HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
  1177. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1178. end;
  1179. procedure TFPHelpWindow.Show;
  1180. begin
  1181. inherited Show;
  1182. if GetState(sfVisible) and (Number=0) then
  1183. begin
  1184. Number:=SearchFreeWindowNo;
  1185. ReDraw;
  1186. end;
  1187. end;
  1188. procedure TFPHelpWindow.Hide;
  1189. begin
  1190. inherited Hide;
  1191. if GetState(sfVisible)=false then
  1192. Number:=0;
  1193. end;
  1194. procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
  1195. begin
  1196. case Event.What of
  1197. evBroadcast :
  1198. case Event.Command of
  1199. cmUpdate :
  1200. ReDraw;
  1201. cmSearchWindow+1..cmSearchWindow+99 :
  1202. if (Event.Command-cmSearchWindow=Number) then
  1203. ClearEvent(Event);
  1204. end;
  1205. end;
  1206. inherited HandleEvent(Event);
  1207. end;
  1208. function TFPHelpWindow.GetPalette: PPalette;
  1209. const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
  1210. begin
  1211. GetPalette:=@P;
  1212. end;
  1213. constructor TFPHelpWindow.Load(var S: TStream);
  1214. begin
  1215. Abstract;
  1216. end;
  1217. procedure TFPHelpWindow.Store(var S: TStream);
  1218. begin
  1219. Abstract;
  1220. end;
  1221. constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
  1222. var HSB,VSB: PScrollBar;
  1223. R: TRect;
  1224. PA : Array[1..2] of pointer;
  1225. LoadFile: boolean;
  1226. begin
  1227. inherited Init(Bounds,AFileName,{SearchFreeWindowNo}0);
  1228. AutoNumber:=true;
  1229. Options:=Options or ofTileAble;
  1230. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1231. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1232. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1233. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1234. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1235. New(Indicator, Init(R));
  1236. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1237. Insert(Indicator);
  1238. GetExtent(R); R.Grow(-1,-1);
  1239. LoadFile:=AFileName<>'';
  1240. if not LoadFile then
  1241. begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
  1242. New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
  1243. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1244. if LoadFile then
  1245. begin
  1246. if Editor^.LoadFile=false then
  1247. ErrorBox(FormatStrStr(msg_errorreadingfile,''),nil)
  1248. else if Editor^.GetModified then
  1249. begin
  1250. PA[1]:=@AFileName;
  1251. (* longint(PA[2]):=Editor^.ChangedLine;
  1252. EditorDialog(edChangedOnloading,@PA);*)
  1253. end;
  1254. end;
  1255. Insert(Editor);
  1256. If assigned(BreakpointsCollection) then
  1257. BreakpointsCollection^.ShowBreakpoints(@Self);
  1258. UpdateTitle;
  1259. end;
  1260. procedure TSourceWindow.UpdateTitle;
  1261. var Name: string;
  1262. Count: sw_integer;
  1263. begin
  1264. if Editor^.FileName<>'' then
  1265. begin
  1266. Name:=SmartPath(Editor^.FileName);
  1267. Count:=Editor^.Core^.GetBindingCount;
  1268. if Count>1 then
  1269. begin
  1270. Name:=Name+':'+IntToStr(Editor^.Core^.GetBindingIndex(Editor)+1);
  1271. end;
  1272. SetTitle(Name);
  1273. end;
  1274. end;
  1275. function TSourceWindow.GetTitle(MaxSize: sw_Integer): TTitleStr;
  1276. begin
  1277. GetTitle:=OptimizePath(inherited GetTitle(255),MaxSize);
  1278. end;
  1279. procedure TSourceWindow.SetTitle(ATitle: string);
  1280. begin
  1281. if Title<>nil then DisposeStr(Title);
  1282. Title:=NewStr(ATitle);
  1283. Frame^.DrawView;
  1284. end;
  1285. procedure TSourceWindow.HandleEvent(var Event: TEvent);
  1286. var DontClear: boolean;
  1287. begin
  1288. case Event.What of
  1289. evBroadcast :
  1290. case Event.Command of
  1291. cmUpdate :
  1292. Update;
  1293. cmUpdateTitle :
  1294. UpdateTitle;
  1295. cmSearchWindow :
  1296. if @Self<>ClipboardWindow then
  1297. ClearEvent(Event);
  1298. end;
  1299. evCommand :
  1300. begin
  1301. DontClear:=false;
  1302. case Event.Command of
  1303. cmHide :
  1304. Hide;
  1305. cmSave :
  1306. if Editor^.IsClipboard=false then
  1307. if Editor^.FileName='' then
  1308. Editor^.SaveAs
  1309. else
  1310. Editor^.Save;
  1311. cmSaveAs :
  1312. if Editor^.IsClipboard=false then
  1313. Editor^.SaveAs;
  1314. else DontClear:=true;
  1315. end;
  1316. if DontClear=false then ClearEvent(Event);
  1317. end;
  1318. end;
  1319. inherited HandleEvent(Event);
  1320. end;
  1321. procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
  1322. var OldState: word;
  1323. begin
  1324. OldState:=State;
  1325. inherited SetState(AState,Enable);
  1326. if ((AState and sfActive)<>0) and (((OldState xor State) and sfActive)<>0) then
  1327. UpdateCommands;
  1328. end;
  1329. procedure TSourceWindow.UpdateCommands;
  1330. var Active: boolean;
  1331. begin
  1332. Active:=GetState(sfActive);
  1333. if Editor^.IsClipboard=false then
  1334. begin
  1335. SetCmdState(SourceCmds+CompileCmds,Active);
  1336. SetCmdState(EditorCmds,Active);
  1337. end;
  1338. if Active=false then
  1339. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmd+RedoCmd,false);
  1340. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  1341. end;
  1342. procedure TSourceWindow.Update;
  1343. begin
  1344. ReDraw;
  1345. end;
  1346. procedure TSourceWindow.SelectInDebugSession;
  1347. var
  1348. F,PrevCurrent : PView;
  1349. begin
  1350. DeskTop^.Lock;
  1351. PrevCurrent:=Desktop^.Current;
  1352. F:=PrevCurrent;
  1353. While assigned(F) and
  1354. ((F^.HelpCtx = hcGDBWindow) or
  1355. (F^.HelpCtx = hcWatches) or {hcStack,}
  1356. (F^.HelpCtx = hcRegisters)) do
  1357. F:=F^.NextView;
  1358. if F<>@Self then
  1359. Select;
  1360. if PrevCurrent<>F then
  1361. Begin
  1362. Desktop^.InsertBefore(@self,F);
  1363. PrevCurrent^.Select;
  1364. End;
  1365. DeskTop^.Unlock;
  1366. end;
  1367. function TSourceWindow.GetPalette: PPalette;
  1368. const P: string[length(CSourceWindow)] = CSourceWindow;
  1369. begin
  1370. GetPalette:=@P;
  1371. end;
  1372. constructor TSourceWindow.Load(var S: TStream);
  1373. begin
  1374. Title:=S.ReadStr;
  1375. PushStatus(FormatStrStr(msg_loadingfile,GetStr(Title)));
  1376. inherited Load(S);
  1377. GetSubViewPtr(S,Indicator);
  1378. GetSubViewPtr(S,Editor);
  1379. If assigned(BreakpointsCollection) then
  1380. BreakpointsCollection^.ShowBreakpoints(@Self);
  1381. PopStatus;
  1382. end;
  1383. procedure TSourceWindow.Store(var S: TStream);
  1384. begin
  1385. S.WriteStr(Title);
  1386. PushStatus(FormatStrStr(msg_storingfile,GetStr(Title)));
  1387. inherited Store(S);
  1388. PutSubViewPtr(S,Indicator);
  1389. PutSubViewPtr(S,Editor);
  1390. PopStatus;
  1391. end;
  1392. destructor TSourceWindow.Done;
  1393. begin
  1394. PushStatus(FormatStrStr(msg_closingfile,GetStr(Title)));
  1395. if not IDEApp.IsClosing then
  1396. Message(Application,evBroadcast,cmSourceWndClosing,@Self);
  1397. inherited Done;
  1398. { if not IDEApp.IsClosing then
  1399. Message(Application,evBroadcast,cmUpdate,@Self);}
  1400. PopStatus;
  1401. end;
  1402. function TGDBSourceEditor.Valid(Command: Word): Boolean;
  1403. var OK: boolean;
  1404. begin
  1405. OK:=TCodeEditor.Valid(Command);
  1406. { do NOT ask for save !!
  1407. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  1408. if IsClipboard=false then
  1409. OK:=SaveAsk; }
  1410. Valid:=OK;
  1411. end;
  1412. procedure TGDBSourceEditor.AddLine(const S: string);
  1413. begin
  1414. if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
  1415. inherited AddLine(S);
  1416. LimitsChanged;
  1417. end;
  1418. procedure TGDBSourceEditor.AddErrorLine(const S: string);
  1419. begin
  1420. if Silent then exit;
  1421. inherited AddLine(S);
  1422. { display like breakpoints in red }
  1423. SetLineFlagState(GetLineCount-1,lfBreakpoint,true);
  1424. LimitsChanged;
  1425. end;
  1426. function TGDBSourceEditor.InsertNewLine: Sw_integer;
  1427. Var
  1428. S : string;
  1429. begin
  1430. if IsReadOnly then begin InsertNewLine:=-1; Exit; end;
  1431. if CurPos.Y<GetLineCount then S:=GetDisplayText(CurPos.Y) else S:='';
  1432. s:=Copy(S,1,CurPos.X);
  1433. if assigned(Debugger) then
  1434. if S<>'' then
  1435. begin
  1436. LastCommand:=S;
  1437. { should be true only if we are at the end ! }
  1438. IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and
  1439. (CurPos.X=length(GetDisplayText(GetLineCount-1)));
  1440. Debugger^.Command(S);
  1441. IgnoreStringAtEnd:=false;
  1442. end
  1443. else if AutoRepeat then
  1444. Debugger^.Command(LastCommand);
  1445. InsertNewLine:=inherited InsertNewLine;
  1446. end;
  1447. constructor TGDBWindow.Init(var Bounds: TRect);
  1448. var HSB,VSB: PScrollBar;
  1449. R: TRect;
  1450. begin
  1451. inherited Init(Bounds,dialog_gdbwindow,0);
  1452. Options:=Options or ofTileAble;
  1453. AutoNumber:=true;
  1454. HelpCtx:=hcGDBWindow;
  1455. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1456. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1457. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1458. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1459. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1460. New(Indicator, Init(R));
  1461. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1462. Insert(Indicator);
  1463. GetExtent(R); R.Grow(-1,-1);
  1464. New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
  1465. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1466. if ExistsFile(GDBOutputFile) then
  1467. begin
  1468. if Editor^.LoadFile=false then
  1469. ErrorBox(FormatStrStr(msg_errorreadingfile,GDBOutputFile),nil);
  1470. end
  1471. else
  1472. { Empty files are buggy !! }
  1473. Editor^.AddLine('');
  1474. Insert(Editor);
  1475. if assigned(Debugger) then
  1476. Debugger^.Command('set width '+IntToStr(Size.X-1));
  1477. Editor^.silent:=false;
  1478. Editor^.AutoRepeat:=true;
  1479. end;
  1480. destructor TGDBWindow.Done;
  1481. begin
  1482. if @Self=GDBWindow then
  1483. GDBWindow:=nil;
  1484. inherited Done;
  1485. end;
  1486. constructor TGDBWindow.Load(var S: TStream);
  1487. begin
  1488. inherited Load(S);
  1489. GetSubViewPtr(S,Indicator);
  1490. GetSubViewPtr(S,Editor);
  1491. end;
  1492. procedure TGDBWindow.Store(var S: TStream);
  1493. begin
  1494. inherited Store(S);
  1495. PutSubViewPtr(S,Indicator);
  1496. PutSubViewPtr(S,Editor);
  1497. end;
  1498. function TGDBWindow.GetPalette: PPalette;
  1499. const P: string[length(CSourceWindow)] = CSourceWindow;
  1500. begin
  1501. GetPalette:=@P;
  1502. end;
  1503. procedure TGDBWindow.WriteOutputText(Buf : pchar);
  1504. begin
  1505. {selected normal color ?}
  1506. WriteText(Buf,false);
  1507. end;
  1508. procedure TGDBWindow.WriteErrorText(Buf : pchar);
  1509. begin
  1510. {selected normal color ?}
  1511. WriteText(Buf,true);
  1512. end;
  1513. procedure TGDBWindow.WriteString(Const S : string);
  1514. begin
  1515. Editor^.AddLine(S);
  1516. end;
  1517. procedure TGDBWindow.WriteErrorString(Const S : string);
  1518. begin
  1519. Editor^.AddErrorLine(S);
  1520. end;
  1521. procedure TGDBWindow.WriteText(Buf : pchar;IsError : boolean);
  1522. var p,pe : pchar;
  1523. s : string;
  1524. begin
  1525. p:=buf;
  1526. DeskTop^.Lock;
  1527. While assigned(p) do
  1528. begin
  1529. pe:=strscan(p,#10);
  1530. if pe<>nil then
  1531. pe^:=#0;
  1532. s:=strpas(p);
  1533. If IsError then
  1534. Editor^.AddErrorLine(S)
  1535. else
  1536. Editor^.AddLine(S);
  1537. { restore for dispose }
  1538. if pe<>nil then
  1539. pe^:=#10;
  1540. if pe=nil then
  1541. p:=nil
  1542. else
  1543. begin
  1544. p:=pe;
  1545. inc(p);
  1546. end;
  1547. end;
  1548. DeskTop^.Unlock;
  1549. Editor^.Draw;
  1550. end;
  1551. constructor TClipboardWindow.Init;
  1552. var R: TRect;
  1553. HSB,VSB: PScrollBar;
  1554. begin
  1555. Desktop^.GetExtent(R);
  1556. inherited Init(R, '');
  1557. SetTitle(dialog_clipboard);
  1558. HelpCtx:=hcClipboardWindow;
  1559. Number:=wnNoNumber;
  1560. AutoNumber:=true;
  1561. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  1562. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1563. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  1564. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1565. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  1566. New(Indicator, Init(R));
  1567. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  1568. Insert(Indicator);
  1569. GetExtent(R); R.Grow(-1,-1);
  1570. New(Editor, Init(R, HSB, VSB, Indicator, ''));
  1571. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1572. Insert(Editor);
  1573. Hide;
  1574. Clipboard:=Editor;
  1575. end;
  1576. procedure TClipboardWindow.Close;
  1577. begin
  1578. Hide;
  1579. end;
  1580. constructor TClipboardWindow.Load(var S: TStream);
  1581. begin
  1582. inherited Load(S);
  1583. Clipboard:=Editor;
  1584. end;
  1585. procedure TClipboardWindow.Store(var S: TStream);
  1586. begin
  1587. inherited Store(S);
  1588. end;
  1589. destructor TClipboardWindow.Done;
  1590. begin
  1591. inherited Done;
  1592. Clipboard:=nil;
  1593. ClipboardWindow:=nil;
  1594. end;
  1595. constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1596. begin
  1597. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1598. GrowMode:=gfGrowHiX+gfGrowHiY;
  1599. New(ModuleNames, Init(50,100));
  1600. NoSelection:=true;
  1601. end;
  1602. function TMessageListBox.GetLocalMenu: PMenu;
  1603. var M: PMenu;
  1604. begin
  1605. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1606. M:=NewMenu(
  1607. NewItem(menu_msglocal_clear,'',kbNoKey,cmMsgClear,hcMsgClear,
  1608. NewLine(
  1609. NewItem(menu_msglocal_gotosource,'',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1610. NewItem(menu_msglocal_tracksource,'',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
  1611. nil)))));
  1612. GetLocalMenu:=M;
  1613. end;
  1614. procedure TMessageListBox.HandleEvent(var Event: TEvent);
  1615. var DontClear: boolean;
  1616. begin
  1617. case Event.What of
  1618. evKeyDown :
  1619. begin
  1620. DontClear:=false;
  1621. case Event.KeyCode of
  1622. kbEnter :
  1623. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1624. else
  1625. DontClear:=true;
  1626. end;
  1627. if not DontClear then
  1628. ClearEvent(Event);
  1629. end;
  1630. evBroadcast :
  1631. case Event.Command of
  1632. cmListItemSelected :
  1633. if Event.InfoPtr=@Self then
  1634. Message(@Self,evCommand,cmMsgTrackSource,nil);
  1635. end;
  1636. evCommand :
  1637. begin
  1638. DontClear:=false;
  1639. case Event.Command of
  1640. cmMsgGotoSource :
  1641. if Range>0 then
  1642. GotoSource;
  1643. cmMsgTrackSource :
  1644. if Range>0 then
  1645. TrackSource;
  1646. cmMsgClear :
  1647. Clear;
  1648. else
  1649. DontClear:=true;
  1650. end;
  1651. if not DontClear then
  1652. ClearEvent(Event);
  1653. end;
  1654. end;
  1655. inherited HandleEvent(Event);
  1656. end;
  1657. procedure TMessageListBox.AddItem(P: PMessageItem);
  1658. var W : integer;
  1659. begin
  1660. if List=nil then New(List, Init(500,500));
  1661. W:=length(P^.GetText(255));
  1662. if W>MaxWidth then
  1663. begin
  1664. MaxWidth:=W;
  1665. if HScrollBar<>nil then
  1666. HScrollBar^.SetRange(0,MaxWidth);
  1667. end;
  1668. List^.Insert(P);
  1669. SetRange(List^.Count);
  1670. if Focused=List^.Count-1-1 then
  1671. FocusItem(List^.Count-1);
  1672. DrawView;
  1673. end;
  1674. function TMessageListBox.AddModuleName(const Name: string): PString;
  1675. var P: PString;
  1676. begin
  1677. if ModuleNames<>nil then
  1678. P:=ModuleNames^.Add(Name)
  1679. else
  1680. P:=nil;
  1681. AddModuleName:=P;
  1682. end;
  1683. function TMessageListBox.GetText(Item,MaxLen: Sw_Integer): String;
  1684. var P: PMessageItem;
  1685. S: string;
  1686. begin
  1687. P:=List^.At(Item);
  1688. S:=P^.GetText(MaxLen);
  1689. GetText:=copy(S,1,MaxLen);
  1690. end;
  1691. procedure TMessageListBox.Clear;
  1692. begin
  1693. if assigned(List) then
  1694. Dispose(List, Done);
  1695. List:=nil;
  1696. MaxWidth:=0;
  1697. if assigned(ModuleNames) then
  1698. ModuleNames^.FreeAll;
  1699. SetRange(0); DrawView;
  1700. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1701. end;
  1702. procedure TMessageListBox.TrackSource;
  1703. var W: PSourceWindow;
  1704. P: PMessageItem;
  1705. R: TRect;
  1706. Row,Col: sw_integer;
  1707. begin
  1708. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1709. if Range=0 then Exit;
  1710. P:=List^.At(Focused);
  1711. if P^.Row=0 then Exit;
  1712. Desktop^.Lock;
  1713. GetNextEditorBounds(R);
  1714. {$ifdef OLDCOMP}
  1715. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1716. {$endif}
  1717. R.B.Y:=Owner^.Origin.Y;
  1718. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1719. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1720. W:=EditorWindowFile(P^.GetModuleName);
  1721. if assigned(W) then
  1722. begin
  1723. W^.GetExtent(R);
  1724. {$ifdef OLDCOMP}
  1725. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1726. {$endif}
  1727. R.B.Y:=Owner^.Origin.Y;
  1728. W^.ChangeBounds(R);
  1729. W^.Editor^.SetCurPtr(Col,Row);
  1730. end
  1731. else
  1732. W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
  1733. if W<>nil then
  1734. begin
  1735. W^.Select;
  1736. W^.Editor^.TrackCursor(true);
  1737. W^.Editor^.SetLineFlagExclusive(lfHighlightRow,Row);
  1738. end;
  1739. if Assigned(Owner) then
  1740. Owner^.Select;
  1741. Desktop^.UnLock;
  1742. end;
  1743. procedure TMessageListBox.GotoSource;
  1744. var W: PSourceWindow;
  1745. P: PMessageItem;
  1746. R:TRect;
  1747. Row,Col: sw_integer;
  1748. begin
  1749. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1750. if Range=0 then Exit;
  1751. P:=List^.At(Focused);
  1752. if P^.Row=0 then Exit;
  1753. Desktop^.Lock;
  1754. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1755. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1756. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  1757. if assigned(W) then
  1758. begin
  1759. { Message(Owner,evCommand,cmClose,nil);
  1760. This calls close on StackWindow
  1761. rendering P invalid
  1762. so postpone it PM }
  1763. W^.GetExtent(R);
  1764. if (P^.TClass<>0) then
  1765. W^.Editor^.SetErrorMessage(P^.GetText(R.B.X-R.A.X));
  1766. W^.Select;
  1767. Message(Owner,evCommand,cmClose,nil);
  1768. end;
  1769. Desktop^.UnLock;
  1770. end;
  1771. procedure TMessageListBox.Draw;
  1772. var
  1773. I, J, Item: Sw_Integer;
  1774. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1775. ColWidth, CurCol, Indent: Integer;
  1776. B: TDrawBuffer;
  1777. Text: String;
  1778. SCOff: Byte;
  1779. TC: byte;
  1780. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1781. begin
  1782. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1783. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1784. begin
  1785. NormalColor := GetColor(1);
  1786. FocusedColor := GetColor(3);
  1787. SelectedColor := GetColor(4);
  1788. end else
  1789. begin
  1790. NormalColor := GetColor(2);
  1791. SelectedColor := GetColor(4);
  1792. end;
  1793. if Transparent then
  1794. begin MT(NormalColor); MT(SelectedColor); end;
  1795. if NoSelection then
  1796. SelectedColor:=NormalColor;
  1797. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1798. else Indent := 0;
  1799. ColWidth := Size.X div NumCols + 1;
  1800. for I := 0 to Size.Y - 1 do
  1801. begin
  1802. for J := 0 to NumCols-1 do
  1803. begin
  1804. Item := J*Size.Y + I + TopItem;
  1805. CurCol := J*ColWidth;
  1806. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1807. (Focused = Item) and (Range > 0) then
  1808. begin
  1809. Color := FocusedColor;
  1810. SetCursor(CurCol+1,I);
  1811. SCOff := 0;
  1812. end
  1813. else if (Item < Range) and IsSelected(Item) then
  1814. begin
  1815. Color := SelectedColor;
  1816. SCOff := 2;
  1817. end
  1818. else
  1819. begin
  1820. Color := NormalColor;
  1821. SCOff := 4;
  1822. end;
  1823. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1824. if Item < Range then
  1825. begin
  1826. Text := GetText(Item, ColWidth + Indent);
  1827. Text := Copy(Text,Indent,ColWidth);
  1828. MoveStr(B[CurCol+1], Text, Color);
  1829. if ShowMarkers then
  1830. begin
  1831. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1832. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1833. end;
  1834. end;
  1835. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1836. end;
  1837. WriteLine(0, I, Size.X, 1, B);
  1838. end;
  1839. end;
  1840. constructor TMessageListBox.Load(var S: TStream);
  1841. begin
  1842. inherited Load(S);
  1843. New(ModuleNames, Init(50,100));
  1844. NoSelection:=true;
  1845. end;
  1846. procedure TMessageListBox.Store(var S: TStream);
  1847. var OL: PCollection;
  1848. ORV: sw_integer;
  1849. begin
  1850. OL:=List; ORV:=Range;
  1851. New(List, Init(1,1)); Range:=0;
  1852. inherited Store(S);
  1853. Dispose(List, Done);
  1854. List:=OL; Range:=ORV;
  1855. { ^^^ nasty trick - has anyone a better idea how to avoid storing the
  1856. collection? Pasting here a modified version of TListBox.Store+
  1857. TAdvancedListBox.Store isn't a better solution, since by eventually
  1858. changing the obj-hierarchy you'll always have to modify this, too - BG }
  1859. end;
  1860. destructor TMessageListBox.Done;
  1861. begin
  1862. inherited Done;
  1863. if List<>nil then Dispose(List, Done);
  1864. if ModuleNames<>nil then Dispose(ModuleNames, Done);
  1865. end;
  1866. constructor TMessageItem.Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
  1867. begin
  1868. inherited Init;
  1869. TClass:=AClass;
  1870. Text:=NewStr(AText);
  1871. Module:=AModule;
  1872. Row:=ARow; Col:=ACol;
  1873. end;
  1874. function TMessageItem.GetText(MaxLen: Sw_integer): string;
  1875. var S: string;
  1876. begin
  1877. if Text=nil then S:='' else S:=Text^;
  1878. if (Module<>nil) then
  1879. S:=NameAndExtOf(Module^)+'('+IntToStr(Row)+') '+S;
  1880. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1881. GetText:=S;
  1882. end;
  1883. procedure TMessageItem.Selected;
  1884. begin
  1885. end;
  1886. function TMessageItem.GetModuleName: string;
  1887. begin
  1888. GetModuleName:=GetStr(Module);
  1889. end;
  1890. destructor TMessageItem.Done;
  1891. begin
  1892. inherited Done;
  1893. if Text<>nil then DisposeStr(Text);
  1894. { if Module<>nil then DisposeStr(Module);}
  1895. end;
  1896. {$ifdef OLDCOMP}
  1897. function TCompilerMessage.GetText(MaxLen: Integer): String;
  1898. var ClassS: string[20];
  1899. S: string;
  1900. begin
  1901. if TClass=
  1902. V_Fatal then ClassS:='Fatal' else if TClass =
  1903. V_Error then ClassS:='Error' else if TClass =
  1904. V_Normal then ClassS:='' else if TClass =
  1905. V_Warning then ClassS:='Warning' else if TClass =
  1906. V_Note then ClassS:='Note' else if TClass =
  1907. V_Hint then ClassS:='Hint' else if TClass =
  1908. V_Macro then ClassS:='Macro' else if TClass =
  1909. V_Procedure then ClassS:='Procedure' else if TClass =
  1910. V_Conditional then ClassS:='Conditional' else if TClass =
  1911. V_Info then ClassS:='Info' else if TClass =
  1912. V_Status then ClassS:='Status' else if TClass =
  1913. V_Used then ClassS:='Used' else if TClass =
  1914. V_Tried then ClassS:='Tried' else if TClass =
  1915. V_Debug then ClassS:='Debug'
  1916. else
  1917. ClassS:='???';
  1918. if ClassS<>'' then
  1919. ClassS:=RExpand(ClassS,0)+': ';
  1920. S:=ClassS;
  1921. if (Module<>nil) {and (ID<>0)} then
  1922. S:=S+NameAndExtOf(Module^)+'('+IntToStr(Row)+') ';
  1923. if Text<>nil then S:=S+Text^;
  1924. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1925. GetText:=S;
  1926. end;
  1927. {$endif}
  1928. constructor TProgramInfoWindow.Init;
  1929. var R,R2: TRect;
  1930. HSB,VSB: PScrollBar;
  1931. ST: PStaticText;
  1932. C: word;
  1933. const White = 15;
  1934. begin
  1935. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
  1936. inherited Init(R, dialog_programinformation, wnNoNumber);
  1937. HelpCtx:=hcInfoWindow;
  1938. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
  1939. C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
  1940. New(InfoST, Init(R,'', C, false)); InfoST^.GrowMode:=gfGrowHiX;
  1941. Insert(InfoST);
  1942. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
  1943. New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
  1944. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
  1945. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1946. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1947. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1948. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1949. New(LogLB, Init(R,HSB,VSB));
  1950. LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1951. LogLB^.Transparent:=true;
  1952. Insert(LogLB);
  1953. Update;
  1954. end;
  1955. constructor TProgramInfoWindow.Load(var S : TStream);
  1956. begin
  1957. inherited Load(S);
  1958. GetSubViewPtr(S,InfoST);
  1959. GetSubViewPtr(S,LogLB);
  1960. end;
  1961. procedure TProgramInfoWindow.Store(var S : TStream);
  1962. begin
  1963. inherited Store(S);
  1964. PutSubViewPtr(S,InfoST);
  1965. PutSubViewPtr(S,LogLB);
  1966. end;
  1967. procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  1968. begin
  1969. if AClass>=V_Info then Line:=0;
  1970. LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, LogLB^.AddModuleName(Module), Line, Column)));
  1971. end;
  1972. procedure TProgramInfoWindow.ClearMessages;
  1973. begin
  1974. LogLB^.Clear;
  1975. ReDraw;
  1976. end;
  1977. procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
  1978. begin
  1979. inherited SizeLimits(Min,Max);
  1980. Min.X:=30; Min.Y:=9;
  1981. end;
  1982. procedure TProgramInfoWindow.Close;
  1983. begin
  1984. Hide;
  1985. end;
  1986. procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
  1987. begin
  1988. case Event.What of
  1989. evBroadcast :
  1990. case Event.Command of
  1991. cmUpdate :
  1992. Update;
  1993. end;
  1994. end;
  1995. inherited HandleEvent(Event);
  1996. end;
  1997. procedure TProgramInfoWindow.Update;
  1998. begin
  1999. ClearFormatParams;
  2000. AddFormatParamStr(label_proginfo_currentmodule);
  2001. AddFormatParamStr(MainFile);
  2002. AddFormatParamStr(label_proginfo_lastexitcode);
  2003. AddFormatParamInt(LastExitCode);
  2004. AddFormatParamStr(label_proginfo_availablememory);
  2005. AddFormatParamInt(MemAvail div 1024);
  2006. InfoST^.SetText(
  2007. FormatStrF(
  2008. {#13+ }
  2009. '%24s : %s'#13+
  2010. '%24s : %d'#13+
  2011. '%24s : %5d'+'K'+#13+
  2012. '',
  2013. FormatParams)
  2014. );
  2015. end;
  2016. destructor TProgramInfoWindow.Done;
  2017. begin
  2018. inherited Done;
  2019. ProgramInfoWindow:=nil;
  2020. end;
  2021. constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
  2022. begin
  2023. inherited Init(Bounds);
  2024. Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
  2025. GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
  2026. TabDefs:=ATabDef;
  2027. ActiveDef:=-1;
  2028. SelectTab(0);
  2029. ReDraw;
  2030. end;
  2031. function TTab.TabCount: integer;
  2032. var i: integer;
  2033. P: PTabDef;
  2034. begin
  2035. I:=0; P:=TabDefs;
  2036. while (P<>nil) do
  2037. begin
  2038. Inc(I);
  2039. P:=P^.Next;
  2040. end;
  2041. TabCount:=I;
  2042. end;
  2043. function TTab.AtTab(Index: integer): PTabDef;
  2044. var i: integer;
  2045. P: PTabDef;
  2046. begin
  2047. i:=0; P:=TabDefs;
  2048. while (I<Index) do
  2049. begin
  2050. if P=nil then RunError($AA);
  2051. P:=P^.Next;
  2052. Inc(i);
  2053. end;
  2054. AtTab:=P;
  2055. end;
  2056. procedure TTab.SelectTab(Index: integer);
  2057. var P: PTabItem;
  2058. V: PView;
  2059. begin
  2060. if ActiveDef<>Index then
  2061. begin
  2062. if Owner<>nil then Owner^.Lock;
  2063. Lock;
  2064. { --- Update --- }
  2065. if TabDefs<>nil then
  2066. begin
  2067. DefCount:=1;
  2068. while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
  2069. end
  2070. else DefCount:=0;
  2071. if ActiveDef<>-1 then
  2072. begin
  2073. P:=AtTab(ActiveDef)^.Items;
  2074. while P<>nil do
  2075. begin
  2076. if P^.View<>nil then Delete(P^.View);
  2077. P:=P^.Next;
  2078. end;
  2079. end;
  2080. ActiveDef:=Index;
  2081. P:=AtTab(ActiveDef)^.Items;
  2082. while P<>nil do
  2083. begin
  2084. if P^.View<>nil then Insert(P^.View);
  2085. P:=P^.Next;
  2086. end;
  2087. V:=AtTab(ActiveDef)^.DefItem;
  2088. if V<>nil then V^.Select;
  2089. ReDraw;
  2090. { --- Update --- }
  2091. UnLock;
  2092. if Owner<>nil then Owner^.UnLock;
  2093. DrawView;
  2094. end;
  2095. end;
  2096. procedure TTab.ChangeBounds(var Bounds: TRect);
  2097. var D: TPoint;
  2098. procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
  2099. var
  2100. R: TRect;
  2101. begin
  2102. if P^.Owner=nil then Exit; { it think this is a bug in TV }
  2103. P^.CalcBounds(R, D);
  2104. P^.ChangeBounds(R);
  2105. end;
  2106. var
  2107. P: PTabItem;
  2108. I: integer;
  2109. begin
  2110. D.X := Bounds.B.X - Bounds.A.X - Size.X;
  2111. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  2112. inherited ChangeBounds(Bounds);
  2113. for I:=0 to TabCount-1 do
  2114. if I<>ActiveDef then
  2115. begin
  2116. P:=AtTab(I)^.Items;
  2117. while P<>nil do
  2118. begin
  2119. if P^.View<>nil then DoCalcChange(P^.View);
  2120. P:=P^.Next;
  2121. end;
  2122. end;
  2123. end;
  2124. procedure TTab.SelectNextTab(Forwards: boolean);
  2125. var Index: integer;
  2126. begin
  2127. Index:=ActiveDef;
  2128. if Index=-1 then Exit;
  2129. if Forwards then Inc(Index) else Dec(Index);
  2130. if Index<0 then Index:=DefCount-1 else
  2131. if Index>DefCount-1 then Index:=0;
  2132. SelectTab(Index);
  2133. end;
  2134. procedure TTab.HandleEvent(var Event: TEvent);
  2135. var Index : integer;
  2136. I : integer;
  2137. X : integer;
  2138. Len : byte;
  2139. P : TPoint;
  2140. V : PView;
  2141. CallOrig: boolean;
  2142. LastV : PView;
  2143. FirstV: PView;
  2144. function FirstSelectable: PView;
  2145. var
  2146. FV : PView;
  2147. begin
  2148. FV := First;
  2149. while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
  2150. FV:=FV^.Next;
  2151. if FV<>nil then
  2152. if (FV^.Options and ofSelectable)=0 then FV:=nil;
  2153. FirstSelectable:=FV;
  2154. end;
  2155. function LastSelectable: PView;
  2156. var
  2157. LV : PView;
  2158. begin
  2159. LV := Last;
  2160. while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
  2161. LV:=LV^.Prev;
  2162. if LV<>nil then
  2163. if (LV^.Options and ofSelectable)=0 then LV:=nil;
  2164. LastSelectable:=LV;
  2165. end;
  2166. begin
  2167. if (Event.What and evMouseDown)<>0 then
  2168. begin
  2169. MakeLocal(Event.Where,P);
  2170. if P.Y<3 then
  2171. begin
  2172. Index:=-1; X:=1;
  2173. for i:=0 to DefCount-1 do
  2174. begin
  2175. Len:=CStrLen(AtTab(i)^.Name^);
  2176. if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
  2177. X:=X+Len+3;
  2178. end;
  2179. if Index<>-1 then
  2180. SelectTab(Index);
  2181. end;
  2182. end;
  2183. if Event.What=evKeyDown then
  2184. begin
  2185. Index:=-1;
  2186. case Event.KeyCode of
  2187. kbCtrlTab :
  2188. begin
  2189. SelectNextTab((Event.KeyShift and kbShift)=0);
  2190. ClearEvent(Event);
  2191. end;
  2192. kbTab,kbShiftTab :
  2193. if GetState(sfSelected) then
  2194. begin
  2195. if Current<>nil then
  2196. begin
  2197. LastV:=LastSelectable; FirstV:=FirstSelectable;
  2198. if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
  2199. begin
  2200. if Owner<>nil then Owner^.SelectNext(true);
  2201. end else
  2202. if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
  2203. begin
  2204. Lock;
  2205. if Owner<>nil then Owner^.SelectNext(false);
  2206. UnLock;
  2207. end else
  2208. SelectNext(Event.KeyCode=kbShiftTab);
  2209. ClearEvent(Event);
  2210. end;
  2211. end;
  2212. else
  2213. for I:=0 to DefCount-1 do
  2214. begin
  2215. if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
  2216. then begin
  2217. Index:=I;
  2218. ClearEvent(Event);
  2219. Break;
  2220. end;
  2221. end;
  2222. end;
  2223. if Index<>-1 then
  2224. begin
  2225. Select;
  2226. SelectTab(Index);
  2227. V:=AtTab(ActiveDef)^.DefItem;
  2228. if V<>nil then V^.Focus;
  2229. end;
  2230. end;
  2231. CallOrig:=true;
  2232. if Event.What=evKeyDown then
  2233. begin
  2234. if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
  2235. then
  2236. else CallOrig:=false;
  2237. end;
  2238. if CallOrig then inherited HandleEvent(Event);
  2239. end;
  2240. function TTab.GetPalette: PPalette;
  2241. begin
  2242. GetPalette:=nil;
  2243. end;
  2244. procedure TTab.Draw;
  2245. var B : TDrawBuffer;
  2246. i : integer;
  2247. C1,C2,C3,C : word;
  2248. HeaderLen : integer;
  2249. X,X2 : integer;
  2250. Name : PString;
  2251. ActiveKPos : integer;
  2252. ActiveVPos : integer;
  2253. FC : char;
  2254. ClipR : TRect;
  2255. procedure SWriteBuf(X,Y,W,H: integer; var Buf);
  2256. var i: integer;
  2257. begin
  2258. if Y+H>Size.Y then H:=Size.Y-Y;
  2259. if X+W>Size.X then W:=Size.X-X;
  2260. if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
  2261. else for i:=1 to H do
  2262. Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
  2263. end;
  2264. procedure ClearBuf;
  2265. begin
  2266. MoveChar(B,' ',C1,Size.X);
  2267. end;
  2268. begin
  2269. if InDraw then Exit;
  2270. InDraw:=true;
  2271. { - Start of TGroup.Draw - }
  2272. if Buffer = nil then
  2273. begin
  2274. GetBuffer;
  2275. end;
  2276. { - Start of TGroup.Draw - }
  2277. C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
  2278. HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
  2279. if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
  2280. { --- 1. sor --- }
  2281. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
  2282. X:=1;
  2283. for i:=0 to DefCount-1 do
  2284. begin
  2285. Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
  2286. if i=ActiveDef
  2287. then begin
  2288. ActiveKPos:=X-1;
  2289. ActiveVPos:=X+X2+2;
  2290. if GetState(sfFocused) then C:=C3 else C:=C2;
  2291. end
  2292. else C:=C2;
  2293. MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
  2294. MoveChar(B[X-1],'³',C1,1);
  2295. end;
  2296. SWriteBuf(0,1,Size.X,1,B);
  2297. { --- 0. sor --- }
  2298. ClearBuf; MoveChar(B[0],'Ú',C1,1);
  2299. X:=1;
  2300. for i:=0 to DefCount-1 do
  2301. begin
  2302. if I<ActiveDef then FC:='Ú'
  2303. else FC:='¿';
  2304. X2:=CStrLen(AtTab(i)^.Name^)+2;
  2305. MoveChar(B[X+X2],{'Â'}FC,C1,1);
  2306. if i=DefCount-1 then X2:=X2+1;
  2307. if X2>0 then
  2308. MoveChar(B[X],'Ä',C1,X2);
  2309. X:=X+X2+1;
  2310. end;
  2311. MoveChar(B[HeaderLen+1],'¿',C1,1);
  2312. MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
  2313. SWriteBuf(0,0,Size.X,1,B);
  2314. { --- 2. sor --- }
  2315. MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
  2316. MoveChar(B[Size.X-1],'¿',C1,1);
  2317. MoveChar(B[ActiveKPos],'Ù',C1,1);
  2318. if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
  2319. else MoveChar(B[0],{'Ã'}'Ú',C1,1);
  2320. MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
  2321. MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
  2322. SWriteBuf(0,2,Size.X,1,B);
  2323. { --- marad‚k sor --- }
  2324. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
  2325. SWriteBuf(0,3,Size.X,Size.Y-4,B);
  2326. { --- Size.X . sor --- }
  2327. MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
  2328. SWriteBuf(0,Size.Y-1,Size.X,1,B);
  2329. { - End of TGroup.Draw - }
  2330. if Buffer <> nil then
  2331. begin
  2332. Lock;
  2333. Redraw;
  2334. UnLock;
  2335. end;
  2336. if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  2337. begin
  2338. GetClipRect(ClipR);
  2339. Redraw;
  2340. GetExtent(ClipR);
  2341. end;
  2342. { - End of TGroup.Draw - }
  2343. InDraw:=false;
  2344. end;
  2345. function TTab.Valid(Command: Word): Boolean;
  2346. var PT : PTabDef;
  2347. PI : PTabItem;
  2348. OK : boolean;
  2349. begin
  2350. OK:=true;
  2351. PT:=TabDefs;
  2352. while (PT<>nil) and (OK=true) do
  2353. begin
  2354. PI:=PT^.Items;
  2355. while (PI<>nil) and (OK=true) do
  2356. begin
  2357. if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
  2358. PI:=PI^.Next;
  2359. end;
  2360. PT:=PT^.Next;
  2361. end;
  2362. Valid:=OK;
  2363. end;
  2364. procedure TTab.SetState(AState: Word; Enable: Boolean);
  2365. begin
  2366. inherited SetState(AState,Enable);
  2367. if (AState and sfFocused)<>0 then DrawView;
  2368. end;
  2369. destructor TTab.Done;
  2370. var P,X: PTabDef;
  2371. procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
  2372. begin
  2373. if P<>nil then Delete(P);
  2374. end;
  2375. begin
  2376. ForEach(@DeleteViews);
  2377. inherited Done;
  2378. P:=TabDefs;
  2379. while P<>nil do
  2380. begin
  2381. X:=P^.Next;
  2382. DisposeTabDef(P);
  2383. P:=X;
  2384. end;
  2385. end;
  2386. constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  2387. AScreen: PScreen);
  2388. begin
  2389. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  2390. Screen:=AScreen;
  2391. if Screen=nil then
  2392. Fail;
  2393. SetState(sfCursorVis,true);
  2394. Update;
  2395. end;
  2396. procedure TScreenView.Update;
  2397. begin
  2398. SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
  2399. DrawView;
  2400. end;
  2401. procedure TScreenView.HandleEvent(var Event: TEvent);
  2402. begin
  2403. case Event.What of
  2404. evBroadcast :
  2405. case Event.Command of
  2406. cmUpdate : Update;
  2407. end;
  2408. end;
  2409. inherited HandleEvent(Event);
  2410. end;
  2411. procedure TScreenView.Draw;
  2412. var B: TDrawBuffer;
  2413. X,Y: integer;
  2414. Text,Attr: string;
  2415. P: TPoint;
  2416. begin
  2417. Screen^.GetCursorPos(P);
  2418. for Y:=Delta.Y to Delta.Y+Size.Y-1 do
  2419. begin
  2420. if Y<Screen^.GetHeight then
  2421. Screen^.GetLine(Y,Text,Attr)
  2422. else
  2423. begin Text:=''; Attr:=''; end;
  2424. Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
  2425. MoveChar(B,' ',0,Size.X);
  2426. for X:=1 to length(Text) do
  2427. MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
  2428. WriteLine(0,Y-Delta.Y,Size.X,1,B);
  2429. end;
  2430. SetCursor(P.X-Delta.X,P.Y-Delta.Y);
  2431. end;
  2432. constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
  2433. var R: TRect;
  2434. VSB,HSB: PScrollBar;
  2435. begin
  2436. Desktop^.GetExtent(R);
  2437. inherited Init(R, dialog_userscreen, ANumber);
  2438. Options:=Options or ofTileAble;
  2439. GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
  2440. New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
  2441. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  2442. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
  2443. New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
  2444. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  2445. GetExtent(R); R.Grow(-1,-1);
  2446. New(ScreenView, Init(R, HSB, VSB, AScreen));
  2447. ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2448. Insert(ScreenView);
  2449. UserScreenWindow:=@Self;
  2450. end;
  2451. destructor TScreenWindow.Done;
  2452. begin
  2453. inherited Done;
  2454. UserScreenWindow:=nil;
  2455. end;
  2456. const InTranslate : boolean = false;
  2457. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  2458. procedure TranslateAction(Action: integer);
  2459. var E: TEvent;
  2460. begin
  2461. if Action<>acNone then
  2462. begin
  2463. E:=Event;
  2464. E.What:=evMouseDown; E.Buttons:=mbLeftButton;
  2465. View^.HandleEvent(E);
  2466. Event.What:=evCommand;
  2467. Event.Command:=ActionCommands[Action];
  2468. end;
  2469. end;
  2470. begin
  2471. if InTranslate then Exit;
  2472. InTranslate:=true;
  2473. case Event.What of
  2474. evMouseDown :
  2475. if (GetShiftState and kbAlt)<>0 then
  2476. TranslateAction(AltMouseAction) else
  2477. if (GetShiftState and kbCtrl)<>0 then
  2478. TranslateAction(CtrlMouseAction);
  2479. end;
  2480. InTranslate:=false;
  2481. end;
  2482. function GetNextEditorBounds(var Bounds: TRect): boolean;
  2483. var P: PView;
  2484. begin
  2485. P:=Desktop^.Current;
  2486. while P<>nil do
  2487. begin
  2488. if P^.HelpCtx=hcSourceWindow then Break;
  2489. P:=P^.NextView;
  2490. if P=Desktop^.Current then
  2491. begin
  2492. P:=nil;
  2493. break;
  2494. end;
  2495. end;
  2496. if P=nil then Desktop^.GetExtent(Bounds) else
  2497. begin
  2498. P^.GetBounds(Bounds);
  2499. Inc(Bounds.A.X); Inc(Bounds.A.Y);
  2500. end;
  2501. GetNextEditorBounds:=P<>nil;
  2502. end;
  2503. function IOpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer; ShowIt: boolean): PSourceWindow;
  2504. var R: TRect;
  2505. W: PSourceWindow;
  2506. begin
  2507. if Assigned(Bounds) then R.Copy(Bounds^) else
  2508. GetNextEditorBounds(R);
  2509. PushStatus(FormatStrStr(msg_openingsourcefile,SmartPath(FileName)));
  2510. New(W, Init(R, FileName));
  2511. if ShowIt=false then
  2512. W^.Hide;
  2513. if W<>nil then
  2514. begin
  2515. if (CurX<>0) or (CurY<>0) then
  2516. with W^.Editor^ do
  2517. begin
  2518. SetCurPtr(CurX,CurY);
  2519. TrackCursor(true);
  2520. end;
  2521. W^.HelpCtx:=hcSourceWindow;
  2522. Desktop^.Insert(W);
  2523. Message(Application,evBroadcast,cmUpdate,nil);
  2524. end;
  2525. PopStatus;
  2526. IOpenEditorWindow:=W;
  2527. end;
  2528. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  2529. begin
  2530. OpenEditorWindow:=IOpenEditorWindow(Bounds,FileName,CurX,CurY,true);
  2531. end;
  2532. function SearchOnDesktop(FileName : string;tryexts:boolean) : PSourceWindow;
  2533. var
  2534. D,DS : DirStr;
  2535. N,NS : NameStr;
  2536. E,ES : ExtStr;
  2537. SName : string;
  2538. function IsSearchedFile(W : PSourceWindow) : boolean;
  2539. var Found: boolean;
  2540. begin
  2541. Found:=false;
  2542. if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
  2543. begin
  2544. if (D='') then
  2545. SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
  2546. else
  2547. SName:=PSourceWindow(W)^.Editor^.FileName;
  2548. FSplit(SName,DS,NS,ES);
  2549. SName:=UpcaseStr(NS+ES);
  2550. if (E<>'') or (not tryexts) then
  2551. begin
  2552. if D<>'' then
  2553. Found:=UpCaseStr(DS)+SName=UpcaseStr(D+N+E)
  2554. else
  2555. Found:=SName=UpcaseStr(N+E);
  2556. end
  2557. else
  2558. begin
  2559. Found:=SName=UpcaseStr(N+'.pp');
  2560. if Found=false then
  2561. Found:=SName=UpcaseStr(N+'.pas');
  2562. end;
  2563. end;
  2564. IsSearchedFile:=found;
  2565. end;
  2566. function IsSearchedSource(P: PView) : boolean; {$ifndef FPC}far;{$endif}
  2567. begin
  2568. if assigned(P) and
  2569. (TypeOf(P^)=TypeOf(TSourceWindow)) then
  2570. IsSearchedSource:=IsSearchedFile(PSourceWindow(P))
  2571. else
  2572. IsSearchedSource:=false;
  2573. end;
  2574. begin
  2575. FSplit(FileName,D,N,E);
  2576. SearchOnDesktop:=PSourceWindow(Desktop^.FirstThat(@IsSearchedSource));
  2577. end;
  2578. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  2579. begin
  2580. TryToOpenFile:=ITryToOpenFile(Bounds,FileName,CurX,CurY,tryexts,true,false);
  2581. end;
  2582. function ITryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean;
  2583. ShowIt,ForceNewWindow: boolean): PSourceWindow;
  2584. var D : DirStr;
  2585. N : NameStr;
  2586. E : ExtStr;
  2587. DrStr : String;
  2588. function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
  2589. var OK: boolean;
  2590. begin
  2591. NewDir:=CompleteDir(NewDir);
  2592. OK:=ExistsFile(NewDir+NewName+NewExt);
  2593. if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
  2594. CheckDir:=OK;
  2595. end;
  2596. function CheckExt(NewExt: ExtStr): boolean;
  2597. var OK: boolean;
  2598. begin
  2599. OK:=false;
  2600. if D<>'' then OK:=CheckDir(D,N,NewExt) else
  2601. if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
  2602. CheckExt:=OK;
  2603. end;
  2604. function TryToOpen(const DD : dirstr): PSourceWindow;
  2605. var Found: boolean;
  2606. W : PSourceWindow;
  2607. begin
  2608. D:=CompleteDir(DD);
  2609. Found:=true;
  2610. if (E<>'') or (not tryexts) then
  2611. Found:=CheckExt(E)
  2612. else
  2613. if CheckExt('.pp') then
  2614. Found:=true
  2615. else
  2616. if CheckExt('.pas') then
  2617. Found:=true
  2618. else
  2619. if CheckExt('.inc') then
  2620. Found:=true
  2621. else
  2622. Found:=false;
  2623. if Found=false then
  2624. W:=nil
  2625. else
  2626. begin
  2627. FileName:=FExpand(D+N+E);
  2628. W:=IOpenEditorWindow(Bounds,FileName,CurX,CurY,ShowIt);
  2629. end;
  2630. TryToOpen:=W;
  2631. end;
  2632. var
  2633. W : PSourceWindow;
  2634. begin
  2635. if ForceNewWindow then
  2636. W:=nil
  2637. else
  2638. W:=SearchOnDesktop(FileName,tryexts);
  2639. if W<>nil then
  2640. begin
  2641. NewEditorOpened:=false;
  2642. { if assigned(Bounds) then
  2643. W^.ChangeBounds(Bounds^);}
  2644. W^.Editor^.SetCurPtr(CurX,CurY);
  2645. end
  2646. else
  2647. begin
  2648. FSplit(FileName,D,N,E);
  2649. if D<>'' then
  2650. W:=TryToOpen(D);
  2651. DrStr:=GetSourceDirectories;
  2652. if not assigned(W) then
  2653. While pos(';',DrStr)>0 do
  2654. Begin
  2655. W:=TryToOpen(Copy(DrStr,1,pos(';',DrStr)-1));
  2656. if assigned(W) then
  2657. break;
  2658. DrStr:=Copy(DrStr,pos(';',DrStr)+1,255);
  2659. End;
  2660. if not assigned(W) then
  2661. W:=TryToOpen(DrStr);
  2662. NewEditorOpened:=W<>nil;
  2663. if assigned(W) then
  2664. W^.Editor^.SetCurPtr(CurX,CurY);
  2665. end;
  2666. ITryToOpenFile:=W;
  2667. end;
  2668. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  2669. var OK: boolean;
  2670. E: PFileEditor;
  2671. R: TRect;
  2672. begin
  2673. R.Assign(0,0,0,0);
  2674. New(E, Init(R,nil,nil,nil,nil,FileName));
  2675. OK:=E<>nil;
  2676. if OK then
  2677. begin
  2678. PushStatus(FormatStrStr(msg_readingfileineditor,FileName));
  2679. OK:=E^.LoadFile;
  2680. PopStatus;
  2681. end;
  2682. if OK then
  2683. begin
  2684. Editor^.Lock;
  2685. E^.SelectAll(true);
  2686. Editor^.InsertFrom(E);
  2687. Editor^.SetCurPtr(0,0);
  2688. Editor^.SelectAll(false);
  2689. Editor^.UnLock;
  2690. Dispose(E, Done);
  2691. end;
  2692. StartEditor:=OK;
  2693. end;
  2694. constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  2695. begin
  2696. inherited Init(Bounds,'');
  2697. EventMask:=EventMask or evIdle;
  2698. Speed:=ASpeed; Lines:=AText;
  2699. end;
  2700. function TTextScroller.GetLineCount: integer;
  2701. var Count: integer;
  2702. begin
  2703. if Lines=nil then Count:=0 else
  2704. Count:=Lines^.Count;
  2705. GetLineCount:=Count;
  2706. end;
  2707. function TTextScroller.GetLine(I: integer): string;
  2708. var S: string;
  2709. begin
  2710. if I<Lines^.Count then
  2711. S:=GetStr(Lines^.At(I))
  2712. else
  2713. S:='';
  2714. GetLine:=S;
  2715. end;
  2716. procedure TTextScroller.HandleEvent(var Event: TEvent);
  2717. begin
  2718. case Event.What of
  2719. evIdle :
  2720. Update;
  2721. end;
  2722. inherited HandleEvent(Event);
  2723. end;
  2724. procedure TTextScroller.Update;
  2725. begin
  2726. if abs(GetDosTicks-LastTT)<Speed then Exit;
  2727. Scroll;
  2728. LastTT:=GetDosTicks;
  2729. end;
  2730. procedure TTextScroller.Reset;
  2731. begin
  2732. TopLine:=0;
  2733. LastTT:=GetDosTicks;
  2734. DrawView;
  2735. end;
  2736. procedure TTextScroller.Scroll;
  2737. begin
  2738. Inc(TopLine);
  2739. if TopLine>=GetLineCount then
  2740. Reset;
  2741. DrawView;
  2742. end;
  2743. procedure TTextScroller.Draw;
  2744. var B: TDrawBuffer;
  2745. C: word;
  2746. Count,Y: integer;
  2747. S: string;
  2748. begin
  2749. C:=GetColor(1);
  2750. Count:=GetLineCount;
  2751. for Y:=0 to Size.Y-1 do
  2752. begin
  2753. if Count=0 then S:='' else
  2754. S:=GetLine((TopLine+Y) mod Count);
  2755. if copy(S,1,1)=^C then
  2756. S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
  2757. MoveChar(B,' ',C,Size.X);
  2758. MoveStr(B,S,C);
  2759. WriteLine(0,Y,Size.X,1,B);
  2760. end;
  2761. end;
  2762. destructor TTextScroller.Done;
  2763. begin
  2764. inherited Done;
  2765. if Lines<>nil then Dispose(Lines, Done);
  2766. end;
  2767. constructor TFPAboutDialog.Init;
  2768. var R,R2: TRect;
  2769. C: PUnsortedStringCollection;
  2770. I: integer;
  2771. OSStr: string;
  2772. procedure AddLine(S: string);
  2773. begin
  2774. C^.Insert(NewStr(S));
  2775. end;
  2776. begin
  2777. OSStr:='';
  2778. {$ifdef go32v2}
  2779. OSStr:='Dos';
  2780. {$endif}
  2781. {$ifdef tp}
  2782. OSStr:='Dos';
  2783. {$endif}
  2784. {$ifdef linux}
  2785. OSStr:='Linux';
  2786. {$endif}
  2787. {$ifdef win32}
  2788. OSStr:='Win32';
  2789. {$endif}
  2790. {$ifdef os2}
  2791. OSStr:='OS/2';
  2792. {$endif}
  2793. R.Assign(0,0,38,14{$ifdef NODEBUG}-1{$endif});
  2794. inherited Init(R, dialog_about);
  2795. GetExtent(R); R.Grow(-3,-2);
  2796. R2.Copy(R); R2.B.Y:=R2.A.Y+1;
  2797. Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE for '+OSStr)));
  2798. R2.Move(0,1);
  2799. Insert(New(PStaticText, Init(R2, ^C'Version '+VersionStr
  2800. {$ifdef FPC}+' '+{$i %date%}{$endif}
  2801. )));
  2802. R2.Move(0,1);
  2803. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_compilerversion,Version_String))));
  2804. {$ifndef NODEBUG}
  2805. if pos('Fake',GDBVersion)=0 then
  2806. begin
  2807. R2.Move(0,1);
  2808. Insert(New(PStaticText, Init(R2, FormatStrStr2(^C'(%s %s)',label_about_debugger,GDBVersion))));
  2809. R2.Move(0,1);
  2810. end
  2811. else
  2812. {$endif NODEBUG}
  2813. R2.Move(0,2);
  2814. Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-2000 by')));
  2815. R2.Move(0,2);
  2816. Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
  2817. R2.Move(0,1);
  2818. Insert(New(PStaticText, Init(R2, ^C'Pierre Muller')));
  2819. R2.Move(0,1);
  2820. Insert(New(PStaticText, Init(R2, ^C'and')));
  2821. R2.Move(0,1);
  2822. Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
  2823. New(C, Init(50,10));
  2824. for I:=1 to 7 do
  2825. AddLine('');
  2826. AddLine(^C'< Original concept >');
  2827. AddLine(^C'Borland International, Inc.');
  2828. AddLine('');
  2829. AddLine(^C'< Compiler development >');
  2830. AddLine(^C'Carl-Eric Codere');
  2831. AddLine(^C'Daniel Mantione');
  2832. AddLine(^C'Florian Kl„mpfl');
  2833. AddLine(^C'Jonas Maebe');
  2834. AddLine(^C'Mich„el Van Canneyt');
  2835. AddLine(^C'Peter Vreman');
  2836. AddLine(^C'Pierre Muller');
  2837. AddLine('');
  2838. AddLine(^C'< IDE development >');
  2839. AddLine(^C'B‚rczi G bor');
  2840. AddLine(^C'Peter Vreman');
  2841. AddLine(^C'Pierre Muller');
  2842. AddLine('');
  2843. GetExtent(R);
  2844. R.Grow(-1,-1); Inc(R.A.Y,3);
  2845. New(Scroller, Init(R, 10, C));
  2846. Scroller^.Hide;
  2847. Insert(Scroller);
  2848. R.Move(0,-1); R.B.Y:=R.A.Y+1;
  2849. New(TitleST, Init(R, ^C'Team'));
  2850. TitleST^.Hide;
  2851. Insert(TitleST);
  2852. InsertOK(@Self);
  2853. end;
  2854. procedure TFPAboutDialog.ToggleInfo;
  2855. begin
  2856. if Scroller=nil then Exit;
  2857. if Scroller^.GetState(sfVisible) then
  2858. begin
  2859. Scroller^.Hide;
  2860. TitleST^.Hide;
  2861. end
  2862. else
  2863. begin
  2864. Scroller^.Reset;
  2865. Scroller^.Show;
  2866. TitleST^.Show;
  2867. end;
  2868. end;
  2869. procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
  2870. begin
  2871. case Event.What of
  2872. evKeyDown :
  2873. case Event.KeyCode of
  2874. kbAltI : { just like in BP }
  2875. begin
  2876. ToggleInfo;
  2877. ClearEvent(Event);
  2878. end;
  2879. end;
  2880. end;
  2881. inherited HandleEvent(Event);
  2882. end;
  2883. constructor TFPASCIIChart.Init;
  2884. begin
  2885. inherited Init;
  2886. HelpCtx:=hcASCIITableWindow;
  2887. Number:=SearchFreeWindowNo;
  2888. ASCIIChart:=@Self;
  2889. end;
  2890. procedure TFPASCIIChart.Store(var S: TStream);
  2891. begin
  2892. inherited Store(S);
  2893. end;
  2894. constructor TFPASCIIChart.Load(var S: TStream);
  2895. begin
  2896. inherited Load(S);
  2897. end;
  2898. procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
  2899. var W: PSourceWindow;
  2900. begin
  2901. case Event.What of
  2902. evKeyDown :
  2903. case Event.KeyCode of
  2904. kbEsc :
  2905. begin
  2906. Close;
  2907. ClearEvent(Event);
  2908. end;
  2909. end;
  2910. evCommand :
  2911. case Event.Command of
  2912. cmTransfer :
  2913. begin
  2914. W:=FirstEditorWindow;
  2915. if Assigned(W) and Assigned(Report) then
  2916. Message(W,evCommand,cmAddChar,pointer(ord(Report^.AsciiChar)));
  2917. ClearEvent(Event);
  2918. end;
  2919. end;
  2920. end;
  2921. inherited HandleEvent(Event);
  2922. end;
  2923. destructor TFPASCIIChart.Done;
  2924. begin
  2925. ASCIIChart:=nil;
  2926. inherited Done;
  2927. end;
  2928. function TVideoModeListBox.GetText(Item: pointer; MaxLen: sw_integer): string;
  2929. var P: PVideoModeList;
  2930. S: string;
  2931. begin
  2932. P:=Item;
  2933. S:=IntToStr(P^.Col)+'x'+IntToStr(P^.Row)+' ';
  2934. if P^.Color then
  2935. S:=S+'color'
  2936. else
  2937. S:=S+'mono';
  2938. GetText:=copy(S,1,MaxLen);
  2939. end;
  2940. constructor TFPDesktop.Init(var Bounds: TRect);
  2941. begin
  2942. inherited Init(Bounds);
  2943. end;
  2944. procedure TFPDesktop.InitBackground;
  2945. var AV: PANSIBackground;
  2946. FileName: string;
  2947. R: TRect;
  2948. begin
  2949. AV:=nil;
  2950. FileName:=LocateFile(BackgroundPath);
  2951. if FileName<>'' then
  2952. begin
  2953. GetExtent(R);
  2954. New(AV, Init(R));
  2955. AV^.GrowMode:=gfGrowHiX+gfGrowHiY;
  2956. if AV^.LoadFile(FileName)=false then
  2957. begin
  2958. Dispose(AV, Done); AV:=nil;
  2959. end;
  2960. if Assigned(AV) then
  2961. Insert(AV);
  2962. end;
  2963. Background:=AV;
  2964. if Assigned(Background)=false then
  2965. inherited InitBackground;
  2966. end;
  2967. constructor TFPDesktop.Load(var S: TStream);
  2968. begin
  2969. inherited Load(S);
  2970. end;
  2971. procedure TFPDesktop.Store(var S: TStream);
  2972. begin
  2973. inherited Store(S);
  2974. end;
  2975. constructor TFPToolTip.Init(var Bounds: TRect; const AText: string; AAlign: TAlign);
  2976. begin
  2977. inherited Init(Bounds);
  2978. SetAlign(AAlign);
  2979. SetText(AText);
  2980. end;
  2981. procedure TFPToolTip.Draw;
  2982. var C: word;
  2983. procedure DrawLine(Y: integer; S: string);
  2984. var B: TDrawBuffer;
  2985. begin
  2986. S:=copy(S,1,Size.X-2);
  2987. case Align of
  2988. alLeft : S:=' '+S;
  2989. alRight : S:=LExpand(' '+S,Size.X);
  2990. alCenter : S:=Center(S,Size.X);
  2991. end;
  2992. MoveChar(B,' ',C,Size.X);
  2993. MoveStr(B,S,C);
  2994. WriteLine(0,Y,Size.X,1,B);
  2995. end;
  2996. var S: string;
  2997. Y: integer;
  2998. begin
  2999. C:=GetColor(1);
  3000. S:=GetText;
  3001. for Y:=0 to Size.Y-1 do
  3002. DrawLine(Y,S);
  3003. end;
  3004. function TFPToolTip.GetText: string;
  3005. begin
  3006. GetText:=GetStr(Text);
  3007. end;
  3008. procedure TFPToolTip.SetText(const AText: string);
  3009. begin
  3010. if AText<>GetText then
  3011. begin
  3012. if Assigned(Text) then DisposeStr(Text);
  3013. Text:=NewStr(AText);
  3014. DrawView;
  3015. end;
  3016. end;
  3017. function TFPToolTip.GetAlign: TAlign;
  3018. begin
  3019. GetAlign:=Align;
  3020. end;
  3021. procedure TFPToolTip.SetAlign(AAlign: TAlign);
  3022. begin
  3023. if AAlign<>Align then
  3024. begin
  3025. Align:=AAlign;
  3026. DrawView;
  3027. end;
  3028. end;
  3029. destructor TFPToolTip.Done;
  3030. begin
  3031. if Assigned(Text) then DisposeStr(Text); Text:=nil;
  3032. inherited Done;
  3033. end;
  3034. function TFPToolTip.GetPalette: PPalette;
  3035. const S: string[length(CFPToolTip)] = CFPToolTip;
  3036. begin
  3037. GetPalette:=@S;
  3038. end;
  3039. constructor TFPMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  3040. PScrollBar; AIndicator: PIndicator);
  3041. begin
  3042. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,nil);
  3043. SetFlags(Flags and not (efPersistentBlocks) or efSyntaxHighlight);
  3044. end;
  3045. function TFPMemo.GetPalette: PPalette;
  3046. const P: string[length(CFPMemo)] = CFPMemo;
  3047. begin
  3048. GetPalette:=@P;
  3049. end;
  3050. function TFPMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  3051. begin
  3052. GetSpecSymbolCount:=0;
  3053. end;
  3054. function TFPMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  3055. begin
  3056. Abstract;
  3057. GetSpecSymbol:='';
  3058. end;
  3059. function TFPMemo.IsReservedWord(const S: string): boolean;
  3060. begin
  3061. IsReservedWord:=false;
  3062. end;
  3063. constructor TFPCodeMemo.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  3064. PScrollBar; AIndicator: PIndicator);
  3065. begin
  3066. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator);
  3067. end;
  3068. function TFPCodeMemo.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  3069. var Count: integer;
  3070. begin
  3071. case SpecClass of
  3072. ssCommentPrefix : Count:=3;
  3073. ssCommentSingleLinePrefix : Count:=1;
  3074. ssCommentSuffix : Count:=2;
  3075. ssStringPrefix : Count:=1;
  3076. ssStringSuffix : Count:=1;
  3077. ssAsmPrefix : Count:=1;
  3078. ssAsmSuffix : Count:=1;
  3079. ssDirectivePrefix : Count:=1;
  3080. ssDirectiveSuffix : Count:=1;
  3081. end;
  3082. GetSpecSymbolCount:=Count;
  3083. end;
  3084. function TFPCodeMemo.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  3085. var S: string[20];
  3086. begin
  3087. case SpecClass of
  3088. ssCommentPrefix :
  3089. case Index of
  3090. 0 : S:='{';
  3091. 1 : S:='(*';
  3092. 2 : S:='//';
  3093. end;
  3094. ssCommentSingleLinePrefix :
  3095. case Index of
  3096. 0 : S:='//';
  3097. end;
  3098. ssCommentSuffix :
  3099. case Index of
  3100. 0 : S:='}';
  3101. 1 : S:='*)';
  3102. end;
  3103. ssStringPrefix :
  3104. S:='''';
  3105. ssStringSuffix :
  3106. S:='''';
  3107. ssAsmPrefix :
  3108. S:='asm';
  3109. ssAsmSuffix :
  3110. S:='end';
  3111. ssDirectivePrefix :
  3112. S:='{$';
  3113. ssDirectiveSuffix :
  3114. S:='}';
  3115. end;
  3116. GetSpecSymbol:=S;
  3117. end;
  3118. function TFPCodeMemo.IsReservedWord(const S: string): boolean;
  3119. begin
  3120. IsReservedWord:=IsFPReservedWord(S);
  3121. end;
  3122. {$ifdef VESA}
  3123. function VESASetVideoModeProc(const VideoMode: TVideoMode; Params: Longint): Boolean; {$ifndef FPC}far;{$endif}
  3124. begin
  3125. VESASetVideoModeProc:=VESASetMode(Params);
  3126. end;
  3127. procedure InitVESAScreenModes;
  3128. var ML: TVESAModeList;
  3129. MI: TVESAModeInfoBlock;
  3130. I: integer;
  3131. begin
  3132. if VESAInit=false then Exit;
  3133. if VESAGetModeList(ML)=false then Exit;
  3134. for I:=1 to ML.Count do
  3135. begin
  3136. if VESAGetModeInfo(ML.Modes[I],MI) then
  3137. with MI do
  3138. if (Attributes and vesa_vma_GraphicsMode)=0 then
  3139. RegisterVideoMode(XResolution,YResolution,
  3140. (Attributes and vesa_vma_ColorMode)<>0,{$ifdef FPC}@{$endif}VESASetVideoModeProc,ML.Modes[I]);
  3141. end;
  3142. end;
  3143. {$endif}
  3144. procedure NoDebugger;
  3145. begin
  3146. InformationBox(msg_nodebuggersupportavailable,nil);
  3147. end;
  3148. procedure RegisterFPViews;
  3149. begin
  3150. RegisterType(RSourceEditor);
  3151. RegisterType(RSourceWindow);
  3152. RegisterType(RFPHelpViewer);
  3153. RegisterType(RFPHelpWindow);
  3154. RegisterType(RClipboardWindow);
  3155. RegisterType(RMessageListBox);
  3156. RegisterType(RFPDesktop);
  3157. RegisterType(RGDBSourceEditor);
  3158. RegisterType(RGDBWindow);
  3159. RegisterType(RFPASCIIChart);
  3160. RegisterType(RProgramInfoWindow);
  3161. end;
  3162. END.
  3163. {
  3164. $Log$
  3165. Revision 1.72 2000-06-16 08:50:42 pierre
  3166. + new bunch of Gabor's changes
  3167. Revision 1.71 2000/05/29 10:44:57 pierre
  3168. + New bunch of Gabor's changes: see fixes.txt
  3169. Revision 1.70 2000/05/16 21:50:53 pierre
  3170. * avoid to typecast the status line to a TWindow
  3171. Revision 1.69 2000/05/02 08:42:29 pierre
  3172. * new set of Gabor changes: see fixes.txt
  3173. Revision 1.68 2000/04/25 08:42:34 pierre
  3174. * New Gabor changes : see fixes.txt
  3175. Revision 1.67 2000/04/18 11:42:37 pierre
  3176. lot of Gabor changes : see fixes.txt
  3177. Revision 1.66 2000/03/23 22:22:25 pierre
  3178. * file loading problem fixed
  3179. Revision 1.65 2000/03/21 23:25:16 pierre
  3180. adapted to wcedit addition
  3181. Revision 1.64 2000/03/14 13:59:41 pierre
  3182. + add a warning if Changed on loading
  3183. Revision 1.63 2000/03/13 20:39:25 pierre
  3184. * one more try to get the menu update to work correctly
  3185. * breakpoint in red at loading
  3186. Revision 1.62 2000/03/07 21:50:38 pierre
  3187. * UpdateCommands changed again, still not correct :(
  3188. Revision 1.61 2000/03/01 22:32:48 pierre
  3189. * hopfully the bug on wrong Menu config fixed
  3190. Revision 1.60 2000/02/07 23:40:38 pierre
  3191. * avoid closing the StackWindow too early
  3192. Revision 1.59 2000/02/07 10:36:43 michael
  3193. + Something went wrong when unzipping
  3194. Revision 1.58 2000/02/06 23:42:47 pierre
  3195. + Use ErrorLine on GotoSource
  3196. Revision 1.57 2000/02/04 00:03:30 pierre
  3197. + SelectInDebugSession lets CPU and watches in front
  3198. Revision 1.56 2000/02/02 22:51:49 pierre
  3199. * use desktop^.current for GetNextEditorBounds
  3200. Revision 1.55 2000/02/01 10:58:41 pierre
  3201. * avoid Search sometimes disabled for Editor Windows
  3202. Revision 1.54 2000/01/10 14:59:50 pierre
  3203. * TProgramInfo was not registered
  3204. Revision 1.53 2000/01/07 14:02:52 pierre
  3205. + date string added
  3206. Revision 1.52 2000/01/03 11:38:34 michael
  3207. Changes from Gabor
  3208. Revision 1.51 1999/12/20 14:23:17 pierre
  3209. * MyApp renamed IDEApp
  3210. * TDebugController.ResetDebuggerRows added to
  3211. get resetting of debugger rows
  3212. Revision 1.50 1999/12/16 16:55:52 pierre
  3213. * fix of web bug 756
  3214. Revision 1.49 1999/11/25 00:25:43 pierre
  3215. * add Status when loading/saving files
  3216. Revision 1.48 1999/11/22 16:02:12 pierre
  3217. * TryToOpenFile failed tofind a sourcewindow if it has no number
  3218. Revision 1.47 1999/11/18 13:39:24 pierre
  3219. * Better info for Undo debugging
  3220. Revision 1.46 1999/11/10 00:44:12 pierre
  3221. * Grouped Undo action signaled in 'Dump Undo'
  3222. Revision 1.45 1999/10/29 14:50:07 pierre
  3223. * About dialog changes
  3224. Revision 1.44 1999/10/27 12:10:42 pierre
  3225. + With DebugUndo added 3 menu items
  3226. "Dump Undo" "Undo All" and "Redo All"
  3227. for Undo checks
  3228. Revision 1.43 1999/10/25 16:55:13 pierre
  3229. * adapted to a small weditor change
  3230. Revision 1.42 1999/09/16 14:34:59 pierre
  3231. + TBreakpoint and TWatch registering
  3232. + WatchesCollection and BreakpointsCollection stored in desk file
  3233. * Syntax highlighting was broken
  3234. Revision 1.41 1999/09/13 16:24:43 peter
  3235. + clock
  3236. * backspace unident like tp7
  3237. Revision 1.40 1999/09/09 16:30:37 pierre
  3238. * ModuleNames was not created in TMessageListBox.Load
  3239. Revision 1.39 1999/09/03 12:54:07 pierre
  3240. * adapted to modified tokens unit
  3241. * TryToOpen works better
  3242. Revision 1.38 1999/08/31 16:18:33 pierre
  3243. + TGDBWindow.Load and Store + Registration
  3244. Revision 1.37 1999/08/16 18:25:26 peter
  3245. * Adjusting the selection when the editor didn't contain any line.
  3246. * Reserved word recognition redesigned, but this didn't affect the overall
  3247. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  3248. The syntax scanner loop is a bit slow but the main problem is the
  3249. recognition of special symbols. Switching off symbol processing boosts
  3250. the performance up to ca. 200%...
  3251. * The editor didn't allow copying (for ex to clipboard) of a single character
  3252. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  3253. * Compiler Messages window (actually the whole desktop) did not act on any
  3254. keypress when compilation failed and thus the window remained visible
  3255. + Message windows are now closed upon pressing Esc
  3256. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  3257. only when neccessary
  3258. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  3259. + LineSelect (Ctrl+K+L) implemented
  3260. * The IDE had problems closing help windows before saving the desktop
  3261. Revision 1.36 1999/08/03 20:22:39 peter
  3262. + TTab acts now on Ctrl+Tab and Ctrl+Shift+Tab...
  3263. + Desktop saving should work now
  3264. - History saved
  3265. - Clipboard content saved
  3266. - Desktop saved
  3267. - Symbol info saved
  3268. * syntax-highlight bug fixed, which compared special keywords case sensitive
  3269. (for ex. 'asm' caused asm-highlighting, while 'ASM' didn't)
  3270. * with 'whole words only' set, the editor didn't found occourences of the
  3271. searched text, if the text appeared previously in the same line, but didn't
  3272. satisfied the 'whole-word' condition
  3273. * ^QB jumped to (SelStart.X,SelEnd.X) instead of (SelStart.X,SelStart.Y)
  3274. (ie. the beginning of the selection)
  3275. * when started typing in a new line, but not at the start (X=0) of it,
  3276. the editor inserted the text one character more to left as it should...
  3277. * TCodeEditor.HideSelection (Ctrl-K+H) didn't update the screen
  3278. * Shift shouldn't cause so much trouble in TCodeEditor now...
  3279. * Syntax highlight had problems recognizing a special symbol if it was
  3280. prefixed by another symbol character in the source text
  3281. * Auto-save also occours at Dos shell, Tool execution, etc. now...
  3282. Revision 1.35 1999/07/12 13:14:22 pierre
  3283. * LineEnd bug corrected, now goes end of text even if selected
  3284. + Until Return for debugger
  3285. + Code for Quit inside GDB Window
  3286. Revision 1.34 1999/06/30 23:58:20 pierre
  3287. + BreakpointsList Window implemented
  3288. with Edit/New/Delete functions
  3289. + Individual breakpoint dialog with support for all types
  3290. ignorecount and conditions
  3291. (commands are not yet implemented, don't know if this wolud be useful)
  3292. awatch and rwatch have problems because GDB does not annotate them
  3293. I fixed v4.16 for this
  3294. Revision 1.33 1999/06/28 19:32:28 peter
  3295. * fixes from gabor
  3296. Revision 1.32 1999/06/21 23:37:08 pierre
  3297. * VESASetVideoModeProc return value was not set
  3298. Revision 1.31 1999/06/02 11:19:13 pierre
  3299. * @ is now required for FPC for procedure address passing in functions
  3300. Revision 1.30 1999/05/22 13:44:33 peter
  3301. * fixed couple of bugs
  3302. Revision 1.29 1999/04/15 08:58:08 peter
  3303. * syntax highlight fixes
  3304. * browser updates
  3305. Revision 1.28 1999/04/07 21:55:56 peter
  3306. + object support for browser
  3307. * html help fixes
  3308. * more desktop saving things
  3309. * NODEBUG directive to exclude debugger
  3310. Revision 1.27 1999/04/01 10:27:06 pierre
  3311. + file(line) in start of message added
  3312. Revision 1.26 1999/03/23 16:16:41 peter
  3313. * linux fixes
  3314. Revision 1.25 1999/03/23 15:11:37 peter
  3315. * desktop saving things
  3316. * vesa mode
  3317. * preferences dialog
  3318. Revision 1.24 1999/03/21 22:51:37 florian
  3319. + functional screen mode switching added
  3320. Revision 1.23 1999/03/19 16:04:33 peter
  3321. * new compiler dialog
  3322. Revision 1.22 1999/03/16 00:44:45 peter
  3323. * forgotten in last commit :(
  3324. Revision 1.21 1999/03/08 14:58:16 peter
  3325. + prompt with dialogs for tools
  3326. Revision 1.20 1999/03/01 15:42:08 peter
  3327. + Added dummy entries for functions not yet implemented
  3328. * MenuBar didn't update itself automatically on command-set changes
  3329. * Fixed Debugging/Profiling options dialog
  3330. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  3331. * efBackSpaceUnindents works correctly
  3332. + 'Messages' window implemented
  3333. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  3334. + Added TP message-filter support (for ex. you can call GREP thru
  3335. GREP2MSG and view the result in the messages window - just like in TP)
  3336. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  3337. so topic search didn't work...
  3338. * In FPHELP.PAS there were still context-variables defined as word instead
  3339. of THelpCtx
  3340. * StdStatusKeys() was missing from the statusdef for help windows
  3341. + Topic-title for index-table can be specified when adding a HTML-files
  3342. Revision 1.19 1999/02/22 11:51:39 peter
  3343. * browser updates from gabor
  3344. Revision 1.18 1999/02/22 11:29:38 pierre
  3345. + added col info in MessageItem
  3346. + grep uses HighLightExts and should work for linux
  3347. Revision 1.17 1999/02/22 02:15:22 peter
  3348. + default extension for save in the editor
  3349. + Separate Text to Find for the grep dialog
  3350. * fixed redir crash with tp7
  3351. Revision 1.16 1999/02/19 18:43:49 peter
  3352. + open dialog supports mask list
  3353. Revision 1.15 1999/02/17 15:04:02 pierre
  3354. + file(line) added in TProgramInfo message list
  3355. Revision 1.14 1999/02/16 12:45:18 pierre
  3356. * GDBWindow size and grow corrected
  3357. Revision 1.13 1999/02/15 09:36:06 pierre
  3358. * // comment ends at end of line !
  3359. GDB window changed !
  3360. now all is in a normal text editor, but pressing
  3361. Enter key will send part of line before cursor to GDB !
  3362. Revision 1.12 1999/02/11 19:07:25 pierre
  3363. * GDBWindow redesigned :
  3364. normal editor apart from
  3365. that any kbEnter will send the line (for begin to cursor)
  3366. to GDB command !
  3367. GDBWindow opened in Debugger Menu
  3368. still buggy :
  3369. -echo should not be present if at end of text
  3370. -GDBWindow becomes First after each step (I don't know why !)
  3371. Revision 1.11 1999/02/11 13:08:39 pierre
  3372. + TGDBWindow : direct gdb input/output
  3373. Revision 1.10 1999/02/10 09:42:52 pierre
  3374. + DoneReservedWords to avoid memory leaks
  3375. * TMessageItem Module field was not disposed
  3376. Revision 1.9 1999/02/05 12:12:02 pierre
  3377. + SourceDir that stores directories for sources that the
  3378. compiler should not know about
  3379. Automatically asked for addition when a new file that
  3380. needed filedialog to be found is in an unknown directory
  3381. Stored and retrieved from INIFile
  3382. + Breakpoints conditions added to INIFile
  3383. * Breakpoints insterted and removed at debin and end of debug session
  3384. Revision 1.8 1999/02/04 17:45:23 pierre
  3385. + BrowserAtCursor started
  3386. * bug in TryToOpenFile removed
  3387. Revision 1.7 1999/02/04 13:32:11 pierre
  3388. * Several things added (I cannot commit them independently !)
  3389. + added TBreakpoint and TBreakpointCollection
  3390. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  3391. + Breakpoint list in INIFile
  3392. * Select items now also depend of SwitchMode
  3393. * Reading of option '-g' was not possible !
  3394. + added search for -Fu args pathes in TryToOpen
  3395. + added code for automatic opening of FileDialog
  3396. if source not found
  3397. Revision 1.6 1999/01/21 11:54:27 peter
  3398. + tools menu
  3399. + speedsearch in symbolbrowser
  3400. * working run command
  3401. Revision 1.5 1999/01/14 21:42:25 peter
  3402. * source tracking from Gabor
  3403. Revision 1.4 1999/01/12 14:29:42 peter
  3404. + Implemented still missing 'switch' entries in Options menu
  3405. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  3406. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  3407. ASCII chars and inserted directly in the text.
  3408. + Added symbol browser
  3409. * splitted fp.pas to fpide.pas
  3410. Revision 1.3 1999/01/04 11:49:53 peter
  3411. * 'Use tab characters' now works correctly
  3412. + Syntax highlight now acts on File|Save As...
  3413. + Added a new class to syntax highlight: 'hex numbers'.
  3414. * There was something very wrong with the palette managment. Now fixed.
  3415. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  3416. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  3417. process revised
  3418. Revision 1.2 1998/12/28 15:47:54 peter
  3419. + Added user screen support, display & window
  3420. + Implemented Editor,Mouse Options dialog
  3421. + Added location of .INI and .CFG file
  3422. + Option (INI) file managment implemented (see bottom of Options Menu)
  3423. + Switches updated
  3424. + Run program
  3425. Revision 1.4 1998/12/22 10:39:53 peter
  3426. + options are now written/read
  3427. + find and replace routines
  3428. }