fpviews.pas 88 KB

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