fpviews.pas 106 KB

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