fpide.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310
  1. {
  2. This file is part of the Free Pascal Integrated Development Environment
  3. Copyright (c) 1998 by Berczi Gabor
  4. Main IDEApp object
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit fpide;
  12. interface
  13. {$i globdir.inc}
  14. uses
  15. Objects,Drivers,Views,App,Gadgets,MsgBox,Tabs,
  16. WEditor,WCEdit,
  17. Comphook,Browcol,
  18. WHTMLScn,
  19. FPViews,FPSymbol,fpstring;
  20. type
  21. TExecType = (exNormal,exNoSwap,exDosShell);
  22. TIDEApp = object(TApplication)
  23. IsRunning : boolean;
  24. constructor Init;
  25. procedure InitDesktop; virtual;
  26. procedure LoadMenuBar;
  27. procedure InitMenuBar; virtual;
  28. procedure reload_menubar;
  29. procedure InitStatusLine; virtual;
  30. procedure Open(FileName: string;FileDir:string);
  31. function OpenSearch(FileName: string) : boolean;
  32. function AskSaveAll: boolean;
  33. function SaveAll: boolean;
  34. function AutoSave: boolean;
  35. procedure Idle; virtual;
  36. procedure Update;
  37. procedure UpdateMode;
  38. procedure UpdateRunMenu(DebuggeeRunning : boolean);
  39. procedure UpdateTarget;
  40. procedure GetEvent(var Event: TEvent); virtual;
  41. procedure HandleEvent(var Event: TEvent); virtual;
  42. procedure GetTileRect(var R: TRect); virtual;
  43. function GetPalette: PPalette; virtual;
  44. procedure DosShell; {virtual;}
  45. procedure ShowReadme;
  46. destructor Done; virtual;
  47. procedure ShowUserScreen;
  48. procedure ShowIDEScreen;
  49. function IsClosing : boolean;
  50. private
  51. procedure NewEditor;
  52. procedure NewFromTemplate;
  53. procedure OpenRecentFile(RecentIndex: integer);
  54. procedure ChangeDir;
  55. procedure Print;
  56. procedure PrinterSetup;
  57. procedure ShowClipboard;
  58. procedure FindProcedure;
  59. procedure Objects;
  60. procedure Modules;
  61. procedure Globals;
  62. procedure SearchSymbol;
  63. procedure RunDir;
  64. procedure Parameters;
  65. procedure DoStepOver;
  66. procedure DoTraceInto;
  67. procedure DoRun;
  68. procedure DoResetDebugger;
  69. procedure DoContToCursor;
  70. procedure DoContUntilReturn;
  71. procedure Target;
  72. procedure DoCompilerMessages;
  73. procedure DoPrimaryFile;
  74. procedure DoClearPrimary;
  75. procedure DoUserScreenWindow;
  76. procedure DoCloseUserScreenWindow;
  77. procedure DoUserScreen;
  78. procedure DoOpenGDBWindow;
  79. procedure DoToggleBreak;
  80. procedure DoShowCallStack;
  81. procedure DoShowDisassembly;
  82. procedure DoShowBreakpointList;
  83. procedure DoShowWatches;
  84. procedure DoAddWatch;
  85. procedure DoShowRegisters;
  86. procedure DoShowFPU;
  87. procedure DoShowVector;
  88. function AskRecompileIfModified:boolean;
  89. procedure Messages;
  90. procedure Calculator;
  91. procedure DoAsciiTable;
  92. procedure ExecuteTool(Idx: integer);
  93. procedure SetSwitchesMode;
  94. procedure DoCompilerSwitch;
  95. procedure MemorySizes;
  96. procedure DoLinkerSwitch;
  97. procedure DoDebuggerSwitch;
  98. {$ifdef SUPPORT_REMOTE}
  99. procedure DoRemote;
  100. procedure TransferRemote;
  101. {$endif SUPPORT_REMOTE}
  102. procedure Directories;
  103. procedure Tools;
  104. procedure DoGrep;
  105. procedure Preferences;
  106. procedure EditorOptions(Editor: PEditor);
  107. procedure CodeComplete;
  108. procedure CodeTemplates;
  109. procedure BrowserOptions(Browser: PBrowserWindow);
  110. procedure DesktopOptions;
  111. procedure ResizeApplication(x, y : longint);
  112. procedure Mouse;
  113. procedure StartUp;
  114. procedure Colors;
  115. procedure OpenINI;
  116. procedure SaveINI;
  117. procedure SaveAsINI;
  118. procedure CloseAll;
  119. procedure WindowList;
  120. procedure HelpContents;
  121. procedure HelpHelpIndex;
  122. procedure HelpTopicSearch;
  123. procedure HelpPrevTopic;
  124. procedure HelpUsingHelp;
  125. procedure HelpFiles;
  126. procedure About;
  127. procedure CreateAnsiFile;
  128. public
  129. procedure SourceWindowClosed;
  130. function DoExecute(ProgramPath, Params, InFile, OutFile, ErrFile: string; ExecType: TExecType): boolean;
  131. private
  132. SaveCancelled: boolean;
  133. InsideDone : boolean;
  134. LastEvent: longint;
  135. procedure AddRecentFile(AFileName: string; CurX, CurY: sw_integer);
  136. function SearchRecentFile(AFileName: string): integer;
  137. procedure RemoveRecentFile(Index: integer);
  138. procedure CurDirChanged;
  139. procedure UpdatePrimaryFile;
  140. procedure UpdateINIFile;
  141. procedure UpdateRecentFileList;
  142. procedure UpdateTools;
  143. end;
  144. procedure PutEvent(TargetView: PView; E: TEvent);
  145. procedure PutCommand(TargetView: PView; What, Command: Word; InfoPtr: Pointer);
  146. var
  147. IDEApp: TIDEApp;
  148. {Configurable keys.}
  149. const menu_key_edit_cut:string[63]=menu_key_edit_cut_borland;
  150. menu_key_edit_copy:string[63]=menu_key_edit_copy_borland;
  151. menu_key_edit_paste:string[63]=menu_key_edit_paste_borland;
  152. menu_key_hlplocal_copy:string[63]=menu_key_hlplocal_copy_borland;
  153. cut_key:word=kbShiftDel;
  154. copy_key:word=kbCtrlIns;
  155. paste_key:word=kbShiftIns;
  156. implementation
  157. uses
  158. {$ifdef HasSignal}
  159. fpcatch,
  160. {$endif HasSignal}
  161. {$ifdef WinClipSupported}
  162. WinClip,
  163. {$endif WinClipSupported}
  164. {$ifdef Unix}
  165. fpKeys,
  166. {$endif Unix}
  167. FpDpAnsi,WConsts,
  168. Video,Mouse,Keyboard,
  169. Compiler,Version,
  170. FVConsts,
  171. Dos{,Memory},Menus,Dialogs,StdDlg,timeddlg,
  172. Systems,
  173. WUtils,WHlpView,WViews,WHTMLHlp,WHelp,WConsole,
  174. FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompil,FPHelp,
  175. FPTemplt,FPCalc,FPUsrScr,FPTools,
  176. {$ifndef NODEBUG}
  177. FPDebug,FPRegs,
  178. {$endif}
  179. FPRedir,
  180. FPDesk,FPCodCmp,FPCodTmp;
  181. type
  182. TTargetedEvent = record
  183. Target: PView;
  184. Event: TEvent;
  185. end;
  186. const
  187. TargetedEventHead : integer = 0;
  188. TargetedEventTail : integer = 0;
  189. var
  190. TargetedEvents : array[0..10] of TTargetedEvent;
  191. function IncTargetedEventPtr(I: integer): integer;
  192. begin
  193. Inc(I);
  194. if I>High(TargetedEvents) then I:=Low(TargetedEvents);
  195. IncTargetedEventPtr:=I;
  196. end;
  197. procedure PutEvent(TargetView: PView; E: TEvent);
  198. begin
  199. if IncTargetedEventPtr(TargetedEventHead)=TargetedEventTail then Exit;
  200. with TargetedEvents[TargetedEventHead] do
  201. begin
  202. Target:=TargetView;
  203. Event:=E;
  204. end;
  205. TargetedEventHead:=IncTargetedEventPtr(TargetedEventHead);
  206. end;
  207. procedure PutCommand(TargetView: PView; What, Command: Word; InfoPtr: Pointer);
  208. var E: TEvent;
  209. begin
  210. FillChar(E,Sizeof(E),0);
  211. E.What:=What;
  212. E.Command:=Command;
  213. E.InfoPtr:=InfoPtr;
  214. PutEvent(TargetView,E);
  215. end;
  216. function GetTargetedEvent(var P: PView; var E: TEvent): boolean;
  217. var OK: boolean;
  218. begin
  219. OK:=TargetedEventHead<>TargetedEventTail;
  220. if OK then
  221. begin
  222. with TargetedEvents[TargetedEventTail] do
  223. begin
  224. P:=Target;
  225. E:=Event;
  226. end;
  227. TargetedEventTail:=IncTargetedEventPtr(TargetedEventTail);
  228. end;
  229. GetTargetedEvent:=OK;
  230. end;
  231. function IDEUseSyntaxHighlight(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
  232. begin
  233. IDEUseSyntaxHighlight:=(Editor^.FileName='') or MatchesFileList(NameAndExtOf(Editor^.FileName),HighlightExts);
  234. end;
  235. function IDEUseTabsPattern(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
  236. begin
  237. { the commented code lead all new files
  238. to become with TAB use enabled which is wrong in my opinion PM }
  239. IDEUseTabsPattern:={(Editor^.FileName='') or }MatchesFileList(NameAndExtOf(Editor^.FileName),TabsPattern);
  240. end;
  241. constructor TIDEApp.Init;
  242. var R: TRect;
  243. begin
  244. UseSyntaxHighlight:=@IDEUseSyntaxHighlight;
  245. UseTabsPattern:=@IDEUseTabsPattern;
  246. inherited Init;
  247. InitAdvMsgBox;
  248. InsideDone:=false;
  249. IsRunning:=true;
  250. MenuBar^.GetBounds(R); R.A.X:=R.B.X-8;
  251. New(ClockView, Init(R));
  252. ClockView^.GrowMode:=gfGrowLoX+gfGrowHiX;
  253. Application^.Insert(ClockView);
  254. New(ClipboardWindow, Init);
  255. Desktop^.Insert(ClipboardWindow);
  256. New(CalcWindow, Init); CalcWindow^.Hide;
  257. Desktop^.Insert(CalcWindow);
  258. New(CompilerMessageWindow, Init);
  259. CompilerMessageWindow^.Hide;
  260. Desktop^.Insert(CompilerMessageWindow);
  261. Message(@Self,evBroadcast,cmUpdate,nil);
  262. CurDirChanged;
  263. { heap viewer }
  264. GetExtent(R); Dec(R.B.X); R.A.X:=R.B.X-9; R.A.Y:=R.B.Y-1;
  265. New(HeapView, InitKb(R));
  266. if (StartupOptions and soHeapMonitor)=0 then HeapView^.Hide;
  267. Insert(HeapView);
  268. Drivers.ShowMouse;
  269. {$ifdef Windows}
  270. // WindowsShowMouse;
  271. {$endif Windows}
  272. end;
  273. procedure TIDEApp.InitDesktop;
  274. var
  275. R: TRect;
  276. begin
  277. GetExtent(R);
  278. Inc(R.A.Y);
  279. Dec(R.B.Y);
  280. Desktop:=New(PFPDesktop, Init(R));
  281. end;
  282. procedure TIDEApp.LoadMenuBar;
  283. var R: TRect;
  284. WinPMI : PMenuItem;
  285. begin
  286. GetExtent(R); R.B.Y:=R.A.Y+1;
  287. WinPMI:=nil;
  288. {$ifdef WinClipSupported}
  289. if WinClipboardSupported then
  290. WinPMI:=NewLine(
  291. NewItem(menu_edit_copywin,'', kbNoKey, cmCopyWin, hcCopyWin,
  292. NewItem(menu_edit_pastewin,'', kbNoKey, cmPasteWin, hcPasteWin,
  293. nil)));
  294. {$endif WinClipSupported}
  295. MenuBar:=New(PAdvancedMenuBar, Init(R, NewMenu(
  296. NewSubMenu(menu_file,hcFileMenu, NewMenu(
  297. NewItem(menu_file_new,'',kbNoKey,cmNew,hcNew,
  298. NewItem(menu_file_template,'',kbNoKey,cmNewFromTemplate,hcNewFromTemplate,
  299. NewItem(menu_file_open,menu_key_file_open,kbF3,cmOpen,hcOpen,
  300. NewItem(menu_file_reload,'',kbNoKey,cmDoReload,hcDoReload,
  301. NewItem(menu_file_save,menu_key_file_save,kbF2,cmSave,hcSave,
  302. NewItem(menu_file_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
  303. NewItem(menu_file_saveall,'',kbNoKey,cmSaveAll,hcSaveAll,
  304. NewLine(
  305. NewItem(menu_file_print,'',kbNoKey,cmPrint,hcPrint,
  306. NewItem(menu_file_printsetup,'',kbNoKey,cmPrinterSetup,hcPrinterSetup,
  307. NewLine(
  308. NewItem(menu_file_changedir,'',kbNoKey,cmChangeDir,hcChangeDir,
  309. NewItem(menu_file_dosshell,'',kbNoKey,cmDOSShell,hcDOSShell,
  310. NewItem(menu_file_exit,menu_key_file_exit,kbNoKey,cmQuit,hcQuit,
  311. nil))))))))))))))),
  312. NewSubMenu(menu_edit,hcEditMenu, NewMenu(
  313. NewItem(menu_edit_undo,menu_key_edit_undo, kbAltBack, cmUndo, hcUndo,
  314. NewItem(menu_edit_redo,'', kbNoKey, cmRedo, hcRedo,
  315. {$ifdef DebugUndo}
  316. NewItem('~D~ump Undo','', kbNoKey, cmDumpUndo, hcUndo,
  317. NewItem('U~n~do All','', kbNoKey, cmUndoAll, hcUndo,
  318. NewItem('R~e~do All','', kbNoKey, cmRedoAll, hcRedo,
  319. {$endif DebugUndo}
  320. NewLine(
  321. NewItem(menu_edit_cut,menu_key_edit_cut, cut_key, cmCut, hcCut,
  322. NewItem(menu_edit_copy,menu_key_edit_copy, copy_key, cmCopy, hcCut,
  323. NewItem(menu_edit_paste,menu_key_edit_paste, paste_key, cmPaste, hcPaste,
  324. NewItem(menu_edit_clear,menu_key_edit_clear, kbCtrlDel, cmClear, hcClear,
  325. NewItem(menu_edit_selectall,'', kbNoKey, cmSelectAll, hcSelectAll,
  326. NewItem(menu_edit_unselect,'', kbNoKey, cmUnselect, hcUnselect,
  327. NewLine(
  328. NewItem(menu_edit_showclipboard,'', kbNoKey, cmShowClipboard, hcShowClipboard,
  329. WinPMI))))))))
  330. {$ifdef DebugUndo}))){$endif DebugUndo}
  331. )))),
  332. NewSubMenu(menu_search,hcSearchMenu, NewMenu(
  333. NewItem(menu_search_find,'', kbNoKey, cmFind, hcFind,
  334. NewItem(menu_search_replace,'', kbNoKey, cmReplace, hcReplace,
  335. NewItem(menu_search_searchagain,'', kbNoKey, cmSearchAgain, hcSearchAgain,
  336. NewLine(
  337. NewItem(menu_search_jumpline,'', kbNoKey, cmJumpLine, hcGotoLine,
  338. NewItem(menu_search_findproc,'', kbNoKey, cmFindProcedure, hcFindProcedure,
  339. NewLine(
  340. NewItem(menu_search_objects,'', kbNoKey, cmObjects, hcObjects,
  341. NewItem(menu_search_modules,'', kbNoKey, cmModules, hcModules,
  342. NewItem(menu_search_globals,'', kbNoKey, cmGlobals, hcGlobals,
  343. NewLine(
  344. NewItem(menu_search_symbol,'', kbNoKey, cmSymbol, hcSymbol,
  345. nil))))))))))))),
  346. NewSubMenu(menu_run,hcRunMenu, NewMenu(
  347. NewItem(menu_run_run,menu_key_run_run, kbCtrlF9, cmRun, hcRun,
  348. NewItem(menu_run_stepover,menu_key_run_stepover, kbF8, cmStepOver, hcRun,
  349. NewItem(menu_run_traceinto,menu_key_run_traceinto, kbF7, cmTraceInto, hcRun,
  350. NewItem(menu_run_conttocursor,menu_key_run_conttocursor, kbF4, cmContToCursor, hcContToCursor,
  351. NewItem(menu_run_untilreturn,'', kbNoKey,cmUntilReturn,hcUntilReturn,
  352. NewItem(menu_run_rundir,'', kbNoKey, cmRunDir, hcRunDir,
  353. NewItem(menu_run_parameters,'', kbNoKey, cmParameters, hcParameters,
  354. NewItem(menu_run_resetdebugger,menu_key_run_resetdebugger, kbCtrlF2, cmResetDebugger, hcResetDebugger,
  355. nil))))))))),
  356. NewSubMenu(menu_compile,hcCompileMenu, NewMenu(
  357. NewItem(menu_compile_compile,menu_key_compile_compile, kbAltF9, cmCompile, hcCompile,
  358. NewItem(menu_compile_make,menu_key_compile_make, kbF9, cmMake, hcMake,
  359. NewItem(menu_compile_build,'', kbNoKey, cmBuild, hcBuild,
  360. NewLine(
  361. NewItem(menu_compile_target,'', kbNoKey, cmTarget, hcTarget,
  362. NewItem(menu_compile_primaryfile,'', kbNoKey, cmPrimaryFile, hcPrimaryFile,
  363. NewItem(menu_compile_clearprimaryfile,'', kbNoKey, cmClearPrimary, hcClearPrimary,
  364. NewLine(
  365. NewItem(menu_compile_compilermessages,menu_key_compile_compilermessages, kbF12, cmCompilerMessages, hcCompilerMessages,
  366. nil)))))))))),
  367. NewSubMenu(menu_debug, hcDebugMenu, NewMenu(
  368. NewItem(menu_debug_output,'', kbNoKey, cmUserScreenWindow, hcUserScreenWindow,
  369. NewItem(menu_debug_userscreen,menu_key_debug_userscreen, kbAltF5, cmUserScreen, hcUserScreen,
  370. NewLine(
  371. {$ifdef SUPPORT_REMOTE}
  372. NewItem(menu_debug_remote,'', kbNoKey, cmTransferRemote, hcTransferRemote,
  373. {$endif SUPPORT_REMOTE}
  374. NewItem(menu_debug_addwatch,menu_key_debug_addwatch, kbCtrlF7, cmAddWatch, hcAddWatch,
  375. NewItem(menu_debug_watches,'', kbNoKey, cmWatches, hcWatchesWindow,
  376. NewItem(menu_debug_breakpoint,menu_key_debug_breakpoint, kbCtrlF8, cmToggleBreakpoint, hcToggleBreakpoint,
  377. NewItem(menu_debug_breakpointlist,'', kbNoKey, cmBreakpointList, hcBreakpointList,
  378. NewItem(menu_debug_callstack,menu_key_debug_callstack, kbCtrlF3, cmStack, hcStackWindow,
  379. NewLine(
  380. NewItem(menu_debug_disassemble,'', kbNoKey, cmDisassemble, hcStackWindow,
  381. NewItem(menu_debug_registers,'', kbNoKey, cmRegisters, hcRegistersWindow,
  382. NewItem(menu_debug_fpu_registers,'', kbNoKey, cmFPURegisters, hcFPURegisters,
  383. NewItem(menu_debug_vector_registers,'', kbNoKey, cmVectorRegisters, hcVectorRegisters,
  384. NewLine(
  385. NewItem(menu_debug_gdbwindow,'', kbNoKey, cmOpenGDBWindow, hcOpenGDBWindow,
  386. nil
  387. {$ifdef SUPPORT_REMOTE}
  388. )
  389. {$endif SUPPORT_REMOTE}
  390. )))))))))))))))),
  391. NewSubMenu(menu_tools, hcToolsMenu, NewMenu(
  392. NewItem(menu_tools_messages,menu_key_tools_messages, kbF11, cmToolsMessages, hcToolsMessages,
  393. NewItem(menu_tools_msgnext,menu_key_tools_msgnext, kbAltF8, cmToolsMsgNext, hcToolsMsgNext,
  394. NewItem(menu_tools_msgprev,menu_key_tools_msgprev, kbAltF7, cmToolsMsgPrev, hcToolsMsgPrev,
  395. NewLine(
  396. NewItem(menu_tools_grep,menu_key_tools_grep, kbShiftF2, cmGrep, hcGrep,
  397. NewItem(menu_tools_calculator, '', kbNoKey, cmCalculator, hcCalculator,
  398. NewItem(menu_tools_asciitable, '', kbNoKey, cmAsciiTable, hcAsciiTable,
  399. nil)))))))),
  400. NewSubMenu(menu_options, hcOptionsMenu, NewMenu(
  401. NewItem(menu_options_mode,'', kbNoKey, cmSwitchesMode, hcSwitchesMode,
  402. NewItem(menu_options_compiler,'', kbNoKey, cmCompiler, hcCompiler,
  403. NewItem(menu_options_memory,'', kbNoKey, cmMemorySizes, hcMemorySizes,
  404. NewItem(menu_options_linker,'', kbNoKey, cmLinker, hcLinker,
  405. NewItem(menu_options_debugger,'', kbNoKey, cmDebugger, hcDebugger,
  406. {$ifdef SUPPORT_REMOTE}
  407. NewItem(menu_options_remote,'', kbNoKey, cmRemoteDialog, hcRemoteDialog,
  408. {$endif SUPPORT_REMOTE}
  409. NewItem(menu_options_directories,'', kbNoKey, cmDirectories, hcDirectories,
  410. NewItem(menu_options_browser,'',kbNoKey, cmBrowser, hcBrowser,
  411. NewItem(menu_options_tools,'', kbNoKey, cmTools, hcTools,
  412. NewLine(
  413. NewSubMenu(menu_options_env, hcEnvironmentMenu, NewMenu(
  414. NewItem(menu_options_env_preferences,'', kbNoKey, cmPreferences, hcPreferences,
  415. NewItem(menu_options_env_editor,'', kbNoKey, cmEditor, hcEditor,
  416. NewItem(menu_options_env_codecomplete,'', kbNoKey, cmCodeCompleteOptions, hcCodeCompleteOptions,
  417. NewItem(menu_options_env_codetemplates,'', kbNoKey, cmCodeTemplateOptions, hcCodeTemplateOptions,
  418. NewItem(menu_options_env_desktop,'', kbNoKey, cmDesktopOptions, hcDesktopOptions,
  419. NewItem(menu_options_env_keybmouse,'', kbNoKey, cmMouse, hcMouse,
  420. { NewItem(menu_options_env_startup,'', kbNoKey, cmStartup, hcStartup,
  421. NewItem(menu_options_env_colors,'', kbNoKey, cmColors, hcColors,}
  422. {$ifdef Unix}
  423. NewItem(menu_options_learn_keys,'', kbNoKey, cmKeys, hcKeys,
  424. {$endif Unix}
  425. nil
  426. {$ifdef Unix}
  427. )
  428. {$endif Unix}
  429. {))}))))))),
  430. NewLine(
  431. NewItem(menu_options_open,'', kbNoKey, cmOpenINI, hcOpenINI,
  432. NewItem(menu_options_save,'', kbNoKey, cmSaveINI, hcSaveINI,
  433. NewItem(menu_options_saveas,'', kbNoKey, cmSaveAsINI, hcSaveAsINI,
  434. nil
  435. {$ifdef SUPPORT_REMOTE}
  436. )
  437. {$endif SUPPORT_REMOTE}
  438. ))))))))))))))),
  439. NewSubMenu(menu_window, hcWindowMenu, NewMenu(
  440. NewItem(menu_window_tile,'', kbNoKey, cmTile, hcTile,
  441. NewItem(menu_window_cascade,'', kbNoKey, cmCascade, hcCascade,
  442. NewItem(menu_window_closeall,'', kbNoKey, cmCloseAll, hcCloseAll,
  443. NewLine(
  444. NewItem(menu_window_resize,menu_key_window_resize, kbCtrlF5, cmResize, hcResize,
  445. NewItem(menu_window_zoom,menu_key_window_zoom, kbF5, cmZoom, hcZoom,
  446. NewItem(menu_window_next,menu_key_window_next, kbF6, cmNext, hcNext,
  447. NewItem(menu_window_previous,menu_key_window_previous, kbShiftF6, cmPrev, hcPrev,
  448. NewItem(menu_window_hide,menu_key_window_hide, kbCtrlF6, cmHide, hcHide,
  449. NewItem(menu_window_close,menu_key_window_close, kbAltF3, cmClose, hcClose,
  450. NewLine(
  451. NewItem(menu_window_list,menu_key_window_list, kbAlt0, cmWindowList, hcWindowList,
  452. NewItem(menu_window_update,'', kbNoKey, cmUpdate, hcUpdate,
  453. nil)))))))))))))),
  454. NewSubMenu(menu_help, hcHelpMenu, NewMenu(
  455. NewItem(menu_help_contents,'', kbNoKey, cmHelpContents, hcHelpContents,
  456. NewItem(menu_help_index,menu_key_help_helpindex, kbShiftF1, cmHelpIndex, hcHelpIndex,
  457. NewItem(menu_help_topicsearch,menu_key_help_topicsearch, kbCtrlF1, cmHelpTopicSearch, hcHelpTopicSearch,
  458. NewItem(menu_help_prevtopic,menu_key_help_prevtopic, kbAltF1, cmHelpPrevTopic, hcHelpPrevTopic,
  459. NewItem(menu_help_using,'',kbNoKey, cmHelpUsingHelp, hcHelpUsingHelp,
  460. NewItem(menu_help_files,'',kbNoKey, cmHelpFiles, hcHelpFiles,
  461. NewLine(
  462. NewItem(menu_help_about,'',kbNoKey, cmAbout, hcAbout,
  463. nil))))))))),
  464. nil)))))))))))));
  465. end;
  466. procedure TIDEApp.InitMenuBar;
  467. begin
  468. LoadMenuBar;
  469. DisableCommands(EditorCmds+SourceCmds+CompileCmds);
  470. // Update; Desktop is still nil at that point ...
  471. end;
  472. procedure Tideapp.reload_menubar;
  473. begin
  474. delete(menubar);
  475. dispose(menubar,done);
  476. case EditKeys of
  477. ekm_microsoft:
  478. begin
  479. menu_key_edit_cut:=menu_key_edit_cut_microsoft;
  480. menu_key_edit_copy:=menu_key_edit_copy_microsoft;
  481. menu_key_edit_paste:=menu_key_edit_paste_microsoft;
  482. menu_key_hlplocal_copy:=menu_key_hlplocal_copy_microsoft;
  483. cut_key:=kbCtrlX;
  484. copy_key:=kbCtrlC;
  485. paste_key:=kbCtrlV;
  486. end;
  487. ekm_borland:
  488. begin
  489. menu_key_edit_cut:=menu_key_edit_cut_borland;
  490. menu_key_edit_copy:=menu_key_edit_copy_borland;
  491. menu_key_edit_paste:=menu_key_edit_paste_borland;
  492. menu_key_hlplocal_copy:=menu_key_hlplocal_copy_borland;
  493. cut_key:=kbShiftDel;
  494. copy_key:=kbCtrlIns;
  495. paste_key:=kbShiftIns;
  496. end;
  497. end;
  498. loadmenubar;
  499. insert(menubar);
  500. end;
  501. procedure TIDEApp.InitStatusLine;
  502. var
  503. R: TRect;
  504. begin
  505. GetExtent(R);
  506. R.A.Y := R.B.Y - 1;
  507. StatusLine:=New(PIDEStatusLine, Init(R,
  508. NewStatusDef(hcDragging, hcDragging,
  509. NewStatusKey(status_help, kbF1, cmHelp,
  510. StdStatusKeys(
  511. NewStatusKey('~Cursor~ Move', kbNoKey, 65535,
  512. NewStatusKey('~Shift+Cursor~ Size', kbNoKey, 65535,
  513. NewStatusKey('~'#17'ÄÙ~ Done', kbNoKey, 65535, {#17 = left arrow}
  514. NewStatusKey('~Esc~ Cancel', kbNoKey, 65535,
  515. nil)))))),
  516. NewStatusDef(hcStackWindow, hcStackWindow,
  517. NewStatusKey(status_help, kbF1, cmHelp,
  518. NewStatusKey(status_disassemble, kbAltI, cmDisassemble,
  519. StdStatusKeys(
  520. nil))),
  521. NewStatusDef(hcFirstCommand, hcLastNormalCommand,
  522. NewStatusKey(status_help, kbF1, cmHelp,
  523. StdStatusKeys(
  524. nil)),
  525. NewStatusDef(hcFirstNoAltXCommand, hcLastCommand,
  526. NewStatusKey(status_help, kbF1, cmHelp,
  527. NewStatusKey('', kbF10, cmMenu,
  528. NewStatusKey('', kbAltF3, cmClose,
  529. NewStatusKey('', kbF5, cmZoom,
  530. NewStatusKey('', kbCtrlF5, cmResize,
  531. NewStatusKey('', kbF6, cmNext,
  532. NewStatusKey('', kbShiftF6, cmPrev,
  533. nil))))))),
  534. NewStatusDef(hcHelpWindow, hcHelpWindow,
  535. NewStatusKey(status_help_on_help, kbF1, cmHelpUsingHelp,
  536. NewStatusKey(status_help_previoustopic, kbAltF1, cmHelpPrevTopic,
  537. NewStatusKey(status_help_index, kbShiftF1, cmHelpIndex,
  538. NewStatusKey(status_help_close, kbEsc, cmClose,
  539. StdStatusKeys(
  540. nil))))),
  541. NewStatusDef(hcSourceWindow, hcSourceWindow,
  542. NewStatusKey(status_help, kbF1, cmHelp,
  543. NewStatusKey(status_save, kbF2, cmSave,
  544. NewStatusKey(status_open, kbF3, cmOpen,
  545. NewStatusKey(status_compile, kbAltF9, cmCompile,
  546. NewStatusKey(status_make, kbF9, cmMake,
  547. NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
  548. StdStatusKeys
  549. (
  550. nil))))))),
  551. NewStatusDef(hcASCIITableWindow, hcASCIITableWindow,
  552. NewStatusKey(status_help, kbF1, cmHelp,
  553. NewStatusKey(status_transferchar, kbCtrlEnter, cmTransfer,
  554. StdStatusKeys(
  555. nil))),
  556. NewStatusDef(hcMessagesWindow, hcMessagesWindow,
  557. NewStatusKey(status_help, kbF1, cmHelp,
  558. NewStatusKey(status_msggotosource, kbEnter, cmMsgGotoSource,
  559. NewStatusKey(status_msgtracksource, kbNoKey, cmMsgTrackSource,
  560. NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
  561. NewStatusKey('', kbEsc, cmClose,
  562. StdStatusKeys(
  563. nil)))))),
  564. NewStatusDef(hcCalcWindow, hcCalcWindow,
  565. NewStatusKey(status_help, kbF1, cmHelp,
  566. NewStatusKey(status_close, kbEsc, cmClose,
  567. NewStatusKey(status_calculatorpaste, kbCtrlEnter, cmCalculatorPaste,
  568. StdStatusKeys(
  569. nil)))),
  570. NewStatusDef(0, $FFFF,
  571. NewStatusKey(status_help, kbF1, cmHelp,
  572. NewStatusKey(status_open, kbF3, cmOpen,
  573. NewStatusKey(status_compile, kbAltF9, cmCompile,
  574. NewStatusKey(status_make, kbF9, cmMake,
  575. NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
  576. StdStatusKeys(
  577. nil)))))),
  578. nil))))))))))));
  579. end;
  580. procedure TIDEApp.Idle;
  581. begin
  582. inherited Idle;
  583. Message(Application,evIdle,0,nil);
  584. end;
  585. procedure TIDEApp.GetEvent(var Event: TEvent);
  586. var P: PView;
  587. begin
  588. { first of all dispatch queued targeted events }
  589. while GetTargetedEvent(P,Event) do
  590. P^.HandleEvent(Event);
  591. { Handle System events directly }
  592. Drivers.GetSystemEvent(Event); { Load system event }
  593. If (Event.What <> evNothing) Then
  594. HandleEvent(Event);
  595. inherited GetEvent(Event);
  596. {$ifdef DEBUG}
  597. if (Event.What=evKeyDown) and (Event.KeyCode=kbAltF11) then
  598. begin
  599. {$ifdef HasSignal}
  600. Generate_SIGSEGV;
  601. {$else}
  602. Halt(1);
  603. {$endif}
  604. end;
  605. if (Event.What=evKeyDown) and (Event.KeyCode=kbCtrlF11) then
  606. begin
  607. RunError(250);
  608. end;
  609. {$endif DEBUG}
  610. if (Event.What=evKeyDown) and (Event.KeyCode=kbAltF12) then
  611. begin
  612. CreateAnsiFile;
  613. ClearEvent(Event);
  614. end;
  615. if Event.What<>evNothing then
  616. LastEvent:=GetDosTicks
  617. else
  618. begin
  619. if abs(GetDosTicks-LastEvent)>SleepTimeOut then
  620. GiveUpTimeSlice;
  621. end;
  622. end;
  623. procedure TIDEApp.HandleEvent(var Event: TEvent);
  624. var DontClear: boolean;
  625. TempS: string;
  626. ForceDlg: boolean;
  627. W : PSourceWindow;
  628. DS : DirStr;
  629. NS : NameStr;
  630. ES : ExtStr;
  631. {$ifdef HasSignal}
  632. CtrlCCatched : boolean;
  633. {$endif HasSignal}
  634. begin
  635. {$ifdef HasSignal}
  636. if (Event.What=evKeyDown) and (Event.keyCode=kbCtrlC) and
  637. (CtrlCPressed) then
  638. begin
  639. CtrlCCatched:=true;
  640. {$ifdef DEBUG}
  641. Writeln(stderr,'One Ctrl-C caught');
  642. {$endif DEBUG}
  643. end
  644. else
  645. CtrlCCatched:=false;
  646. {$endif HasSignal}
  647. case Event.What of
  648. evKeyDown :
  649. begin
  650. DontClear:=true;
  651. { just for debugging purposes }
  652. end;
  653. evCommand :
  654. begin
  655. DontClear:=false;
  656. case Event.Command of
  657. cmUpdate : Message(Application,evBroadcast,cmUpdate,nil);
  658. { -- File menu -- }
  659. cmNew : NewEditor;
  660. cmNewFromTemplate: NewFromTemplate;
  661. cmOpen : begin
  662. ForceDlg:=false;
  663. if (OpenFileName<>'') and
  664. ((DirOf(OpenFileName)='') or (Pos(ListSeparator,OpenFileName)<>0)) then
  665. begin
  666. TempS:=LocateSourceFile(OpenFileName,false);
  667. if TempS='' then
  668. ForceDlg:=true
  669. else
  670. OpenFileName:=TempS;
  671. end;
  672. if ForceDlg then
  673. OpenSearch(OpenFileName)
  674. else
  675. begin
  676. W:=LastSourceEditor;
  677. if assigned(W) then
  678. FSplit(W^.Editor^.FileName,DS,NS,ES)
  679. else
  680. DS:='';
  681. Open(OpenFileName,DS);
  682. end;
  683. OpenFileName:='';
  684. end;
  685. cmPrint : Print;
  686. cmPrinterSetup : PrinterSetup;
  687. cmSaveAll : SaveAll;
  688. cmChangeDir : ChangeDir;
  689. cmDOSShell : DOSShell;
  690. cmRecentFileBase..
  691. cmRecentFileBase+10
  692. : OpenRecentFile(Event.Command-cmRecentFileBase);
  693. { -- Edit menu -- }
  694. cmShowClipboard : ShowClipboard;
  695. { -- Search menu -- }
  696. cmFindProcedure : FindProcedure;
  697. cmObjects : Objects;
  698. cmModules : Modules;
  699. cmGlobals : Globals;
  700. cmSymbol : SearchSymbol;
  701. { -- Run menu -- }
  702. cmRunDir : RunDir;
  703. cmParameters : Parameters;
  704. cmStepOver : DoStepOver;
  705. cmTraceInto : DoTraceInto;
  706. cmRun : DoRun;
  707. cmResetDebugger : DoResetDebugger;
  708. cmContToCursor : DoContToCursor;
  709. cmUntilReturn : DoContUntilReturn;
  710. { -- Compile menu -- }
  711. cmCompile : DoCompile(cCompile);
  712. cmBuild : DoCompile(cBuild);
  713. cmMake : DoCompile(cMake);
  714. cmTarget : Target;
  715. cmPrimaryFile : DoPrimaryFile;
  716. cmClearPrimary : DoClearPrimary;
  717. cmCompilerMessages : DoCompilerMessages;
  718. { -- Debug menu -- }
  719. cmUserScreen : DoUserScreen;
  720. cmToggleBreakpoint : DoToggleBreak;
  721. cmStack : DoShowCallStack;
  722. cmDisassemble : DoShowDisassembly;
  723. cmBreakpointList : DoShowBreakpointList;
  724. cmWatches : DoShowWatches;
  725. cmAddWatch : DoAddWatch;
  726. cmOpenGDBWindow : DoOpenGDBWindow;
  727. cmRegisters : DoShowRegisters;
  728. cmFPURegisters : DoShowFPU;
  729. cmVectorRegisters : DoShowVector;
  730. { -- Options menu -- }
  731. cmSwitchesMode : SetSwitchesMode;
  732. cmCompiler : DoCompilerSwitch;
  733. cmMemorySizes : MemorySizes;
  734. cmLinker : DoLinkerSwitch;
  735. cmDebugger : DoDebuggerSwitch;
  736. {$ifdef SUPPORT_REMOTE}
  737. cmRemoteDialog : DoRemote;
  738. cmTransferRemote: TransferRemote;
  739. {$endif SUPPORT_REMOTE}
  740. cmDirectories : Directories;
  741. cmTools : Tools;
  742. cmPreferences : Preferences;
  743. cmEditor : EditorOptions(nil);
  744. cmEditorOptions : EditorOptions(Event.InfoPtr);
  745. cmCodeTemplateOptions: CodeTemplates;
  746. cmCodeCompleteOptions: CodeComplete;
  747. cmBrowser : BrowserOptions(nil);
  748. cmBrowserOptions : BrowserOptions(Event.InfoPtr);
  749. cmMouse : Mouse;
  750. cmStartup : StartUp;
  751. cmDesktopOptions: DesktopOptions;
  752. cmColors : Colors;
  753. {$ifdef Unix}
  754. cmKeys : LearnKeysDialog;
  755. {$endif Unix}
  756. cmOpenINI : OpenINI;
  757. cmSaveINI : SaveINI;
  758. cmSaveAsINI : SaveAsINI;
  759. { -- Tools menu -- }
  760. cmToolsMessages : Messages;
  761. cmCalculator : Calculator;
  762. cmAsciiTable : DoAsciiTable;
  763. cmGrep : DoGrep;
  764. cmToolsBase+1..
  765. cmToolsBase+MaxToolCount
  766. : ExecuteTool(Event.Command-cmToolsBase);
  767. { -- Window menu -- }
  768. cmCloseAll : CloseAll;
  769. cmWindowList : WindowList;
  770. cmUserScreenWindow: DoUserScreenWindow;
  771. { -- Help menu -- }
  772. cmHelp,
  773. cmHelpContents : HelpContents;
  774. cmHelpIndex : HelpHelpIndex;
  775. { cmHelpTopicSearch: HelpTopicSearch;}
  776. cmHelpPrevTopic : HelpPrevTopic;
  777. cmHelpUsingHelp : HelpUsingHelp;
  778. cmHelpFiles : HelpFiles;
  779. cmAbout : About;
  780. cmShowReadme : ShowReadme;
  781. cmResizeApp : ResizeApplication(Event.Id, Event.InfoWord);
  782. cmQuitApp : Message(@Self, evCommand, cmQuit, nil);
  783. else DontClear:=true;
  784. end;
  785. if DontClear=false then ClearEvent(Event);
  786. end;
  787. evBroadcast :
  788. case Event.Command of
  789. cmSaveCancelled :
  790. SaveCancelled:=true;
  791. cmUpdateTools :
  792. UpdateTools;
  793. cmCommandSetChanged :
  794. UpdateMenu(MenuBar^.Menu);
  795. cmUpdate :
  796. Update;
  797. cmSourceWndClosing :
  798. begin
  799. with PSourceWindow(Event.InfoPtr)^ do
  800. if Editor^.FileName<>'' then
  801. AddRecentFile(Editor^.FileName,Editor^.CurPos.X,Editor^.CurPos.Y);
  802. {$ifndef NODEBUG}
  803. if assigned(Debugger) and (PView(Event.InfoPtr)=Debugger^.LastSource) then
  804. Debugger^.LastSource:=nil;
  805. {$endif}
  806. end;
  807. end;
  808. end;
  809. inherited HandleEvent(Event);
  810. {$ifdef HasSignal}
  811. { Reset flag if CrtlC was handled }
  812. if CtrlCCatched and (Event.What=evNothing) then
  813. begin
  814. CtrlCPressed:=false;
  815. {$ifdef DEBUG}
  816. Writeln(stderr,'One CtrlC handled');
  817. {$endif DEBUG}
  818. end;
  819. {$endif HasSignal}
  820. end;
  821. procedure TIDEApp.GetTileRect(var R: TRect);
  822. begin
  823. Desktop^.GetExtent(R);
  824. { Leave the compiler messages window in the bottom }
  825. if assigned(CompilerMessageWindow) and (CompilerMessageWindow^.GetState(sfVisible)) then
  826. R.B.Y:=Min(CompilerMessageWindow^.Origin.Y,R.B.Y);
  827. { Leave the messages window in the bottom }
  828. if assigned(MessagesWindow) and (MessagesWindow^.GetState(sfVisible)) then
  829. R.B.Y:=Min(MessagesWindow^.Origin.Y,R.B.Y);
  830. {$ifndef NODEBUG}
  831. { Leave the watch window in the bottom }
  832. if assigned(WatchesWindow) and (WatchesWindow^.GetState(sfVisible)) then
  833. R.B.Y:=Min(WatchesWindow^.Origin.Y,R.B.Y);
  834. {$endif NODEBUG}
  835. end;
  836. {****************************************************************************
  837. Switch Screens
  838. ****************************************************************************}
  839. procedure TIDEApp.ShowUserScreen;
  840. begin
  841. if Assigned(UserScreen) then
  842. UserScreen^.SaveIDEScreen;
  843. DoneSysError;
  844. DoneEvents;
  845. { DoneKeyboard should be called last to
  846. restore the keyboard correctly PM }
  847. {$ifndef go32v2}
  848. donevideo;
  849. {$endif ndef go32v2}
  850. DoneKeyboard;
  851. If UseMouse then
  852. DoneMouse
  853. else
  854. ButtonCount:=0;
  855. { DoneDosMem;}
  856. if Assigned(UserScreen) then
  857. UserScreen^.SwitchToConsoleScreen;
  858. end;
  859. procedure TIDEApp.ShowIDEScreen;
  860. begin
  861. if Assigned(UserScreen) then
  862. UserScreen^.SaveConsoleScreen;
  863. { InitDosMem;}
  864. InitKeyboard;
  865. If UseMouse then
  866. InitMouse
  867. else
  868. ButtonCount:=0;
  869. {$ifndef go32v2}
  870. initvideo;
  871. {$endif ndef go32v2}
  872. {$ifdef Windows}
  873. { write the empty screen to dummy console handle }
  874. UpdateScreen(true);
  875. {$endif ndef Windows}
  876. InitEvents;
  877. InitSysError;
  878. CurDirChanged;
  879. {$ifndef Windows}
  880. Message(Application,evBroadcast,cmUpdate,nil);
  881. {$endif Windows}
  882. {$ifdef Windows}
  883. // WindowsShowMouse;
  884. {$endif Windows}
  885. if Assigned(UserScreen) then
  886. UserScreen^.SwitchBackToIDEScreen;
  887. {$ifdef Windows}
  888. { This message was sent when the VideoBuffer was smaller
  889. than was the IdeApp thought => writes to random memory and random crashes... PM }
  890. Message(Application,evBroadcast,cmUpdate,nil);
  891. {$endif Windows}
  892. {$ifdef Unix}
  893. SetKnownKeys;
  894. {$endif Unix}
  895. {$ifndef Windows}
  896. {$ifndef go32v2}
  897. UpdateScreen(true);
  898. {$endif go32v2}
  899. {$endif Windows}
  900. end;
  901. function TIDEApp.AutoSave: boolean;
  902. var IOK,SOK,DOK: boolean;
  903. begin
  904. IOK:=true; SOK:=true; DOK:=true;
  905. if (AutoSaveOptions and asEnvironment)<>0 then
  906. begin
  907. IOK:=WriteINIFile(false);
  908. if IOK=false then
  909. ErrorBox(error_saving_cfg_file,nil);
  910. end;
  911. if (AutoSaveOptions and asEditorFiles)<>0 then { was a typo here ("=0") - Gabor }
  912. SOK:=SaveAll;
  913. if (AutoSaveOptions and asDesktop)<>0 then
  914. begin
  915. { destory all help & browser windows - we don't want to store them }
  916. { UserScreenWindow is also not registered PM }
  917. DoCloseUserScreenWindow;
  918. {$IFNDEF NODEBUG}
  919. DoneDisassemblyWindow;
  920. {$ENDIF}
  921. CloseHelpWindows;
  922. CloseAllBrowsers;
  923. DOK:=SaveDesktop;
  924. if DOK=false then
  925. ErrorBox(error_saving_dsk_file,nil);
  926. end;
  927. AutoSave:=IOK and SOK and DOK;
  928. end;
  929. function TIDEApp.DoExecute(ProgramPath, Params, InFile,OutFile,ErrFile: string; ExecType: TExecType): boolean;
  930. var CanRun: boolean;
  931. ConsoleMode : TConsoleMode;
  932. {$ifndef Unix}
  933. PosExe: sw_integer;
  934. {$endif Unix}
  935. begin
  936. SaveCancelled:=false;
  937. CanRun:=AutoSave;
  938. if (CanRun=false) and (SaveCancelled=false) then
  939. CanRun:=true; { do not care about .DSK or .INI saving problems - just like TP }
  940. if CanRun then
  941. begin
  942. if UserScreen=nil then
  943. begin
  944. ErrorBox(error_user_screen_not_avail,nil);
  945. Exit;
  946. end;
  947. if ExecType<>exNoSwap then
  948. ShowUserScreen;
  949. SaveConsoleMode(ConsoleMode);
  950. if ExecType=exDosShell then
  951. WriteShellMsg
  952. else if ExecType<>exNoSwap then
  953. Writeln('Running "'+ProgramPath+' '+Params+'"');
  954. { DO NOT use COMSPEC for exe files as the
  955. ExitCode is lost in those cases PM }
  956. {$ifndef Unix}
  957. posexe:=Pos('.EXE',UpCaseStr(ProgramPath));
  958. { if programpath was three char long => bug }
  959. if (posexe>0) and (posexe=Length(ProgramPath)-3) then
  960. begin
  961. {$endif Unix}
  962. if (InFile='') and (OutFile='') and (ErrFile='') then
  963. DosExecute(ProgramPath,Params)
  964. else
  965. begin
  966. if ErrFile='' then
  967. ErrFile:='stderr';
  968. ExecuteRedir(ProgramPath,Params,InFile,OutFile,ErrFile);
  969. end;
  970. {$ifndef Unix}
  971. end
  972. else if (InFile='') and (OutFile='') and (ErrFile='') then
  973. DosExecute(GetEnv('COMSPEC'),'/C '+ProgramPath+' '+Params)
  974. else
  975. begin
  976. if ErrFile='' then
  977. ErrFile:='stderr';
  978. ExecuteRedir(GetEnv('COMSPEC'),'/C '+ProgramPath+' '+Params,
  979. InFile,OutFile,ErrFile);
  980. end;
  981. {$endif Unix}
  982. {$ifdef Unix}
  983. if (DebuggeeTTY='') and (OutFile='') and (ExecType<>exDosShell) then
  984. begin
  985. Write(' Press any key to return to IDE');
  986. InitKeyBoard;
  987. Keyboard.GetKeyEvent;
  988. while (Keyboard.PollKeyEvent<>0) do
  989. Keyboard.GetKeyEvent;
  990. DoneKeyboard;
  991. end;
  992. {$endif}
  993. RestoreConsoleMode(ConsoleMode);
  994. if ExecType<>exNoSwap then
  995. ShowIDEScreen;
  996. end;
  997. DoExecute:=CanRun;
  998. end;
  999. procedure TIDEApp.Update;
  1000. begin
  1001. SetCmdState([cmSaveAll],IsThereAnyEditor);
  1002. SetCmdState([cmCloseAll,cmWindowList],IsThereAnyWindow);
  1003. SetCmdState([cmTile,cmCascade],IsThereAnyVisibleWindow);
  1004. SetCmdState([cmFindProcedure,cmObjects,cmModules,cmGlobals,cmSymbol],IsSymbolInfoAvailable);
  1005. {$ifndef NODEBUG}
  1006. SetCmdState([cmResetDebugger,cmUntilReturn],assigned(debugger) and debugger^.debuggee_started);
  1007. {$endif}
  1008. SetCmdState([cmToolsMsgNext,cmToolsMsgPrev],MessagesWindow<>nil);
  1009. UpdateTools;
  1010. UpdateRecentFileList;
  1011. UpdatePrimaryFile;
  1012. UpdateINIFile;
  1013. Message(Application,evBroadcast,cmCommandSetChanged,nil);
  1014. application^.redraw;
  1015. end;
  1016. procedure TIDEApp.SourceWindowClosed;
  1017. begin
  1018. if not IsClosing then
  1019. Update;
  1020. end;
  1021. procedure TIDEApp.CurDirChanged;
  1022. begin
  1023. Message(Application,evBroadcast,cmUpdateTitle,nil);
  1024. UpdatePrimaryFile;
  1025. UpdateINIFile;
  1026. UpdateMenu(MenuBar^.Menu);
  1027. end;
  1028. procedure TIDEApp.UpdatePrimaryFile;
  1029. begin
  1030. SetMenuItemParam(SearchMenuItem(MenuBar^.Menu,cmPrimaryFile),SmartPath(PrimaryFile));
  1031. SetCmdState([cmClearPrimary],PrimaryFile<>'');
  1032. if PrimaryFile<>'' then
  1033. SetCmdState(CompileCmds,true);
  1034. UpdateMenu(MenuBar^.Menu);
  1035. end;
  1036. procedure TIDEApp.UpdateINIFile;
  1037. begin
  1038. SetMenuItemParam(SearchMenuItem(MenuBar^.Menu,cmSaveINI),SmartPath(IniFileName));
  1039. end;
  1040. procedure TIDEApp.UpdateRecentFileList;
  1041. var P: PMenuItem;
  1042. {ID,}I: word;
  1043. FileMenu: PMenuItem;
  1044. begin
  1045. { ID:=cmRecentFileBase;}
  1046. FileMenu:=SearchSubMenu(MenuBar^.Menu,menuFile);
  1047. repeat
  1048. { Inc(ID);
  1049. P:=SearchMenuItem(FileMenu^.SubMenu,ID);
  1050. if FileMenu^.SubMenu^.Default=P then
  1051. FileMenu^.SubMenu^.Default:=FileMenu^.SubMenu^.Items;
  1052. if P<>nil then RemoveMenuItem(FileMenu^.SubMenu,P);}
  1053. P:=GetMenuItemBefore(FileMenu^.SubMenu,nil);
  1054. if (P<>nil) then
  1055. begin
  1056. if (cmRecentFileBase<P^.Command) and (P^.Command<=cmRecentFileBase+MaxRecentFileCount) then
  1057. begin
  1058. RemoveMenuItem(FileMenu^.SubMenu,P);
  1059. if FileMenu^.SubMenu^.Default=P then
  1060. FileMenu^.SubMenu^.Default:=FileMenu^.SubMenu^.Items;
  1061. end
  1062. else
  1063. P:=nil;
  1064. end;
  1065. until P=nil;
  1066. P:=GetMenuItemBefore(FileMenu^.SubMenu,nil);
  1067. if (P<>nil) and IsSeparator(P) then
  1068. RemoveMenuItem(FileMenu^.SubMenu,P);
  1069. if RecentFileCount>0 then
  1070. AppendMenuItem(FileMenu^.SubMenu,NewLine(nil));
  1071. for I:=1 to RecentFileCount do
  1072. begin
  1073. P:=NewItem('~'+IntToStr(I)+'~ '+ShrinkPath(SmartPath(RecentFiles[I].FileName),27),' ',
  1074. kbNoKey,cmRecentFileBase+I,hcRecentFileBase+I,nil);
  1075. AppendMenuItem(FileMenu^.SubMenu,P);
  1076. end;
  1077. end;
  1078. procedure TIDEApp.UpdateTools;
  1079. var P: PMenuItem;
  1080. { ID,}I: word;
  1081. ToolsMenu: PMenuItem;
  1082. S1,S2,S3: string;
  1083. W: word;
  1084. begin
  1085. { ID:=cmToolsBase;}
  1086. ToolsMenu:=SearchSubMenu(MenuBar^.Menu,menuTools);
  1087. repeat
  1088. P:=GetMenuItemBefore(ToolsMenu^.SubMenu,nil);
  1089. if (P<>nil) then
  1090. begin
  1091. if (cmToolsBase<P^.Command) and (P^.Command<=cmToolsBase+MaxToolCount) then
  1092. begin
  1093. RemoveMenuItem(ToolsMenu^.SubMenu,P);
  1094. if ToolsMenu^.SubMenu^.Default=P then
  1095. ToolsMenu^.SubMenu^.Default:=ToolsMenu^.SubMenu^.Items;
  1096. end
  1097. else
  1098. P:=nil;
  1099. end;
  1100. until P=nil;
  1101. P:=GetMenuItemBefore(ToolsMenu^.SubMenu,nil);
  1102. if (P<>nil) and IsSeparator(P) then
  1103. RemoveMenuItem(ToolsMenu^.SubMenu,P);
  1104. if GetToolCount>0 then
  1105. AppendMenuItem(ToolsMenu^.SubMenu,NewLine(nil));
  1106. for I:=1 to GetToolCount do
  1107. begin
  1108. GetToolParams(I-1,S1,S2,S3,W);
  1109. P:=NewItem(S1,KillTilde(GetHotKeyName(W)),W,cmToolsBase+I,hcToolsBase+I,nil);
  1110. AppendMenuItem(ToolsMenu^.SubMenu,P);
  1111. end;
  1112. end;
  1113. procedure TIDEApp.DosShell;
  1114. var
  1115. s : string;
  1116. begin
  1117. {$ifdef Unix}
  1118. s:=GetEnv('SHELL');
  1119. if s='' then
  1120. if ExistsFile('/bin/sh') then
  1121. s:='/bin/sh';
  1122. {$else}
  1123. s:=GetEnv('COMSPEC');
  1124. if s='' then
  1125. if ExistsFile('c:\command.com') then
  1126. s:='c:\command.com'
  1127. else
  1128. begin
  1129. s:='command.com';
  1130. if Not LocateExeFile(s) then
  1131. s:='';
  1132. end;
  1133. {$endif}
  1134. if s='' then
  1135. ErrorBox(msg_errorexecutingshell,nil)
  1136. else
  1137. DoExecute(s, '', '', '', '', exDosShell);
  1138. { In case we have something that the compiler touched }
  1139. AskToReloadAllModifiedFiles;
  1140. end;
  1141. procedure TIDEApp.ShowReadme;
  1142. var R,R2: TRect;
  1143. D: PCenterDialog;
  1144. M: PFPMemo;
  1145. VSB: PScrollBar;
  1146. S: PFastBufStream;
  1147. begin
  1148. New(S, Init(ReadmeName, stOpenRead, 4096));
  1149. if S^.Status=stOK then
  1150. begin
  1151. R.Assign(0,0,63,18);
  1152. New(D, Init(R, 'Free Pascal IDE'));
  1153. with D^ do
  1154. begin
  1155. GetExtent(R);
  1156. R.Grow(-2,-2); Inc(R.B.Y);
  1157. R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
  1158. New(VSB, Init(R2)); VSB^.GrowMode:=0; Insert(VSB);
  1159. New(M, Init(R,nil,VSB,nil));
  1160. M^.LoadFromStream(S);
  1161. M^.ReadOnly:=true;
  1162. Insert(M);
  1163. end;
  1164. InsertOK(D);
  1165. ExecuteDialog(D,nil);
  1166. end;
  1167. Dispose(S, Done);
  1168. end;
  1169. {$I FPMFILE.INC}
  1170. {$I FPMEDIT.INC}
  1171. {$I FPMSRCH.INC}
  1172. {$I FPMRUN.INC}
  1173. {$I FPMCOMP.INC}
  1174. {$I FPMDEBUG.INC}
  1175. {$I FPMTOOLS.INC}
  1176. {$I FPMOPTS.INC}
  1177. {$I FPMWND.INC}
  1178. {$I FPMHELP.INC}
  1179. {$I fpmansi.inc}
  1180. procedure TIDEApp.AddRecentFile(AFileName: string; CurX, CurY: sw_integer);
  1181. begin
  1182. if SearchRecentFile(AFileName)<>-1 then Exit;
  1183. if RecentFileCount>0 then
  1184. Move(RecentFiles[1],RecentFiles[2],SizeOf(RecentFiles[1])*Min(RecentFileCount,High(RecentFiles)-1));
  1185. if RecentFileCount<High(RecentFiles) then Inc(RecentFileCount);
  1186. with RecentFiles[1] do
  1187. begin
  1188. FileName:=AFileName;
  1189. LastPos.X:=CurX; LastPos.Y:=CurY;
  1190. end;
  1191. UpdateRecentFileList;
  1192. end;
  1193. function TIDEApp.SearchRecentFile(AFileName: string): integer;
  1194. var Idx,I: integer;
  1195. begin
  1196. Idx:=-1;
  1197. for I:=1 to RecentFileCount do
  1198. if UpcaseStr(AFileName)=UpcaseStr(RecentFiles[I].FileName) then
  1199. begin Idx:=I; Break; end;
  1200. SearchRecentFile:=Idx;
  1201. end;
  1202. procedure TIDEApp.RemoveRecentFile(Index: integer);
  1203. begin
  1204. if Index<RecentFileCount then
  1205. Move(RecentFiles[Index+1],RecentFiles[Index],SizeOf(RecentFiles[1])*(RecentFileCount-Index));
  1206. Dec(RecentFileCount);
  1207. UpdateRecentFileList;
  1208. end;
  1209. function TIDEApp.GetPalette: PPalette;
  1210. begin
  1211. GetPalette:=@AppPalette;
  1212. end;
  1213. function TIDEApp.IsClosing: Boolean;
  1214. begin
  1215. IsClosing:=InsideDone;
  1216. end;
  1217. destructor TIDEApp.Done;
  1218. begin
  1219. InsideDone:=true;
  1220. IsRunning:=false;
  1221. inherited Done;
  1222. Desktop:=nil;
  1223. RemoveBrowsersCollection;
  1224. DoneHelpSystem;
  1225. end;
  1226. end.