fpviews.pas 67 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551
  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. interface
  14. uses
  15. Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,Gadgets,
  16. ASCIITAB,
  17. {$ifdef EDITORS}
  18. Editors,
  19. {$else}
  20. WEditor,
  21. {$endif}
  22. WUtils,WHelp,WHlpView,WViews,
  23. Comphook,
  24. FPConst,FPUsrScr;
  25. type
  26. {$IFNDEF EDITORS}
  27. TEditor = TCodeEditor; PEditor = PCodeEditor;
  28. {$ENDIF}
  29. PStoreCollection = ^TStoreCollection;
  30. TStoreCollection = object(TStringCollection)
  31. function Add(const S: string): PString;
  32. end;
  33. PIntegerLine = ^TIntegerLine;
  34. TIntegerLine = object(TInputLine)
  35. constructor Init(var Bounds: TRect; AMin, AMax: longint);
  36. end;
  37. PFPHeapView = ^TFPHeapView;
  38. TFPHeapView = object(THeapView)
  39. constructor Init(var Bounds: TRect);
  40. constructor InitKb(var Bounds: TRect);
  41. procedure HandleEvent(var Event: TEvent); virtual;
  42. end;
  43. TFPWindow = object(TWindow)
  44. procedure HandleEvent(var Event: TEvent); virtual;
  45. end;
  46. PFPHelpViewer = ^TFPHelpViewer;
  47. TFPHelpViewer = object(THelpViewer)
  48. function GetLocalMenu: PMenu; virtual;
  49. function GetCommandTarget: PView; virtual;
  50. end;
  51. PFPHelpWindow = ^TFPHelpWindow;
  52. TFPHelpWindow = object(THelpWindow)
  53. constructor Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word; AContext: THelpCtx; ANumber: Integer);
  54. procedure InitHelpView; virtual;
  55. procedure Show; virtual;
  56. procedure Hide; virtual;
  57. procedure HandleEvent(var Event: TEvent); virtual;
  58. function GetPalette: PPalette; virtual;
  59. end;
  60. PTextScroller = ^TTextScroller;
  61. TTextScroller = object(TStaticText)
  62. TopLine: integer;
  63. Speed : integer;
  64. Lines : PUnsortedStringCollection;
  65. constructor Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  66. function GetLineCount: integer; virtual;
  67. function GetLine(I: integer): string; virtual;
  68. procedure HandleEvent(var Event: TEvent); virtual;
  69. procedure Update; virtual;
  70. procedure Reset; virtual;
  71. procedure Scroll; virtual;
  72. procedure Draw; virtual;
  73. destructor Done; virtual;
  74. private
  75. LastTT: longint;
  76. end;
  77. PSourceEditor = ^TSourceEditor;
  78. TSourceEditor = object(TFileEditor)
  79. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  80. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  81. {$ifndef EDITORS}
  82. function IsReservedWord(const S: string): boolean; virtual;
  83. function GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer; virtual;
  84. function GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string; virtual;
  85. {$endif}
  86. procedure HandleEvent(var Event: TEvent); virtual;
  87. function GetLocalMenu: PMenu; virtual;
  88. function GetCommandTarget: PView; virtual;
  89. function CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup; virtual;
  90. end;
  91. PSourceWindow = ^TSourceWindow;
  92. TSourceWindow = object(TFPWindow)
  93. Editor : PSourceEditor;
  94. Indicator : PIndicator;
  95. constructor Init(var Bounds: TRect; AFileName: string);
  96. procedure SetTitle(ATitle: string); virtual;
  97. procedure UpdateTitle; virtual;
  98. procedure HandleEvent(var Event: TEvent); virtual;
  99. procedure SetState(AState: Word; Enable: Boolean); virtual;
  100. procedure Update; virtual;
  101. procedure UpdateCommands; virtual;
  102. function GetPalette: PPalette; virtual;
  103. destructor Done; virtual;
  104. end;
  105. PGDBSourceEditor = ^TGDBSourceEditor;
  106. TGDBSourceEditor = object(TSourceEditor)
  107. function InsertLine : Sw_integer;virtual;
  108. function Valid(Command: Word): Boolean; virtual;
  109. procedure AddLine(const S: string); virtual;
  110. procedure AddErrorLine(const S: string); virtual;
  111. private
  112. Silent,
  113. AutoRepeat,
  114. IgnoreStringAtEnd : boolean;
  115. LastCommand : String;
  116. end;
  117. PGDBWindow = ^TGDBWindow;
  118. TGDBWindow = object(TFPWindow)
  119. Editor : PGDBSourceEditor;
  120. Indicator : PIndicator;
  121. constructor Init(var Bounds: TRect);
  122. procedure WriteText(Buf : pchar;IsError : boolean);
  123. procedure WriteString(Const S : string);
  124. procedure WriteErrorString(Const S : string);
  125. procedure WriteOutputText(Buf : pchar);
  126. procedure WriteErrorText(Buf : pchar);
  127. function GetPalette: PPalette;virtual;
  128. destructor Done; virtual;
  129. end;
  130. PClipboardWindow = ^TClipboardWindow;
  131. TClipboardWindow = object(TSourceWindow)
  132. constructor Init;
  133. procedure Show; virtual;
  134. procedure Hide; virtual;
  135. procedure Close; virtual;
  136. destructor Done; virtual;
  137. end;
  138. PMessageItem = ^TMessageItem;
  139. TMessageItem = object(TObject)
  140. TClass : longint;
  141. Text : PString;
  142. Module : PString;
  143. Row,Col : sw_integer;
  144. constructor Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
  145. function GetText(MaxLen: integer): string; virtual;
  146. procedure Selected; virtual;
  147. function GetModuleName: string; virtual;
  148. destructor Done; virtual;
  149. end;
  150. PMessageListBox = ^TMessageListBox;
  151. TMessageListBox = object(THSListBox)
  152. Transparent: boolean;
  153. NoSelection: boolean;
  154. MaxWidth: integer;
  155. ModuleNames: PStoreCollection;
  156. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  157. procedure AddItem(P: PMessageItem); virtual;
  158. function AddModuleName(Name: string): PString; virtual;
  159. function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  160. procedure Clear; virtual;
  161. procedure TrackSource; virtual;
  162. procedure GotoSource; virtual;
  163. procedure Draw; virtual;
  164. procedure HandleEvent(var Event: TEvent); virtual;
  165. function GetLocalMenu: PMenu; virtual;
  166. destructor Done; virtual;
  167. end;
  168. PCompilerMessage = ^TCompilerMessage;
  169. TCompilerMessage = object(TMessageItem)
  170. function GetText(MaxLen: Integer): String; virtual;
  171. end;
  172. PProgramInfoWindow = ^TProgramInfoWindow;
  173. TProgramInfoWindow = object(TDlgWindow)
  174. InfoST: PColorStaticText;
  175. LogLB : PMessageListBox;
  176. constructor Init;
  177. procedure AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  178. procedure ClearMessages;
  179. procedure SizeLimits(var Min, Max: TPoint); virtual;
  180. procedure Close; virtual;
  181. procedure HandleEvent(var Event: TEvent); virtual;
  182. procedure Update; virtual;
  183. destructor Done; virtual;
  184. end;
  185. PTabItem = ^TTabItem;
  186. TTabItem = record
  187. Next : PTabItem;
  188. View : PView;
  189. Dis : boolean;
  190. end;
  191. PTabDef = ^TTabDef;
  192. TTabDef = record
  193. Next : PTabDef;
  194. Name : PString;
  195. Items : PTabItem;
  196. DefItem : PView;
  197. ShortCut : char;
  198. end;
  199. PTab = ^TTab;
  200. TTab = object(TGroup)
  201. TabDefs : PTabDef;
  202. ActiveDef : integer;
  203. DefCount : word;
  204. constructor Init(var Bounds: TRect; ATabDef: PTabDef);
  205. function AtTab(Index: integer): PTabDef; virtual;
  206. procedure SelectTab(Index: integer); virtual;
  207. function TabCount: integer;
  208. function Valid(Command: Word): Boolean; virtual;
  209. procedure ChangeBounds(var Bounds: TRect); virtual;
  210. procedure HandleEvent(var Event: TEvent); virtual;
  211. function GetPalette: PPalette; virtual;
  212. procedure Draw; virtual;
  213. procedure SetState(AState: Word; Enable: Boolean); virtual;
  214. destructor Done; virtual;
  215. private
  216. InDraw: boolean;
  217. end;
  218. PScreenView = ^TScreenView;
  219. TScreenView = object(TScroller)
  220. Screen: PScreen;
  221. constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  222. AScreen: PScreen);
  223. procedure Draw; virtual;
  224. procedure Update; virtual;
  225. procedure HandleEvent(var Event: TEvent); virtual;
  226. end;
  227. PScreenWindow = ^TScreenWindow;
  228. TScreenWindow = object(TFPWindow)
  229. ScreenView : PScreenView;
  230. constructor Init(AScreen: PScreen; ANumber: integer);
  231. destructor Done; virtual;
  232. end;
  233. PFPAboutDialog = ^TFPAboutDialog;
  234. TFPAboutDialog = object(TCenterDialog)
  235. constructor Init;
  236. procedure ToggleInfo;
  237. procedure HandleEvent(var Event: TEvent); virtual;
  238. private
  239. Scroller: PTextScroller;
  240. TitleST : PStaticText;
  241. end;
  242. PFPASCIIChart = ^TFPASCIIChart;
  243. TFPASCIIChart = object(TASCIIChart)
  244. constructor Init;
  245. procedure HandleEvent(var Event: TEvent); virtual;
  246. destructor Done; virtual;
  247. end;
  248. function SearchFreeWindowNo: integer;
  249. function IsThereAnyEditor: boolean;
  250. function IsThereAnyWindow: boolean;
  251. function FirstEditorWindow: PSourceWindow;
  252. function EditorWindowFile(const Name : String): PSourceWindow;
  253. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  254. procedure DisposeTabItem(P: PTabItem);
  255. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  256. procedure DisposeTabDef(P: PTabDef);
  257. function GetEditorCurWord(Editor: PEditor): string;
  258. procedure InitReservedWords;
  259. procedure DoneReservedWords;
  260. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  261. function GetNextEditorBounds(var Bounds: TRect): boolean;
  262. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  263. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  264. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  265. const
  266. SourceCmds : TCommandSet =
  267. ([cmSave,cmSaveAs,cmCompile]);
  268. EditorCmds : TCommandSet =
  269. ([cmFind,cmReplace,cmSearchAgain,cmJumpLine,cmHelpTopicSearch]);
  270. CompileCmds : TCommandSet =
  271. ([cmMake,cmBuild,cmRun]);
  272. CalcClipboard : extended = 0;
  273. OpenFileName : string = '';
  274. OpenFileLastExt : string[12] = '*.pas';
  275. NewEditorOpened : boolean = false;
  276. var MsgParms : array[1..10] of
  277. record
  278. case byte of
  279. 0 : (Ptr : pointer);
  280. 1 : (Long: longint);
  281. end;
  282. implementation
  283. uses
  284. Strings,Keyboard,Memory,MsgBox,Validate,
  285. Tokens,Version,
  286. FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
  287. const
  288. NoNameCount : integer = 0;
  289. ReservedWords : PUnsortedStringCollection = nil;
  290. {****************************************************************************
  291. TStoreCollection
  292. ****************************************************************************}
  293. function TStoreCollection.Add(const S: string): PString;
  294. var P: PString;
  295. Index: Sw_integer;
  296. begin
  297. if S='' then P:=nil else
  298. if Search(@S,Index) then P:=At(Index) else
  299. begin
  300. P:=NewStr(S);
  301. Insert(P);
  302. end;
  303. Add:=P;
  304. end;
  305. function IsThereAnyEditor: boolean;
  306. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  307. begin
  308. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  309. end;
  310. begin
  311. IsThereAnyEditor:=Desktop^.FirstThat(@EditorWindow)<>nil;
  312. end;
  313. function IsThereAnyHelpWindow: boolean;
  314. begin
  315. IsThereAnyHelpWindow:=(HelpWindow<>nil) and (HelpWindow^.GetState(sfVisible));
  316. end;
  317. function IsThereAnyWindow: boolean;
  318. var _Is: boolean;
  319. begin
  320. _Is:=Message(Desktop,evBroadcast,cmSearchWindow,nil)<>nil;
  321. _Is:=_Is or ( (ClipboardWindow<>nil) and ClipboardWindow^.GetState(sfVisible));
  322. IsThereAnyWindow:=_Is;
  323. end;
  324. function FirstEditorWindow: PSourceWindow;
  325. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  326. begin
  327. EditorWindow:=(P^.HelpCtx=hcSourceWindow);
  328. end;
  329. begin
  330. FirstEditorWindow:=pointer(Desktop^.FirstThat(@EditorWindow));
  331. end;
  332. function EditorWindowFile(const Name : String): PSourceWindow;
  333. function EditorWindow(P: PView): boolean; {$ifndef FPC}far;{$endif}
  334. begin
  335. EditorWindow:=(TypeOf(P^)=TypeOf(TSourceWindow)) and
  336. {$ifdef linux}
  337. (PSourceWindow(P)^.Editor^.FileName=Name);
  338. {$else}
  339. (UpcaseStr(PSourceWindow(P)^.Editor^.FileName)=UpcaseStr(Name));
  340. {$endif def linux}
  341. end;
  342. begin
  343. EditorWindowFile:=pointer(Desktop^.FirstThat(@EditorWindow));
  344. end;
  345. function GetEditorCurWord(Editor: PEditor): string;
  346. var S: string;
  347. PS,PE: byte;
  348. function Trim(S: string): string;
  349. const TrimChars : set of char = [#0,#9,' ',#255];
  350. begin
  351. while (length(S)>0) and (S[1] in TrimChars) do Delete(S,1,1);
  352. while (length(S)>0) and (S[length(S)] in TrimChars) do Delete(S,length(S),1);
  353. Trim:=S;
  354. end;
  355. const AlphaNum : set of char = ['A'..'Z','0'..'9','_'];
  356. begin
  357. with Editor^ do
  358. begin
  359. {$ifdef EDITORS}
  360. S:='';
  361. {$else}
  362. S:=GetLineText(CurPos.Y);
  363. PS:=CurPos.X; while (PS>0) and (Upcase(S[PS]) in AlphaNum) do Dec(PS);
  364. PE:=CurPos.X; while (PE<length(S)) and (Upcase(S[PE+1]) in AlphaNum) do Inc(PE);
  365. S:=Trim(copy(S,PS+1,PE-PS));
  366. {$endif}
  367. end;
  368. GetEditorCurWord:=S;
  369. end;
  370. {*****************************************************************************
  371. Tab
  372. *****************************************************************************}
  373. function NewTabItem(AView: PView; ANext: PTabItem): PTabItem;
  374. var P: PTabItem;
  375. begin
  376. New(P); FillChar(P^,SizeOf(P^),0);
  377. P^.Next:=ANext; P^.View:=AView;
  378. NewTabItem:=P;
  379. end;
  380. procedure DisposeTabItem(P: PTabItem);
  381. begin
  382. if P<>nil then
  383. begin
  384. if P^.View<>nil then Dispose(P^.View, Done);
  385. Dispose(P);
  386. end;
  387. end;
  388. function NewTabDef(AName: string; ADefItem: PView; AItems: PTabItem; ANext: PTabDef): PTabDef;
  389. var P: PTabDef;
  390. x: byte;
  391. begin
  392. New(P);
  393. P^.Next:=ANext; P^.Name:=NewStr(AName); P^.Items:=AItems;
  394. x:=pos('~',AName);
  395. if (x<>0) and (x<length(AName)) then P^.ShortCut:=Upcase(AName[x+1])
  396. else P^.ShortCut:=#0;
  397. P^.DefItem:=ADefItem;
  398. NewTabDef:=P;
  399. end;
  400. procedure DisposeTabDef(P: PTabDef);
  401. var PI,X: PTabItem;
  402. begin
  403. DisposeStr(P^.Name);
  404. PI:=P^.Items;
  405. while PI<>nil do
  406. begin
  407. X:=PI^.Next;
  408. DisposeTabItem(PI);
  409. PI:=X;
  410. end;
  411. Dispose(P);
  412. end;
  413. {*****************************************************************************
  414. Reserved Words
  415. *****************************************************************************}
  416. function GetReservedWordCount: integer;
  417. var
  418. Count,I: integer;
  419. begin
  420. Count:=0;
  421. for I:=ord(Low(TokenInfo)) to ord(High(TokenInfo)) do
  422. with TokenInfo[TToken(I)] do
  423. if (str<>'') and (str[1] in['A'..'Z']) then
  424. Inc(Count);
  425. GetReservedWordCount:=Count;
  426. end;
  427. function GetReservedWord(Index: integer): string;
  428. var
  429. Count,Idx,I: integer;
  430. S: string;
  431. begin
  432. Idx:=-1;
  433. Count:=-1;
  434. I:=ord(Low(TokenInfo));
  435. while (I<=ord(High(TokenInfo))) and (Idx=-1) do
  436. with TokenInfo[TToken(I)] do
  437. begin
  438. if (str<>'') and (str[1] in['A'..'Z']) then
  439. begin
  440. Inc(Count);
  441. if Count=Index then
  442. Idx:=I;
  443. end;
  444. Inc(I);
  445. end;
  446. if Idx=-1 then
  447. S:=''
  448. else
  449. S:=TokenInfo[TToken(Idx)].str;
  450. GetReservedWord:=S;
  451. end;
  452. procedure InitReservedWords;
  453. var S,WordS: string;
  454. Idx,I: integer;
  455. begin
  456. New(ReservedWords, Init(50,10));
  457. for I:=1 to GetReservedWordCount do
  458. begin
  459. WordS:=GetReservedWord(I-1); Idx:=length(WordS);
  460. while ReservedWords^.Count<Idx do
  461. ReservedWords^.Insert(NewStr(#0));
  462. S:=ReservedWords^.At(Idx-1)^;
  463. ReservedWords^.AtFree(Idx-1);
  464. ReservedWords^.AtInsert(Idx-1,NewStr(S+WordS+#0));
  465. end;
  466. end;
  467. procedure DoneReservedWords;
  468. begin
  469. if assigned(ReservedWords) then
  470. dispose(ReservedWords,done);
  471. end;
  472. function IsFPReservedWord(S: string): boolean;
  473. var _Is: boolean;
  474. Idx: integer;
  475. P: PString;
  476. begin
  477. Idx:=length(S); _Is:=false;
  478. if (Idx>0) and (ReservedWords<>nil) and (ReservedWords^.Count>=Idx) then
  479. begin
  480. S:=UpcaseStr(S);
  481. P:=ReservedWords^.At(Idx-1);
  482. _Is:=Pos(#0+S+#0,P^)>0;
  483. end;
  484. IsFPReservedWord:=_Is;
  485. end;
  486. {*****************************************************************************
  487. SearchWindow
  488. *****************************************************************************}
  489. function SearchWindowWithNo(No: integer): PWindow;
  490. var P: PSourceWindow;
  491. begin
  492. P:=Message(Desktop,evBroadcast,cmSearchWindow+No,nil);
  493. if pointer(P)=pointer(Desktop) then P:=nil;
  494. SearchWindowWithNo:=P;
  495. end;
  496. function SearchFreeWindowNo: integer;
  497. var No: integer;
  498. begin
  499. No:=1;
  500. while (No<10) and (SearchWindowWithNo(No)<>nil) do
  501. Inc(No);
  502. if No=10 then No:=0;
  503. SearchFreeWindowNo:=No;
  504. end;
  505. {*****************************************************************************
  506. TIntegerLine
  507. *****************************************************************************}
  508. constructor TIntegerLine.Init(var Bounds: TRect; AMin, AMax: longint);
  509. begin
  510. inherited Init(Bounds, Bounds.B.X-Bounds.A.X-1);
  511. Validator:=New(PRangeValidator, Init(AMin, AMax));
  512. end;
  513. {*****************************************************************************
  514. SourceEditor
  515. *****************************************************************************}
  516. {$ifndef EDITORS}
  517. function TSourceEditor.GetSpecSymbolCount(SpecClass: TSpecSymbolClass): integer;
  518. var Count: integer;
  519. begin
  520. case SpecClass of
  521. ssCommentPrefix : Count:=3;
  522. ssCommentSingleLinePrefix : Count:=1;
  523. ssCommentSuffix : Count:=2;
  524. ssStringPrefix : Count:=1;
  525. ssStringSuffix : Count:=1;
  526. ssAsmPrefix : Count:=1;
  527. ssAsmSuffix : Count:=1;
  528. ssDirectivePrefix : Count:=1;
  529. ssDirectiveSuffix : Count:=1;
  530. end;
  531. GetSpecSymbolCount:=Count;
  532. end;
  533. function TSourceEditor.GetSpecSymbol(SpecClass: TSpecSymbolClass; Index: integer): string;
  534. var S: string[20];
  535. begin
  536. case SpecClass of
  537. ssCommentPrefix :
  538. case Index of
  539. 0 : S:='{';
  540. 1 : S:='(*';
  541. 2 : S:='//';
  542. end;
  543. ssCommentSingleLinePrefix :
  544. case Index of
  545. 0 : S:='//';
  546. end;
  547. ssCommentSuffix :
  548. case Index of
  549. 0 : S:='}';
  550. 1 : S:='*)';
  551. end;
  552. ssStringPrefix :
  553. S:='''';
  554. ssStringSuffix :
  555. S:='''';
  556. ssAsmPrefix :
  557. S:='asm';
  558. ssAsmSuffix :
  559. S:='end';
  560. ssDirectivePrefix :
  561. S:='{$';
  562. ssDirectiveSuffix :
  563. S:='}';
  564. end;
  565. GetSpecSymbol:=S;
  566. end;
  567. constructor TSourceEditor.Init(var Bounds: TRect; AHScrollBar, AVScrollBar:
  568. PScrollBar; AIndicator: PIndicator;const AFileName: string);
  569. begin
  570. inherited Init(Bounds,AHScrollBar,AVScrollBar,AIndicator,AFileName);
  571. StoreUndo:=true;
  572. end;
  573. function TSourceEditor.IsReservedWord(const S: string): boolean;
  574. begin
  575. IsReservedWord:=IsFPReservedWord(S);
  576. end;
  577. {$endif EDITORS}
  578. function TSourceEditor.GetLocalMenu: PMenu;
  579. var M: PMenu;
  580. begin
  581. M:=NewMenu(
  582. NewItem('Cu~t~','Shift+Del',kbShiftDel,cmCut,hcCut,
  583. NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
  584. NewItem('~P~aste','Shift+Ins',kbShiftIns,cmPaste,hcPaste,
  585. NewItem('C~l~ear','Ctrl+Del',kbCtrlDel,cmClear,hcClear,
  586. NewLine(
  587. NewItem('Open ~f~ile at cursor','',kbNoKey,cmOpenAtCursor,hcOpenAtCursor,
  588. NewItem('~B~rowse symbol at cursor','',kbNoKey,cmBrowseAtCursor,hcBrowseAtCursor,
  589. NewItem('Topic ~s~earch','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  590. NewLine(
  591. NewItem('~O~ptions...','',kbNoKey,cmEditorOptions,hcEditorOptions,
  592. nil)))))))))));
  593. GetLocalMenu:=M;
  594. end;
  595. function TSourceEditor.GetCommandTarget: PView;
  596. begin
  597. GetCommandTarget:=@Self;
  598. end;
  599. function TSourceEditor.CreateLocalMenuView(var Bounds: TRect; M: PMenu): PMenuPopup;
  600. var MV: PAdvancedMenuPopup;
  601. begin
  602. New(MV, Init(Bounds,M));
  603. CreateLocalMenuView:=MV;
  604. end;
  605. procedure TSourceEditor.HandleEvent(var Event: TEvent);
  606. var DontClear: boolean;
  607. S: string;
  608. begin
  609. TranslateMouseClick(@Self,Event);
  610. case Event.What of
  611. evCommand :
  612. begin
  613. DontClear:=false;
  614. case Event.Command of
  615. cmBrowseAtCursor:
  616. begin
  617. S:=LowerCaseStr(GetEditorCurWord(@Self));
  618. OpenOneSymbolBrowser(S);
  619. end;
  620. cmOpenAtCursor :
  621. begin
  622. S:=LowerCaseStr(GetEditorCurWord(@Self));
  623. OpenFileName:=S+'.pp'+ListSeparator+
  624. S+'.pas'+ListSeparator+
  625. S+'.inc';
  626. Message(Application,evCommand,cmOpen,nil);
  627. end;
  628. cmEditorOptions :
  629. Message(Application,evCommand,cmEditorOptions,@Self);
  630. cmHelp :
  631. Message(@Self,evCommand,cmHelpTopicSearch,@Self);
  632. cmHelpTopicSearch :
  633. HelpTopicSearch(@Self);
  634. else DontClear:=true;
  635. end;
  636. if not DontClear then ClearEvent(Event);
  637. end;
  638. end;
  639. inherited HandleEvent(Event);
  640. end;
  641. constructor TFPHeapView.Init(var Bounds: TRect);
  642. begin
  643. inherited Init(Bounds);
  644. EventMask:=EventMask or evIdle;
  645. end;
  646. constructor TFPHeapView.InitKb(var Bounds: TRect);
  647. begin
  648. inherited InitKb(Bounds);
  649. EventMask:=EventMask or evIdle;
  650. end;
  651. procedure TFPHeapView.HandleEvent(var Event: TEvent);
  652. begin
  653. case Event.What of
  654. evIdle :
  655. Update;
  656. end;
  657. inherited HandleEvent(Event);
  658. end;
  659. procedure TFPWindow.HandleEvent(var Event: TEvent);
  660. begin
  661. case Event.What of
  662. evBroadcast :
  663. case Event.Command of
  664. cmUpdate :
  665. ReDraw;
  666. cmSearchWindow+1..cmSearchWindow+99 :
  667. if (Event.Command-cmSearchWindow=Number) then
  668. ClearEvent(Event);
  669. end;
  670. end;
  671. inherited HandleEvent(Event);
  672. end;
  673. function TFPHelpViewer.GetLocalMenu: PMenu;
  674. var M: PMenu;
  675. begin
  676. M:=NewMenu(
  677. NewItem('C~o~ntents','',kbNoKey,cmHelpContents,hcHelpContents,
  678. NewItem('~I~ndex','Shift+F1',kbShiftF1,cmHelpIndex,hcHelpIndex,
  679. NewItem('~T~opic search','Ctrl+F1',kbCtrlF1,cmHelpTopicSearch,hcHelpTopicSearch,
  680. NewItem('~P~revious topic','Alt+F1',kbAltF1,cmHelpPrevTopic,hcHelpPrevTopic,
  681. NewLine(
  682. NewItem('~C~opy','Ctrl+Ins',kbCtrlIns,cmCopy,hcCopy,
  683. nil)))))));
  684. GetLocalMenu:=M;
  685. end;
  686. function TFPHelpViewer.GetCommandTarget: PView;
  687. begin
  688. GetCommandTarget:=Application;
  689. end;
  690. constructor TFPHelpWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ASourceFileID: word;
  691. AContext: THelpCtx; ANumber: Integer);
  692. begin
  693. inherited Init(Bounds,ATitle,ASourceFileID,AContext,ANumber);
  694. HelpCtx:=hcHelpWindow;
  695. HideOnClose:=true;
  696. end;
  697. procedure TFPHelpWindow.InitHelpView;
  698. var R: TRect;
  699. begin
  700. GetExtent(R); R.Grow(-1,-1);
  701. HelpView:=New(PFPHelpViewer, Init(R, HSB, VSB));
  702. HelpView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  703. end;
  704. procedure TFPHelpWindow.Show;
  705. begin
  706. inherited Show;
  707. if GetState(sfVisible) and (Number=0) then
  708. begin
  709. Number:=SearchFreeWindowNo;
  710. ReDraw;
  711. end;
  712. end;
  713. procedure TFPHelpWindow.Hide;
  714. begin
  715. inherited Hide;
  716. if GetState(sfVisible)=false then
  717. Number:=0;
  718. end;
  719. procedure TFPHelpWindow.HandleEvent(var Event: TEvent);
  720. begin
  721. case Event.What of
  722. evBroadcast :
  723. case Event.Command of
  724. cmUpdate :
  725. ReDraw;
  726. cmSearchWindow+1..cmSearchWindow+99 :
  727. if (Event.Command-cmSearchWindow=Number) then
  728. ClearEvent(Event);
  729. end;
  730. end;
  731. inherited HandleEvent(Event);
  732. end;
  733. function TFPHelpWindow.GetPalette: PPalette;
  734. const P: string[length(CIDEHelpDialog)] = CIDEHelpDialog;
  735. begin
  736. GetPalette:=@P;
  737. end;
  738. constructor TSourceWindow.Init(var Bounds: TRect; AFileName: string);
  739. var HSB,VSB: PScrollBar;
  740. R: TRect;
  741. LoadFile: boolean;
  742. begin
  743. inherited Init(Bounds,AFileName,SearchFreeWindowNo);
  744. Options:=Options or ofTileAble;
  745. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  746. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  747. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  748. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  749. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  750. New(Indicator, Init(R));
  751. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  752. Insert(Indicator);
  753. GetExtent(R); R.Grow(-1,-1);
  754. LoadFile:=AFileName<>'';
  755. if not LoadFile then
  756. begin SetTitle('noname'+IntToStrZ(NonameCount,2)+'.pas'); Inc(NonameCount); end;
  757. New(Editor, Init(R, HSB, VSB, Indicator,AFileName));
  758. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  759. if LoadFile then
  760. if Editor^.LoadFile=false then
  761. ErrorBox(#3'Error reading file.',nil);
  762. Insert(Editor);
  763. UpdateTitle;
  764. end;
  765. procedure TSourceWindow.UpdateTitle;
  766. var Name: string;
  767. begin
  768. if Editor^.FileName<>'' then
  769. begin Name:=SmartPath(Editor^.FileName); SetTitle(Name); end;
  770. end;
  771. procedure TSourceWindow.SetTitle(ATitle: string);
  772. begin
  773. if Title<>nil then DisposeStr(Title);
  774. Title:=NewStr(ATitle);
  775. Frame^.DrawView;
  776. end;
  777. procedure TSourceWindow.HandleEvent(var Event: TEvent);
  778. var DontClear: boolean;
  779. begin
  780. case Event.What of
  781. evBroadcast :
  782. case Event.Command of
  783. cmUpdate :
  784. Update;
  785. cmUpdateTitle :
  786. UpdateTitle;
  787. cmSearchWindow :
  788. if @Self<>ClipboardWindow then
  789. ClearEvent(Event);
  790. end;
  791. evCommand :
  792. begin
  793. DontClear:=false;
  794. case Event.Command of
  795. cmSave :
  796. if Editor^.IsClipboard=false then
  797. Editor^.Save;
  798. cmSaveAs :
  799. if Editor^.IsClipboard=false then
  800. Editor^.SaveAs;
  801. else DontClear:=true;
  802. end;
  803. if DontClear=false then ClearEvent(Event);
  804. end;
  805. end;
  806. inherited HandleEvent(Event);
  807. end;
  808. procedure TSourceWindow.SetState(AState: Word; Enable: Boolean);
  809. var OldState: word;
  810. begin
  811. OldState:=State;
  812. inherited SetState(AState,Enable);
  813. if ((AState xor State) and sfActive)<>0 then
  814. UpdateCommands;
  815. end;
  816. procedure TSourceWindow.UpdateCommands;
  817. var Active: boolean;
  818. begin
  819. Active:=GetState(sfActive);
  820. if Editor^.IsClipboard=false then
  821. begin
  822. SetCmdState(SourceCmds+CompileCmds,Active);
  823. SetCmdState(EditorCmds,Active);
  824. end;
  825. if Active=false then
  826. SetCmdState(ToClipCmds+FromClipCmds+NulClipCmds+UndoCmds,false);
  827. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  828. end;
  829. procedure TSourceWindow.Update;
  830. begin
  831. ReDraw;
  832. end;
  833. function TSourceWindow.GetPalette: PPalette;
  834. const P: string[length(CSourceWindow)] = CSourceWindow;
  835. begin
  836. GetPalette:=@P;
  837. end;
  838. destructor TSourceWindow.Done;
  839. begin
  840. Message(Application,evBroadcast,cmSourceWndClosing,@Self);
  841. inherited Done;
  842. Message(Application,evBroadcast,cmUpdate,@Self);
  843. end;
  844. function TGDBSourceEditor.Valid(Command: Word): Boolean;
  845. var OK: boolean;
  846. begin
  847. OK:=TCodeEditor.Valid(Command);
  848. { do NOT ask for save !!
  849. if OK and ((Command=cmClose) or (Command=cmQuit)) then
  850. if IsClipboard=false then
  851. OK:=SaveAsk; }
  852. Valid:=OK;
  853. end;
  854. procedure TGDBSourceEditor.AddLine(const S: string);
  855. begin
  856. if Silent or (IgnoreStringAtEnd and (S=LastCommand)) then exit;
  857. inherited AddLine(S);
  858. LimitsChanged;
  859. end;
  860. procedure TGDBSourceEditor.AddErrorLine(const S: string);
  861. begin
  862. if Silent then exit;
  863. inherited AddLine(S);
  864. { display like breakpoints in red }
  865. Lines^.At(GetLineCount-1)^.IsBreakpoint:=true;
  866. LimitsChanged;
  867. end;
  868. function TGDBSourceEditor.InsertLine: Sw_integer;
  869. Var
  870. S : string;
  871. begin
  872. if IsReadOnly then begin InsertLine:=-1; Exit; end;
  873. if CurPos.Y<GetLineCount then S:=GetLineText(CurPos.Y) else S:='';
  874. s:=Copy(S,1,CurPos.X);
  875. if assigned(Debugger) then
  876. if S<>'' then
  877. begin
  878. LastCommand:=S;
  879. { should be true only if we are at the end ! }
  880. IgnoreStringAtEnd:=(CurPos.Y=GetLineCount-1) and (CurPos.X=length(GetDisplayText(GetLineCount-1)));
  881. Debugger^.Command(S);
  882. IgnoreStringAtEnd:=false;
  883. end
  884. else if AutoRepeat then
  885. Debugger^.Command(LastCommand);
  886. InsertLine:=inherited InsertLine;
  887. end;
  888. constructor TGDBWindow.Init(var Bounds: TRect);
  889. var HSB,VSB: PScrollBar;
  890. R: TRect;
  891. begin
  892. inherited Init(Bounds,'GDB window',SearchFreeWindowNo);
  893. Options:=Options or ofTileAble;
  894. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  895. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  896. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  897. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  898. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  899. New(Indicator, Init(R));
  900. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  901. Insert(Indicator);
  902. GetExtent(R); R.Grow(-1,-1);
  903. New(Editor, Init(R, HSB, VSB, nil, GDBOutputFile));
  904. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  905. if ExistsFile(GDBOutputFile) then
  906. begin
  907. if Editor^.LoadFile=false then
  908. ErrorBox(#3'Error reading file.',nil);
  909. end
  910. else
  911. { Empty files are buggy !! }
  912. Editor^.AddLine('');
  913. Insert(Editor);
  914. if assigned(Debugger) then
  915. Debugger^.Command('set width '+IntToStr(Size.X-1));
  916. Editor^.silent:=false;
  917. Editor^.AutoRepeat:=true;
  918. end;
  919. destructor TGDBWindow.Done;
  920. begin
  921. if @Self=GDBWindow then
  922. GDBWindow:=nil;
  923. inherited Done;
  924. end;
  925. function TGDBWindow.GetPalette: PPalette;
  926. const P: string[length(CSourceWindow)] = CSourceWindow;
  927. begin
  928. GetPalette:=@P;
  929. end;
  930. procedure TGDBWindow.WriteOutputText(Buf : pchar);
  931. begin
  932. {selected normal color ?}
  933. WriteText(Buf,false);
  934. end;
  935. procedure TGDBWindow.WriteErrorText(Buf : pchar);
  936. begin
  937. {selected normal color ?}
  938. WriteText(Buf,true);
  939. end;
  940. procedure TGDBWindow.WriteString(Const S : string);
  941. begin
  942. Editor^.AddLine(S);
  943. end;
  944. procedure TGDBWindow.WriteErrorString(Const S : string);
  945. begin
  946. Editor^.AddErrorLine(S);
  947. end;
  948. procedure TGDBWindow.WriteText(Buf : pchar;IsError : boolean);
  949. var p,pe : pchar;
  950. s : string;
  951. begin
  952. p:=buf;
  953. DeskTop^.Lock;
  954. While assigned(p) do
  955. begin
  956. pe:=strscan(p,#10);
  957. if pe<>nil then
  958. pe^:=#0;
  959. s:=strpas(p);
  960. If IsError then
  961. Editor^.AddErrorLine(S)
  962. else
  963. Editor^.AddLine(S);
  964. { restore for dispose }
  965. if pe<>nil then
  966. pe^:=#10;
  967. if pe=nil then
  968. p:=nil
  969. else
  970. begin
  971. p:=pe;
  972. inc(p);
  973. end;
  974. end;
  975. DeskTop^.Unlock;
  976. Editor^.Draw;
  977. end;
  978. constructor TClipboardWindow.Init;
  979. var R: TRect;
  980. HSB,VSB: PScrollBar;
  981. begin
  982. Desktop^.GetExtent(R);
  983. inherited Init(R, '');
  984. SetTitle('Clipboard');
  985. HelpCtx:=hcClipboardWindow;
  986. Number:=wnNoNumber;
  987. GetExtent(R); R.A.Y:=R.B.Y-1; R.Grow(-1,0); R.A.X:=14;
  988. New(HSB, Init(R)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  989. GetExtent(R); R.A.X:=R.B.X-1; R.Grow(0,-1);
  990. New(VSB, Init(R)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  991. GetExtent(R); R.A.X:=3; R.B.X:=14; R.A.Y:=R.B.Y-1;
  992. New(Indicator, Init(R));
  993. Indicator^.GrowMode:=gfGrowLoY+gfGrowHiY;
  994. Insert(Indicator);
  995. GetExtent(R); R.Grow(-1,-1);
  996. New(Editor, Init(R, HSB, VSB, Indicator, ''));
  997. Editor^.GrowMode:=gfGrowHiX+gfGrowHiY;
  998. Insert(Editor);
  999. Hide;
  1000. Clipboard:=Editor;
  1001. end;
  1002. procedure TClipboardWindow.Show;
  1003. begin
  1004. inherited Show;
  1005. if GetState(sfVisible) and (Number=0) then
  1006. begin
  1007. Number:=SearchFreeWindowNo;
  1008. ReDraw;
  1009. end;
  1010. end;
  1011. procedure TClipboardWindow.Hide;
  1012. begin
  1013. inherited Hide;
  1014. if GetState(sfVisible)=false then Number:=0;
  1015. end;
  1016. procedure TClipboardWindow.Close;
  1017. begin
  1018. Hide;
  1019. end;
  1020. destructor TClipboardWindow.Done;
  1021. begin
  1022. inherited Done;
  1023. Clipboard:=nil;
  1024. ClipboardWindow:=nil;
  1025. end;
  1026. constructor TMessageListBox.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
  1027. begin
  1028. inherited Init(Bounds,1,AHScrollBar, AVScrollBar);
  1029. New(ModuleNames, Init(50,100));
  1030. NoSelection:=true;
  1031. end;
  1032. function TMessageListBox.GetLocalMenu: PMenu;
  1033. var M: PMenu;
  1034. begin
  1035. if (Owner<>nil) and (Owner^.GetState(sfModal)) then M:=nil else
  1036. M:=NewMenu(
  1037. NewItem('~C~lear','',kbNoKey,cmMsgClear,hcMsgClear,
  1038. NewLine(
  1039. NewItem('~G~oto source','',kbNoKey,cmMsgGotoSource,hcMsgGotoSource,
  1040. NewItem('~T~rack source','',kbNoKey,cmMsgTrackSource,hcMsgTrackSource,
  1041. nil)))));
  1042. GetLocalMenu:=M;
  1043. end;
  1044. procedure TMessageListBox.HandleEvent(var Event: TEvent);
  1045. var DontClear: boolean;
  1046. begin
  1047. case Event.What of
  1048. evKeyDown :
  1049. begin
  1050. DontClear:=false;
  1051. case Event.KeyCode of
  1052. kbEnter :
  1053. if Owner<>pointer(SD) then
  1054. Message(@Self,evCommand,cmMsgGotoSource,nil);
  1055. else DontClear:=true;
  1056. end;
  1057. if DontClear=false then ClearEvent(Event);
  1058. end;
  1059. evBroadcast :
  1060. case Event.Command of
  1061. cmListItemSelected :
  1062. if Event.InfoPtr=@Self then
  1063. Message(@Self,evCommand,cmMsgTrackSource,nil);
  1064. end;
  1065. evCommand :
  1066. begin
  1067. DontClear:=false;
  1068. case Event.Command of
  1069. cmMsgGotoSource :
  1070. if Range>0 then
  1071. GotoSource;
  1072. cmMsgTrackSource :
  1073. if Range>0 then
  1074. TrackSource;
  1075. cmMsgClear :
  1076. Clear;
  1077. else DontClear:=true;
  1078. end;
  1079. if DontClear=false then ClearEvent(Event);
  1080. end;
  1081. end;
  1082. inherited HandleEvent(Event);
  1083. end;
  1084. procedure TMessageListBox.AddItem(P: PMessageItem);
  1085. var W : integer;
  1086. begin
  1087. if List=nil then New(List, Init(500,500));
  1088. W:=length(P^.GetText(255));
  1089. if W>MaxWidth then
  1090. begin
  1091. MaxWidth:=W;
  1092. if HScrollBar<>nil then
  1093. HScrollBar^.SetRange(0,MaxWidth);
  1094. end;
  1095. List^.Insert(P);
  1096. SetRange(List^.Count);
  1097. if Focused=List^.Count-1-1 then
  1098. FocusItem(List^.Count-1);
  1099. DrawView;
  1100. end;
  1101. function TMessageListBox.AddModuleName(Name: string): PString;
  1102. var P: PString;
  1103. begin
  1104. if ModuleNames<>nil then
  1105. P:=ModuleNames^.Add(Name)
  1106. else
  1107. P:=nil;
  1108. AddModuleName:=P;
  1109. end;
  1110. function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
  1111. var P: PMessageItem;
  1112. S: string;
  1113. begin
  1114. P:=List^.At(Item);
  1115. S:=P^.GetText(MaxLen);
  1116. GetText:=copy(S,1,MaxLen);
  1117. end;
  1118. procedure TMessageListBox.Clear;
  1119. begin
  1120. if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
  1121. if ModuleNames<>nil then ModuleNames^.FreeAll;
  1122. SetRange(0); DrawView;
  1123. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1124. end;
  1125. procedure TMessageListBox.TrackSource;
  1126. var W: PSourceWindow;
  1127. P: PMessageItem;
  1128. R: TRect;
  1129. Row,Col: sw_integer;
  1130. begin
  1131. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1132. if Range=0 then Exit;
  1133. P:=List^.At(Focused);
  1134. if P^.Row=0 then Exit;
  1135. Desktop^.Lock;
  1136. GetNextEditorBounds(R);
  1137. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1138. R.B.Y:=Owner^.Origin.Y;
  1139. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1140. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1141. W:=EditorWindowFile(P^.GetModuleName);
  1142. if assigned(W) then
  1143. begin
  1144. W^.GetExtent(R);
  1145. if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
  1146. R.B.Y:=Owner^.Origin.Y;
  1147. W^.ChangeBounds(R);
  1148. W^.Editor^.SetCurPtr(Col,Row);
  1149. end
  1150. else
  1151. W:=TryToOpenFile(@R,P^.GetModuleName,Col,Row,true);
  1152. if W<>nil then
  1153. begin
  1154. W^.Select;
  1155. W^.Editor^.TrackCursor(true);
  1156. W^.Editor^.SetHighlightRow(Row);
  1157. end;
  1158. if Assigned(Owner) then
  1159. Owner^.Select;
  1160. Desktop^.UnLock;
  1161. end;
  1162. procedure TMessageListBox.GotoSource;
  1163. var W: PSourceWindow;
  1164. P: PMessageItem;
  1165. Row,Col: sw_integer;
  1166. begin
  1167. Message(Application,evBroadcast,cmClearLineHighlights,@Self);
  1168. if Range=0 then Exit;
  1169. P:=List^.At(Focused);
  1170. if P^.Row=0 then Exit;
  1171. Desktop^.Lock;
  1172. if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
  1173. if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
  1174. W:=TryToOpenFile(nil,P^.GetModuleName,Col,Row,true);
  1175. Message(Owner,evCommand,cmClose,nil);
  1176. Desktop^.UnLock;
  1177. end;
  1178. procedure TMessageListBox.Draw;
  1179. var
  1180. I, J, Item: Integer;
  1181. NormalColor, SelectedColor, FocusedColor, Color: Word;
  1182. ColWidth, CurCol, Indent: Integer;
  1183. B: TDrawBuffer;
  1184. Text: String;
  1185. SCOff: Byte;
  1186. TC: byte;
  1187. procedure MT(var C: word); begin if TC<>0 then C:=(C and $ff0f) or (TC and $f0); end;
  1188. begin
  1189. if (Owner<>nil) then TC:=ord(Owner^.GetColor(6)) else TC:=0;
  1190. if State and (sfSelected + sfActive) = (sfSelected + sfActive) then
  1191. begin
  1192. NormalColor := GetColor(1);
  1193. FocusedColor := GetColor(3);
  1194. SelectedColor := GetColor(4);
  1195. end else
  1196. begin
  1197. NormalColor := GetColor(2);
  1198. SelectedColor := GetColor(4);
  1199. end;
  1200. if Transparent then
  1201. begin MT(NormalColor); MT(SelectedColor); end;
  1202. if NoSelection then
  1203. SelectedColor:=NormalColor;
  1204. if HScrollBar <> nil then Indent := HScrollBar^.Value
  1205. else Indent := 0;
  1206. ColWidth := Size.X div NumCols + 1;
  1207. for I := 0 to Size.Y - 1 do
  1208. begin
  1209. for J := 0 to NumCols-1 do
  1210. begin
  1211. Item := J*Size.Y + I + TopItem;
  1212. CurCol := J*ColWidth;
  1213. if (State and (sfSelected + sfActive) = (sfSelected + sfActive)) and
  1214. (Focused = Item) and (Range > 0) then
  1215. begin
  1216. Color := FocusedColor;
  1217. SetCursor(CurCol+1,I);
  1218. SCOff := 0;
  1219. end
  1220. else if (Item < Range) and IsSelected(Item) then
  1221. begin
  1222. Color := SelectedColor;
  1223. SCOff := 2;
  1224. end
  1225. else
  1226. begin
  1227. Color := NormalColor;
  1228. SCOff := 4;
  1229. end;
  1230. MoveChar(B[CurCol], ' ', Color, ColWidth);
  1231. if Item < Range then
  1232. begin
  1233. Text := GetText(Item, ColWidth + Indent);
  1234. Text := Copy(Text,Indent,ColWidth);
  1235. MoveStr(B[CurCol+1], Text, Color);
  1236. if ShowMarkers then
  1237. begin
  1238. WordRec(B[CurCol]).Lo := Byte(SpecialChars[SCOff]);
  1239. WordRec(B[CurCol+ColWidth-2]).Lo := Byte(SpecialChars[SCOff+1]);
  1240. end;
  1241. end;
  1242. MoveChar(B[CurCol+ColWidth-1], #179, GetColor(5), 1);
  1243. end;
  1244. WriteLine(0, I, Size.X, 1, B);
  1245. end;
  1246. end;
  1247. destructor TMessageListBox.Done;
  1248. begin
  1249. inherited Done;
  1250. if List<>nil then Dispose(List, Done);
  1251. if ModuleNames<>nil then Dispose(ModuleNames, Done);
  1252. end;
  1253. constructor TMessageItem.Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
  1254. begin
  1255. inherited Init;
  1256. TClass:=AClass;
  1257. Text:=NewStr(AText);
  1258. Module:=AModule;
  1259. Row:=ARow; Col:=ACol;
  1260. end;
  1261. function TMessageItem.GetText(MaxLen: integer): string;
  1262. var S: string;
  1263. begin
  1264. if Text=nil then S:='' else S:=Text^;
  1265. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1266. GetText:=S;
  1267. end;
  1268. procedure TMessageItem.Selected;
  1269. begin
  1270. end;
  1271. function TMessageItem.GetModuleName: string;
  1272. begin
  1273. GetModuleName:=GetStr(Module);
  1274. end;
  1275. destructor TMessageItem.Done;
  1276. begin
  1277. inherited Done;
  1278. if Text<>nil then DisposeStr(Text);
  1279. { if Module<>nil then DisposeStr(Module);}
  1280. end;
  1281. function TCompilerMessage.GetText(MaxLen: Integer): String;
  1282. var ClassS: string[20];
  1283. S: string;
  1284. begin
  1285. if TClass=
  1286. V_Fatal then ClassS:='Fatal' else if TClass =
  1287. V_Error then ClassS:='Error' else if TClass =
  1288. V_Normal then ClassS:='' else if TClass =
  1289. V_Warning then ClassS:='Warning' else if TClass =
  1290. V_Note then ClassS:='Note' else if TClass =
  1291. V_Hint then ClassS:='Hint' else if TClass =
  1292. V_Macro then ClassS:='Macro' else if TClass =
  1293. V_Procedure then ClassS:='Procedure' else if TClass =
  1294. V_Conditional then ClassS:='Conditional' else if TClass =
  1295. V_Info then ClassS:='Info' else if TClass =
  1296. V_Status then ClassS:='Status' else if TClass =
  1297. V_Used then ClassS:='Used' else if TClass =
  1298. V_Tried then ClassS:='Tried' else if TClass =
  1299. V_Debug then ClassS:='Debug'
  1300. else
  1301. ClassS:='???';
  1302. if ClassS<>'' then
  1303. ClassS:=RExpand(ClassS,0)+': ';
  1304. S:=ClassS;
  1305. if (Module<>nil) {and (ID<>0)} then
  1306. S:=S+Module^+' ('+IntToStr(Row)+'): ';
  1307. if Text<>nil then S:=ClassS+Text^;
  1308. if length(S)>MaxLen then S:=copy(S,1,MaxLen-2)+'..';
  1309. GetText:=S;
  1310. end;
  1311. constructor TProgramInfoWindow.Init;
  1312. var R,R2: TRect;
  1313. HSB,VSB: PScrollBar;
  1314. ST: PStaticText;
  1315. C: word;
  1316. const White = 15;
  1317. begin
  1318. Desktop^.GetExtent(R); R.A.Y:=R.B.Y-13;
  1319. inherited Init(R, 'Program Information', wnNoNumber);
  1320. HelpCtx:=hcInfoWindow;
  1321. GetExtent(R); R.Grow(-1,-1); R.B.Y:=R.A.Y+3;
  1322. C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
  1323. New(InfoST, Init(R,'', C)); InfoST^.GrowMode:=gfGrowHiX;
  1324. InfoST^.DontWrap:=true;
  1325. Insert(InfoST);
  1326. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,3); R.B.Y:=R.A.Y+1;
  1327. New(ST, Init(R, CharStr('Ä', MaxViewWidth))); ST^.GrowMode:=gfGrowHiX; Insert(ST);
  1328. GetExtent(R); R.Grow(-1,-1); Inc(R.A.Y,4);
  1329. R2.Copy(R); Inc(R2.B.Y); R2.A.Y:=R2.B.Y-1;
  1330. New(HSB, Init(R2)); HSB^.GrowMode:=gfGrowLoY+gfGrowHiY+gfGrowHiX; Insert(HSB);
  1331. R2.Copy(R); Inc(R2.B.X); R2.A.X:=R2.B.X-1;
  1332. New(VSB, Init(R2)); VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1333. New(LogLB, Init(R,HSB,VSB));
  1334. LogLB^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1335. LogLB^.Transparent:=true;
  1336. Insert(LogLB);
  1337. Update;
  1338. end;
  1339. procedure TProgramInfoWindow.AddMessage(AClass: longint; Msg, Module: string; Line, Column: longint);
  1340. begin
  1341. if AClass>=V_Info then Line:=0;
  1342. LogLB^.AddItem(New(PCompilerMessage, Init(AClass, Msg, LogLB^.AddModuleName(Module), Line, Column)));
  1343. end;
  1344. procedure TProgramInfoWindow.ClearMessages;
  1345. begin
  1346. LogLB^.Clear;
  1347. ReDraw;
  1348. end;
  1349. procedure TProgramInfoWindow.SizeLimits(var Min, Max: TPoint);
  1350. begin
  1351. inherited SizeLimits(Min,Max);
  1352. Min.X:=30; Min.Y:=9;
  1353. end;
  1354. procedure TProgramInfoWindow.Close;
  1355. begin
  1356. Hide;
  1357. end;
  1358. procedure TProgramInfoWindow.HandleEvent(var Event: TEvent);
  1359. begin
  1360. case Event.What of
  1361. evBroadcast :
  1362. case Event.Command of
  1363. cmUpdate :
  1364. Update;
  1365. end;
  1366. end;
  1367. inherited HandleEvent(Event);
  1368. end;
  1369. procedure TProgramInfoWindow.Update;
  1370. begin
  1371. InfoST^.SetText(
  1372. {#13+ }
  1373. ' Current module : '+MainFile+#13+
  1374. ' Last exit code : '+IntToStr(LastExitCode)+#13+
  1375. ' Available memory : '+IntToStrL(MemAvail div 1024,5)+'K'+#13+
  1376. ''
  1377. );
  1378. end;
  1379. destructor TProgramInfoWindow.Done;
  1380. begin
  1381. inherited Done;
  1382. ProgramInfoWindow:=nil;
  1383. end;
  1384. constructor TTab.Init(var Bounds: TRect; ATabDef: PTabDef);
  1385. begin
  1386. inherited Init(Bounds);
  1387. Options:=Options or ofSelectable or ofFirstClick or ofPreProcess or ofPostProcess;
  1388. GrowMode:=gfGrowHiX+gfGrowHiY+gfGrowRel;
  1389. TabDefs:=ATabDef;
  1390. ActiveDef:=-1;
  1391. SelectTab(0);
  1392. ReDraw;
  1393. end;
  1394. function TTab.TabCount: integer;
  1395. var i: integer;
  1396. P: PTabDef;
  1397. begin
  1398. I:=0; P:=TabDefs;
  1399. while (P<>nil) do
  1400. begin
  1401. Inc(I);
  1402. P:=P^.Next;
  1403. end;
  1404. TabCount:=I;
  1405. end;
  1406. function TTab.AtTab(Index: integer): PTabDef;
  1407. var i: integer;
  1408. P: PTabDef;
  1409. begin
  1410. i:=0; P:=TabDefs;
  1411. while (I<Index) do
  1412. begin
  1413. if P=nil then RunError($AA);
  1414. P:=P^.Next;
  1415. Inc(i);
  1416. end;
  1417. AtTab:=P;
  1418. end;
  1419. procedure TTab.SelectTab(Index: integer);
  1420. var P: PTabItem;
  1421. V: PView;
  1422. begin
  1423. if ActiveDef<>Index then
  1424. begin
  1425. if Owner<>nil then Owner^.Lock;
  1426. Lock;
  1427. { --- Update --- }
  1428. if TabDefs<>nil then
  1429. begin
  1430. DefCount:=1;
  1431. while AtTab(DefCount-1)^.Next<>nil do Inc(DefCount);
  1432. end
  1433. else DefCount:=0;
  1434. if ActiveDef<>-1 then
  1435. begin
  1436. P:=AtTab(ActiveDef)^.Items;
  1437. while P<>nil do
  1438. begin
  1439. if P^.View<>nil then Delete(P^.View);
  1440. P:=P^.Next;
  1441. end;
  1442. end;
  1443. ActiveDef:=Index;
  1444. P:=AtTab(ActiveDef)^.Items;
  1445. while P<>nil do
  1446. begin
  1447. if P^.View<>nil then Insert(P^.View);
  1448. P:=P^.Next;
  1449. end;
  1450. V:=AtTab(ActiveDef)^.DefItem;
  1451. if V<>nil then V^.Select;
  1452. ReDraw;
  1453. { --- Update --- }
  1454. UnLock;
  1455. if Owner<>nil then Owner^.UnLock;
  1456. DrawView;
  1457. end;
  1458. end;
  1459. procedure TTab.ChangeBounds(var Bounds: TRect);
  1460. var D: TPoint;
  1461. procedure DoCalcChange(P: PView); {$ifndef FPC}far;{$endif}
  1462. var
  1463. R: TRect;
  1464. begin
  1465. if P^.Owner=nil then Exit; { it think this is a bug in TV }
  1466. P^.CalcBounds(R, D);
  1467. P^.ChangeBounds(R);
  1468. end;
  1469. var
  1470. P: PTabItem;
  1471. I: integer;
  1472. begin
  1473. D.X := Bounds.B.X - Bounds.A.X - Size.X;
  1474. D.Y := Bounds.B.Y - Bounds.A.Y - Size.Y;
  1475. inherited ChangeBounds(Bounds);
  1476. for I:=0 to TabCount-1 do
  1477. if I<>ActiveDef then
  1478. begin
  1479. P:=AtTab(I)^.Items;
  1480. while P<>nil do
  1481. begin
  1482. if P^.View<>nil then DoCalcChange(P^.View);
  1483. P:=P^.Next;
  1484. end;
  1485. end;
  1486. end;
  1487. procedure TTab.HandleEvent(var Event: TEvent);
  1488. var Index : integer;
  1489. I : integer;
  1490. X : integer;
  1491. Len : byte;
  1492. P : TPoint;
  1493. V : PView;
  1494. CallOrig: boolean;
  1495. LastV : PView;
  1496. FirstV: PView;
  1497. function FirstSelectable: PView;
  1498. var
  1499. FV : PView;
  1500. begin
  1501. FV := First;
  1502. while (FV<>nil) and ((FV^.Options and ofSelectable)=0) and (FV<>Last) do
  1503. FV:=FV^.Next;
  1504. if FV<>nil then
  1505. if (FV^.Options and ofSelectable)=0 then FV:=nil;
  1506. FirstSelectable:=FV;
  1507. end;
  1508. function LastSelectable: PView;
  1509. var
  1510. LV : PView;
  1511. begin
  1512. LV := Last;
  1513. while (LV<>nil) and ((LV^.Options and ofSelectable)=0) and (LV<>First) do
  1514. LV:=LV^.Prev;
  1515. if LV<>nil then
  1516. if (LV^.Options and ofSelectable)=0 then LV:=nil;
  1517. LastSelectable:=LV;
  1518. end;
  1519. begin
  1520. if (Event.What and evMouseDown)<>0 then
  1521. begin
  1522. MakeLocal(Event.Where,P);
  1523. if P.Y<3 then
  1524. begin
  1525. Index:=-1; X:=1;
  1526. for i:=0 to DefCount-1 do
  1527. begin
  1528. Len:=CStrLen(AtTab(i)^.Name^);
  1529. if (P.X>=X) and (P.X<=X+Len+1) then Index:=i;
  1530. X:=X+Len+3;
  1531. end;
  1532. if Index<>-1 then
  1533. SelectTab(Index);
  1534. end;
  1535. end;
  1536. if Event.What=evKeyDown then
  1537. begin
  1538. Index:=-1;
  1539. case Event.KeyCode of
  1540. kbTab,kbShiftTab :
  1541. if GetState(sfSelected) then
  1542. begin
  1543. if Current<>nil then
  1544. begin
  1545. LastV:=LastSelectable; FirstV:=FirstSelectable;
  1546. if ((Current=LastV) or (Current=PLabel(LastV)^.Link)) and (Event.KeyCode=kbShiftTab) then
  1547. begin
  1548. if Owner<>nil then Owner^.SelectNext(true);
  1549. end else
  1550. if ((Current=FirstV) or (Current=PLabel(FirstV)^.Link)) and (Event.KeyCode=kbTab) then
  1551. begin
  1552. Lock;
  1553. if Owner<>nil then Owner^.SelectNext(false);
  1554. UnLock;
  1555. end else
  1556. SelectNext(Event.KeyCode=kbShiftTab);
  1557. ClearEvent(Event);
  1558. end;
  1559. end;
  1560. else
  1561. for I:=0 to DefCount-1 do
  1562. begin
  1563. if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
  1564. then begin
  1565. Index:=I;
  1566. ClearEvent(Event);
  1567. Break;
  1568. end;
  1569. end;
  1570. end;
  1571. if Index<>-1 then
  1572. begin
  1573. Select;
  1574. SelectTab(Index);
  1575. V:=AtTab(ActiveDef)^.DefItem;
  1576. if V<>nil then V^.Focus;
  1577. end;
  1578. end;
  1579. CallOrig:=true;
  1580. if Event.What=evKeyDown then
  1581. begin
  1582. if ((Owner<>nil) and (Owner^.Phase=phPostProcess) and (GetAltChar(Event.KeyCode)<>#0)) or GetState(sfFocused)
  1583. then
  1584. else CallOrig:=false;
  1585. end;
  1586. if CallOrig then inherited HandleEvent(Event);
  1587. end;
  1588. function TTab.GetPalette: PPalette;
  1589. begin
  1590. GetPalette:=nil;
  1591. end;
  1592. procedure TTab.Draw;
  1593. var B : TDrawBuffer;
  1594. i : integer;
  1595. C1,C2,C3,C : word;
  1596. HeaderLen : integer;
  1597. X,X2 : integer;
  1598. Name : PString;
  1599. ActiveKPos : integer;
  1600. ActiveVPos : integer;
  1601. FC : char;
  1602. ClipR : TRect;
  1603. procedure SWriteBuf(X,Y,W,H: integer; var Buf);
  1604. var i: integer;
  1605. begin
  1606. if Y+H>Size.Y then H:=Size.Y-Y;
  1607. if X+W>Size.X then W:=Size.X-X;
  1608. if Buffer=nil then WriteBuf(X,Y,W,H,Buf)
  1609. else for i:=1 to H do
  1610. Move(Buf,Buffer^[X+(Y+i-1)*Size.X],W*2);
  1611. end;
  1612. procedure ClearBuf;
  1613. begin
  1614. MoveChar(B,' ',C1,Size.X);
  1615. end;
  1616. begin
  1617. if InDraw then Exit;
  1618. InDraw:=true;
  1619. { - Start of TGroup.Draw - }
  1620. if Buffer = nil then
  1621. begin
  1622. GetBuffer;
  1623. end;
  1624. { - Start of TGroup.Draw - }
  1625. C1:=GetColor(1); C2:=(GetColor(7) and $f0 or $08)+GetColor(9)*256; C3:=GetColor(8)+GetColor({9}8)*256;
  1626. HeaderLen:=0; for i:=0 to DefCount-1 do HeaderLen:=HeaderLen+CStrLen(AtTab(i)^.Name^)+3; Dec(HeaderLen);
  1627. if HeaderLen>Size.X-2 then HeaderLen:=Size.X-2;
  1628. { --- 1. sor --- }
  1629. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[HeaderLen+1],'³',C1,1);
  1630. X:=1;
  1631. for i:=0 to DefCount-1 do
  1632. begin
  1633. Name:=AtTab(i)^.Name; X2:=CStrLen(Name^);
  1634. if i=ActiveDef
  1635. then begin
  1636. ActiveKPos:=X-1;
  1637. ActiveVPos:=X+X2+2;
  1638. if GetState(sfFocused) then C:=C3 else C:=C2;
  1639. end
  1640. else C:=C2;
  1641. MoveCStr(B[X],' '+Name^+' ',C); X:=X+X2+3;
  1642. MoveChar(B[X-1],'³',C1,1);
  1643. end;
  1644. SWriteBuf(0,1,Size.X,1,B);
  1645. { --- 0. sor --- }
  1646. ClearBuf; MoveChar(B[0],'Ú',C1,1);
  1647. X:=1;
  1648. for i:=0 to DefCount-1 do
  1649. begin
  1650. if I<ActiveDef then FC:='Ú'
  1651. else FC:='¿';
  1652. X2:=CStrLen(AtTab(i)^.Name^)+2;
  1653. MoveChar(B[X+X2],{'Â'}FC,C1,1);
  1654. if i=DefCount-1 then X2:=X2+1;
  1655. if X2>0 then
  1656. MoveChar(B[X],'Ä',C1,X2);
  1657. X:=X+X2+1;
  1658. end;
  1659. MoveChar(B[HeaderLen+1],'¿',C1,1);
  1660. MoveChar(B[ActiveKPos],'Ú',C1,1); MoveChar(B[ActiveVPos],'¿',C1,1);
  1661. SWriteBuf(0,0,Size.X,1,B);
  1662. { --- 2. sor --- }
  1663. MoveChar(B[1],'Ä',C1,Max(HeaderLen,0)); MoveChar(B[HeaderLen+2],'Ä',C1,Max(Size.X-HeaderLen-3,0));
  1664. MoveChar(B[Size.X-1],'¿',C1,1);
  1665. MoveChar(B[ActiveKPos],'Ù',C1,1);
  1666. if ActiveDef=0 then MoveChar(B[0],'³',C1,1)
  1667. else MoveChar(B[0],{'Ã'}'Ú',C1,1);
  1668. MoveChar(B[HeaderLen+1],'Ä'{'Á'},C1,1); MoveChar(B[ActiveVPos],'À',C1,1);
  1669. MoveChar(B[ActiveKPos+1],' ',C1,Max(ActiveVPos-ActiveKPos-1,0));
  1670. SWriteBuf(0,2,Size.X,1,B);
  1671. { --- marad‚k sor --- }
  1672. ClearBuf; MoveChar(B[0],'³',C1,1); MoveChar(B[Size.X-1],'³',C1,1);
  1673. SWriteBuf(0,3,Size.X,Size.Y-4,B);
  1674. { --- Size.X . sor --- }
  1675. MoveChar(B[0],'À',C1,1); MoveChar(B[1],'Ä',C1,Max(Size.X-2,0)); MoveChar(B[Size.X-1],'Ù',C1,1);
  1676. SWriteBuf(0,Size.Y-1,Size.X,1,B);
  1677. { - End of TGroup.Draw - }
  1678. if Buffer <> nil then
  1679. begin
  1680. Lock;
  1681. Redraw;
  1682. UnLock;
  1683. end;
  1684. if Buffer <> nil then WriteBuf(0, 0, Size.X, Size.Y, Buffer^) else
  1685. begin
  1686. GetClipRect(ClipR);
  1687. Redraw;
  1688. GetExtent(ClipR);
  1689. end;
  1690. { - End of TGroup.Draw - }
  1691. InDraw:=false;
  1692. end;
  1693. function TTab.Valid(Command: Word): Boolean;
  1694. var PT : PTabDef;
  1695. PI : PTabItem;
  1696. OK : boolean;
  1697. begin
  1698. OK:=true;
  1699. PT:=TabDefs;
  1700. while (PT<>nil) and (OK=true) do
  1701. begin
  1702. PI:=PT^.Items;
  1703. while (PI<>nil) and (OK=true) do
  1704. begin
  1705. if PI^.View<>nil then OK:=OK and PI^.View^.Valid(Command);
  1706. PI:=PI^.Next;
  1707. end;
  1708. PT:=PT^.Next;
  1709. end;
  1710. Valid:=OK;
  1711. end;
  1712. procedure TTab.SetState(AState: Word; Enable: Boolean);
  1713. begin
  1714. inherited SetState(AState,Enable);
  1715. if (AState and sfFocused)<>0 then DrawView;
  1716. end;
  1717. destructor TTab.Done;
  1718. var P,X: PTabDef;
  1719. procedure DeleteViews(P: PView); {$ifndef FPC}far;{$endif}
  1720. begin
  1721. if P<>nil then Delete(P);
  1722. end;
  1723. begin
  1724. ForEach(@DeleteViews);
  1725. inherited Done;
  1726. P:=TabDefs;
  1727. while P<>nil do
  1728. begin
  1729. X:=P^.Next;
  1730. DisposeTabDef(P);
  1731. P:=X;
  1732. end;
  1733. end;
  1734. constructor TScreenView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
  1735. AScreen: PScreen);
  1736. begin
  1737. inherited Init(Bounds,AHScrollBar,AVScrollBar);
  1738. Screen:=AScreen;
  1739. if Screen=nil then
  1740. Fail;
  1741. SetState(sfCursorVis,true);
  1742. Update;
  1743. end;
  1744. procedure TScreenView.Update;
  1745. begin
  1746. SetLimit(UserScreen^.GetWidth,UserScreen^.GetHeight);
  1747. DrawView;
  1748. end;
  1749. procedure TScreenView.HandleEvent(var Event: TEvent);
  1750. begin
  1751. case Event.What of
  1752. evBroadcast :
  1753. case Event.Command of
  1754. cmUpdate : Update;
  1755. end;
  1756. end;
  1757. inherited HandleEvent(Event);
  1758. end;
  1759. procedure TScreenView.Draw;
  1760. var B: TDrawBuffer;
  1761. X,Y: integer;
  1762. Text,Attr: string;
  1763. P: TPoint;
  1764. begin
  1765. Screen^.GetCursorPos(P);
  1766. for Y:=Delta.Y to Delta.Y+Size.Y-1 do
  1767. begin
  1768. if Y<Screen^.GetHeight then
  1769. Screen^.GetLine(Y,Text,Attr)
  1770. else
  1771. begin Text:=''; Attr:=''; end;
  1772. Text:=copy(Text,Delta.X+1,255); Attr:=copy(Attr,Delta.X+1,255);
  1773. MoveChar(B,' ',0,Size.X);
  1774. for X:=1 to length(Text) do
  1775. MoveChar(B[X-1],Text[X],ord(Attr[X]),1);
  1776. WriteLine(0,Y-Delta.Y,Size.X,1,B);
  1777. end;
  1778. SetCursor(P.X-Delta.X,P.Y-Delta.Y);
  1779. end;
  1780. constructor TScreenWindow.Init(AScreen: PScreen; ANumber: integer);
  1781. var R: TRect;
  1782. VSB,HSB: PScrollBar;
  1783. begin
  1784. Desktop^.GetExtent(R);
  1785. inherited Init(R, 'User screen', ANumber);
  1786. Options:=Options or ofTileAble;
  1787. GetExtent(R); R.Grow(-1,-1); R.Move(1,0); R.A.X:=R.B.X-1;
  1788. New(VSB, Init(R)); VSB^.Options:=VSB^.Options or ofPostProcess;
  1789. VSB^.GrowMode:=gfGrowLoX+gfGrowHiX+gfGrowHiY; Insert(VSB);
  1790. GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.A.Y:=R.B.Y-1;
  1791. New(HSB, Init(R)); HSB^.Options:=HSB^.Options or ofPostProcess;
  1792. HSB^.GrowMode:=gfGrowLoY+gfGrowHiX+gfGrowHiY; Insert(HSB);
  1793. GetExtent(R); R.Grow(-1,-1);
  1794. New(ScreenView, Init(R, HSB, VSB, AScreen));
  1795. ScreenView^.GrowMode:=gfGrowHiX+gfGrowHiY;
  1796. Insert(ScreenView);
  1797. UserScreenWindow:=@Self;
  1798. end;
  1799. destructor TScreenWindow.Done;
  1800. begin
  1801. inherited Done;
  1802. UserScreenWindow:=nil;
  1803. end;
  1804. const InTranslate : boolean = false;
  1805. procedure TranslateMouseClick(View: PView; var Event: TEvent);
  1806. procedure TranslateAction(Action: integer);
  1807. var E: TEvent;
  1808. begin
  1809. if Action<>acNone then
  1810. begin
  1811. E:=Event;
  1812. E.What:=evMouseDown; E.Buttons:=mbLeftButton;
  1813. View^.HandleEvent(E);
  1814. Event.What:=evCommand;
  1815. Event.Command:=ActionCommands[Action];
  1816. end;
  1817. end;
  1818. begin
  1819. if InTranslate then Exit;
  1820. InTranslate:=true;
  1821. case Event.What of
  1822. evMouseDown :
  1823. if (GetShiftState and kbAlt)<>0 then
  1824. TranslateAction(AltMouseAction) else
  1825. if (GetShiftState and kbCtrl)<>0 then
  1826. TranslateAction(CtrlMouseAction);
  1827. end;
  1828. InTranslate:=false;
  1829. end;
  1830. function GetNextEditorBounds(var Bounds: TRect): boolean;
  1831. var P: PView;
  1832. begin
  1833. P:=Desktop^.First;
  1834. while P<>nil do
  1835. begin
  1836. if P^.HelpCtx=hcSourceWindow then Break;
  1837. P:=P^.NextView;
  1838. end;
  1839. if P=nil then Desktop^.GetExtent(Bounds) else
  1840. begin
  1841. P^.GetBounds(Bounds);
  1842. Inc(Bounds.A.X); Inc(Bounds.A.Y);
  1843. end;
  1844. GetNextEditorBounds:=P<>nil;
  1845. end;
  1846. function OpenEditorWindow(Bounds: PRect; FileName: string; CurX,CurY: sw_integer): PSourceWindow;
  1847. var R: TRect;
  1848. W: PSourceWindow;
  1849. begin
  1850. if Assigned(Bounds) then R.Copy(Bounds^) else
  1851. GetNextEditorBounds(R);
  1852. PushStatus('Opening source file... ('+SmartPath(FileName)+')');
  1853. New(W, Init(R, FileName));
  1854. if W<>nil then
  1855. begin
  1856. if (CurX<>0) or (CurY<>0) then
  1857. with W^.Editor^ do
  1858. begin
  1859. SetCurPtr(CurX,CurY);
  1860. TrackCursor(true);
  1861. end;
  1862. W^.HelpCtx:=hcSourceWindow;
  1863. Desktop^.Insert(W);
  1864. If assigned(BreakpointCollection) then
  1865. BreakPointCollection^.ShowBreakpoints(W);
  1866. Message(Application,evBroadcast,cmUpdate,nil);
  1867. end;
  1868. PopStatus;
  1869. OpenEditorWindow:=W;
  1870. end;
  1871. function TryToOpenFile(Bounds: PRect; FileName: string; CurX,CurY: sw_integer;tryexts:boolean): PSourceWindow;
  1872. var D : DirStr;
  1873. N : NameStr;
  1874. E : ExtStr;
  1875. DrStr : String;
  1876. function CheckDir(NewDir: DirStr; NewName: NameStr; NewExt: ExtStr): boolean;
  1877. var OK: boolean;
  1878. begin
  1879. NewDir:=CompleteDir(NewDir);
  1880. OK:=ExistsFile(NewDir+NewName+NewExt);
  1881. if OK then begin D:=NewDir; N:=NewName; E:=NewExt; end;
  1882. CheckDir:=OK;
  1883. end;
  1884. function CheckExt(NewExt: ExtStr): boolean;
  1885. var OK: boolean;
  1886. begin
  1887. OK:=false;
  1888. if D<>'' then OK:=CheckDir(D,N,NewExt) else
  1889. if CheckDir('.'+DirSep,N,NewExt) then OK:=true;
  1890. CheckExt:=OK;
  1891. end;
  1892. function TryToOpen(const DD : dirstr): PSourceWindow;
  1893. var Found: boolean;
  1894. W : PSourceWindow;
  1895. begin
  1896. D:=CompleteDir(DD);
  1897. Found:=true;
  1898. if (E<>'') or (not tryexts) then
  1899. Found:=CheckExt(E)
  1900. else
  1901. if CheckExt('.pp') then
  1902. Found:=true
  1903. else
  1904. if CheckExt('.pas') then
  1905. Found:=true
  1906. else
  1907. if CheckExt('.inc') then
  1908. Found:=true
  1909. else
  1910. Found:=false;
  1911. if Found=false then
  1912. W:=nil
  1913. else
  1914. begin
  1915. FileName:=FExpand(D+N+E);
  1916. W:=OpenEditorWindow(Bounds,FileName,CurX,CurY);
  1917. end;
  1918. TryToOpen:=W;
  1919. end;
  1920. function SearchOnDesktop: PSourceWindow;
  1921. var W: PWindow;
  1922. I: integer;
  1923. Found: boolean;
  1924. SName : string;
  1925. begin
  1926. for I:=1 to 100 do
  1927. begin
  1928. W:=SearchWindowWithNo(I);
  1929. if (W<>nil) and (W^.HelpCtx=hcSourceWindow) then
  1930. begin
  1931. if (D='') then
  1932. SName:=NameAndExtOf(PSourceWindow(W)^.Editor^.FileName)
  1933. else
  1934. SName:=PSourceWindow(W)^.Editor^.FileName;
  1935. SName:=UpcaseStr(SName);
  1936. if E<>'' then
  1937. begin
  1938. if D<>'' then
  1939. Found:=SName=UpcaseStr(D+N+E)
  1940. else
  1941. Found:=SName=UpcaseStr(N+E);
  1942. end
  1943. else
  1944. begin
  1945. Found:=SName=UpcaseStr(N+'.pp');
  1946. if Found=false then
  1947. Found:=SName=UpcaseStr(N+'.pas');
  1948. end;
  1949. if Found then Break;
  1950. end;
  1951. end;
  1952. if Found=false then W:=nil;
  1953. SearchOnDesktop:=PSourceWindow(W);
  1954. end;
  1955. var
  1956. W : PSourceWindow;
  1957. begin
  1958. FSplit(FileName,D,N,E);
  1959. W:=SearchOnDesktop;
  1960. if W<>nil then
  1961. begin
  1962. NewEditorOpened:=false;
  1963. { if assigned(Bounds) then
  1964. W^.ChangeBounds(Bounds^);}
  1965. W^.Editor^.SetCurPtr(CurX,CurY);
  1966. end
  1967. else
  1968. begin
  1969. DrStr:=GetSourceDirectories;
  1970. While pos(';',DrStr)>0 do
  1971. Begin
  1972. W:=TryToOpen(Copy(DrStr,1,pos(';',DrStr)-1));
  1973. if assigned(W) then
  1974. break;
  1975. DrStr:=Copy(DrStr,pos(';',DrStr)+1,255);
  1976. End;
  1977. if not assigned(W) then
  1978. W:=TryToOpen(DrStr);
  1979. NewEditorOpened:=W<>nil;
  1980. if assigned(W) then
  1981. W^.Editor^.SetCurPtr(CurX,CurY);
  1982. end;
  1983. TryToOpenFile:=W;
  1984. end;
  1985. function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
  1986. var OK: boolean;
  1987. E: PFileEditor;
  1988. R: TRect;
  1989. begin
  1990. R.Assign(0,0,0,0);
  1991. New(E, Init(R,nil,nil,nil,FileName));
  1992. OK:=E<>nil;
  1993. if OK then OK:=E^.LoadFile;
  1994. if OK then
  1995. begin
  1996. E^.SelectAll(true);
  1997. Editor^.InsertFrom(E);
  1998. Editor^.SetCurPtr(0,0);
  1999. Editor^.SelectAll(false);
  2000. Dispose(E, Done);
  2001. end;
  2002. StartEditor:=OK;
  2003. end;
  2004. constructor TTextScroller.Init(var Bounds: TRect; ASpeed: integer; AText: PUnsortedStringCollection);
  2005. begin
  2006. inherited Init(Bounds,'');
  2007. EventMask:=EventMask or evIdle;
  2008. Speed:=ASpeed; Lines:=AText;
  2009. end;
  2010. function TTextScroller.GetLineCount: integer;
  2011. var Count: integer;
  2012. begin
  2013. if Lines=nil then Count:=0 else
  2014. Count:=Lines^.Count;
  2015. GetLineCount:=Count;
  2016. end;
  2017. function TTextScroller.GetLine(I: integer): string;
  2018. var S: string;
  2019. begin
  2020. if I<Lines^.Count then
  2021. S:=GetStr(Lines^.At(I))
  2022. else
  2023. S:='';
  2024. GetLine:=S;
  2025. end;
  2026. procedure TTextScroller.HandleEvent(var Event: TEvent);
  2027. begin
  2028. case Event.What of
  2029. evIdle :
  2030. Update;
  2031. end;
  2032. inherited HandleEvent(Event);
  2033. end;
  2034. procedure TTextScroller.Update;
  2035. begin
  2036. if abs(GetDosTicks-LastTT)<Speed then Exit;
  2037. Scroll;
  2038. LastTT:=GetDosTicks;
  2039. end;
  2040. procedure TTextScroller.Reset;
  2041. begin
  2042. TopLine:=0;
  2043. LastTT:=GetDosTicks;
  2044. DrawView;
  2045. end;
  2046. procedure TTextScroller.Scroll;
  2047. begin
  2048. Inc(TopLine);
  2049. if TopLine>=GetLineCount then
  2050. Reset;
  2051. DrawView;
  2052. end;
  2053. procedure TTextScroller.Draw;
  2054. var B: TDrawBuffer;
  2055. C: word;
  2056. Count,Y: integer;
  2057. S: string;
  2058. begin
  2059. C:=GetColor(1);
  2060. Count:=GetLineCount;
  2061. for Y:=0 to Size.Y-1 do
  2062. begin
  2063. if Count=0 then S:='' else
  2064. S:=GetLine((TopLine+Y) mod Count);
  2065. if copy(S,1,1)=^C then
  2066. S:=CharStr(' ',Max(0,(Size.X-(length(S)-1)) div 2))+copy(S,2,255);
  2067. MoveChar(B,' ',C,Size.X);
  2068. MoveStr(B,S,C);
  2069. WriteLine(0,Y,Size.X,1,B);
  2070. end;
  2071. end;
  2072. destructor TTextScroller.Done;
  2073. begin
  2074. inherited Done;
  2075. if Lines<>nil then Dispose(Lines, Done);
  2076. end;
  2077. constructor TFPAboutDialog.Init;
  2078. var R,R2: TRect;
  2079. C: PUnsortedStringCollection;
  2080. I: integer;
  2081. OSStr: string;
  2082. procedure AddLine(S: string);
  2083. begin
  2084. C^.Insert(NewStr(S));
  2085. end;
  2086. begin
  2087. OSStr:='';
  2088. {$ifdef go32v2}
  2089. OSStr:='Dos';
  2090. {$endif}
  2091. {$ifdef tp}
  2092. OSStr:='Dos';
  2093. {$endif}
  2094. {$ifdef linux}
  2095. OSStr:='Linux';
  2096. {$endif}
  2097. {$ifdef win32}
  2098. OSStr:='Win32';
  2099. {$endif}
  2100. {$ifdef os2}
  2101. OSStr:='OS/2';
  2102. {$endif}
  2103. R.Assign(0,0,38,12);
  2104. inherited Init(R, 'About');
  2105. GetExtent(R); R.Grow(-3,-2);
  2106. R2.Copy(R); R2.B.Y:=R2.A.Y+1;
  2107. Insert(New(PStaticText, Init(R2, ^C'FreePascal IDE for '+OSStr)));
  2108. R2.Move(0,1);
  2109. Insert(New(PStaticText, Init(R2, ^C' Version '+VersionStr)));
  2110. R2.Move(0,1);
  2111. Insert(New(PStaticText, Init(R2, ^C'(Compiler Version '+Version_String+')')));
  2112. R2.Move(0,2);
  2113. Insert(New(PStaticText, Init(R2, ^C'Copyright (C) 1998-99 by')));
  2114. R2.Move(0,2);
  2115. Insert(New(PStaticText, Init(R2, ^C'B‚rczi G bor')));
  2116. R2.Move(0,1);
  2117. Insert(New(PStaticText, Init(R2, ^C'and')));
  2118. R2.Move(0,1);
  2119. Insert(New(PStaticText, Init(R2, ^C'Peter Vreman')));
  2120. New(C, Init(50,10));
  2121. for I:=1 to 7 do
  2122. AddLine('');
  2123. AddLine(^C'< Original concept >');
  2124. AddLine(^C'Borland International, Inc.');
  2125. AddLine('');
  2126. AddLine(^C'< Compiler development >');
  2127. AddLine(^C'Carl-Eric Codere');
  2128. AddLine(^C'Daniel Mantione');
  2129. AddLine(^C'Florian Kl„mpfl');
  2130. AddLine(^C'Jonas Maebe');
  2131. AddLine(^C'Mich„el Van Canneyt');
  2132. AddLine(^C'Peter Vreman');
  2133. AddLine(^C'Pierre Muller');
  2134. AddLine('');
  2135. AddLine(^C'< IDE development >');
  2136. AddLine(^C'B‚rczi G bor');
  2137. AddLine(^C'Peter Vreman');
  2138. AddLine(^C'Pierre Muller');
  2139. AddLine('');
  2140. GetExtent(R);
  2141. R.Grow(-1,-1); Inc(R.A.Y,3);
  2142. New(Scroller, Init(R, 10, C));
  2143. Scroller^.Hide;
  2144. Insert(Scroller);
  2145. R.Move(0,-1); R.B.Y:=R.A.Y+1;
  2146. New(TitleST, Init(R, ^C'Team'));
  2147. TitleST^.Hide;
  2148. Insert(TitleST);
  2149. InsertOK(@Self);
  2150. end;
  2151. procedure TFPAboutDialog.ToggleInfo;
  2152. begin
  2153. if Scroller=nil then Exit;
  2154. if Scroller^.GetState(sfVisible) then
  2155. begin
  2156. Scroller^.Hide;
  2157. TitleST^.Hide;
  2158. end
  2159. else
  2160. begin
  2161. Scroller^.Reset;
  2162. Scroller^.Show;
  2163. TitleST^.Show;
  2164. end;
  2165. end;
  2166. procedure TFPAboutDialog.HandleEvent(var Event: TEvent);
  2167. begin
  2168. case Event.What of
  2169. evKeyDown :
  2170. case Event.KeyCode of
  2171. kbAltI : { just like in BP }
  2172. begin
  2173. ToggleInfo;
  2174. ClearEvent(Event);
  2175. end;
  2176. end;
  2177. end;
  2178. inherited HandleEvent(Event);
  2179. end;
  2180. constructor TFPASCIIChart.Init;
  2181. begin
  2182. inherited Init;
  2183. HelpCtx:=hcASCIITable;
  2184. Number:=SearchFreeWindowNo;
  2185. ASCIIChart:=@Self;
  2186. end;
  2187. procedure TFPASCIIChart.HandleEvent(var Event: TEvent);
  2188. begin
  2189. case Event.What of
  2190. evKeyDown :
  2191. case Event.KeyCode of
  2192. kbEsc :
  2193. begin
  2194. Close;
  2195. ClearEvent(Event);
  2196. end;
  2197. end;
  2198. end;
  2199. inherited HandleEvent(Event);
  2200. end;
  2201. destructor TFPASCIIChart.Done;
  2202. begin
  2203. ASCIIChart:=nil;
  2204. inherited Done;
  2205. end;
  2206. END.
  2207. {
  2208. $Log$
  2209. Revision 1.22 1999-03-16 00:44:45 peter
  2210. * forgotten in last commit :(
  2211. Revision 1.21 1999/03/08 14:58:16 peter
  2212. + prompt with dialogs for tools
  2213. Revision 1.20 1999/03/01 15:42:08 peter
  2214. + Added dummy entries for functions not yet implemented
  2215. * MenuBar didn't update itself automatically on command-set changes
  2216. * Fixed Debugging/Profiling options dialog
  2217. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is set
  2218. * efBackSpaceUnindents works correctly
  2219. + 'Messages' window implemented
  2220. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  2221. + Added TP message-filter support (for ex. you can call GREP thru
  2222. GREP2MSG and view the result in the messages window - just like in TP)
  2223. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  2224. so topic search didn't work...
  2225. * In FPHELP.PAS there were still context-variables defined as word instead
  2226. of THelpCtx
  2227. * StdStatusKeys() was missing from the statusdef for help windows
  2228. + Topic-title for index-table can be specified when adding a HTML-files
  2229. Revision 1.19 1999/02/22 11:51:39 peter
  2230. * browser updates from gabor
  2231. Revision 1.18 1999/02/22 11:29:38 pierre
  2232. + added col info in MessageItem
  2233. + grep uses HighLightExts and should work for linux
  2234. Revision 1.17 1999/02/22 02:15:22 peter
  2235. + default extension for save in the editor
  2236. + Separate Text to Find for the grep dialog
  2237. * fixed redir crash with tp7
  2238. Revision 1.16 1999/02/19 18:43:49 peter
  2239. + open dialog supports mask list
  2240. Revision 1.15 1999/02/17 15:04:02 pierre
  2241. + file(line) added in TProgramInfo message list
  2242. Revision 1.14 1999/02/16 12:45:18 pierre
  2243. * GDBWindow size and grow corrected
  2244. Revision 1.13 1999/02/15 09:36:06 pierre
  2245. * // comment ends at end of line !
  2246. GDB window changed !
  2247. now all is in a normal text editor, but pressing
  2248. Enter key will send part of line before cursor to GDB !
  2249. Revision 1.12 1999/02/11 19:07:25 pierre
  2250. * GDBWindow redesigned :
  2251. normal editor apart from
  2252. that any kbEnter will send the line (for begin to cursor)
  2253. to GDB command !
  2254. GDBWindow opened in Debugger Menu
  2255. still buggy :
  2256. -echo should not be present if at end of text
  2257. -GDBWindow becomes First after each step (I don't know why !)
  2258. Revision 1.11 1999/02/11 13:08:39 pierre
  2259. + TGDBWindow : direct gdb input/output
  2260. Revision 1.10 1999/02/10 09:42:52 pierre
  2261. + DoneReservedWords to avoid memory leaks
  2262. * TMessageItem Module field was not disposed
  2263. Revision 1.9 1999/02/05 12:12:02 pierre
  2264. + SourceDir that stores directories for sources that the
  2265. compiler should not know about
  2266. Automatically asked for addition when a new file that
  2267. needed filedialog to be found is in an unknown directory
  2268. Stored and retrieved from INIFile
  2269. + Breakpoints conditions added to INIFile
  2270. * Breakpoints insterted and removed at debin and end of debug session
  2271. Revision 1.8 1999/02/04 17:45:23 pierre
  2272. + BrowserAtCursor started
  2273. * bug in TryToOpenFile removed
  2274. Revision 1.7 1999/02/04 13:32:11 pierre
  2275. * Several things added (I cannot commit them independently !)
  2276. + added TBreakpoint and TBreakpointCollection
  2277. + added cmResetDebugger,cmGrep,CmToggleBreakpoint
  2278. + Breakpoint list in INIFile
  2279. * Select items now also depend of SwitchMode
  2280. * Reading of option '-g' was not possible !
  2281. + added search for -Fu args pathes in TryToOpen
  2282. + added code for automatic opening of FileDialog
  2283. if source not found
  2284. Revision 1.6 1999/01/21 11:54:27 peter
  2285. + tools menu
  2286. + speedsearch in symbolbrowser
  2287. * working run command
  2288. Revision 1.5 1999/01/14 21:42:25 peter
  2289. * source tracking from Gabor
  2290. Revision 1.4 1999/01/12 14:29:42 peter
  2291. + Implemented still missing 'switch' entries in Options menu
  2292. + Pressing Ctrl-B sets ASCII mode in editor, after which keypresses (even
  2293. ones with ASCII < 32 ; entered with Alt+<###>) are interpreted always as
  2294. ASCII chars and inserted directly in the text.
  2295. + Added symbol browser
  2296. * splitted fp.pas to fpide.pas
  2297. Revision 1.3 1999/01/04 11:49:53 peter
  2298. * 'Use tab characters' now works correctly
  2299. + Syntax highlight now acts on File|Save As...
  2300. + Added a new class to syntax highlight: 'hex numbers'.
  2301. * There was something very wrong with the palette managment. Now fixed.
  2302. + Added output directory (-FE<xxx>) support to 'Directories' dialog...
  2303. * Fixed some possible bugs in Running/Compiling, and the compilation/run
  2304. process revised
  2305. Revision 1.2 1998/12/28 15:47:54 peter
  2306. + Added user screen support, display & window
  2307. + Implemented Editor,Mouse Options dialog
  2308. + Added location of .INI and .CFG file
  2309. + Option (INI) file managment implemented (see bottom of Options Menu)
  2310. + Switches updated
  2311. + Run program
  2312. Revision 1.4 1998/12/22 10:39:53 peter
  2313. + options are now written/read
  2314. + find and replace routines
  2315. }