fpviews.pas 104 KB

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