fpviews.pas 88 KB

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