fpviews.pas 101 KB

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