123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314 |
- {
- $Id$
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998 by Berczi Gabor
- Main IDEApp object
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit fpide;
- interface
- {$i globdir.inc}
- uses
- Objects,Drivers,Views,App,Gadgets,MsgBox,
- {$ifdef EDITORS}Editors,{$else}WEditor,WCEdit,{$endif}
- Comphook,Browcol,
- WHTMLScn,
- FPViews,FPSymbol,fpstring;
- type
- TExecType = (exNormal,exNoSwap,exDosShell);
- TIDEApp = object(TApplication)
- IsRunning : boolean;
- constructor Init;
- procedure InitDesktop; virtual;
- procedure InitMenuBar; virtual;
- procedure InitStatusLine; virtual;
- procedure Open(FileName: string);
- function OpenSearch(FileName: string) : boolean;
- function AskSaveAll: boolean;
- function SaveAll: boolean;
- function AutoSave: boolean;
- procedure Idle; virtual;
- procedure Update;
- procedure UpdateMode;
- procedure UpdateRunMenu(DebuggeeRunning : boolean);
- procedure UpdateTarget;
- procedure GetEvent(var Event: TEvent); virtual;
- procedure HandleEvent(var Event: TEvent); virtual;
- procedure GetTileRect(var R: TRect); virtual;
- function GetPalette: PPalette; virtual;
- procedure DosShell; {virtual;}
- procedure ShowReadme;
- destructor Done; virtual;
- procedure ShowUserScreen;
- procedure ShowIDEScreen;
- function IsClosing : boolean;
- private
- procedure NewEditor;
- procedure NewFromTemplate;
- procedure OpenRecentFile(RecentIndex: integer);
- procedure ChangeDir;
- procedure ShowClipboard;
- procedure FindProcedure;
- procedure Objects;
- procedure Modules;
- procedure Globals;
- procedure SearchSymbol;
- procedure Parameters;
- procedure DoStepOver;
- procedure DoTraceInto;
- procedure DoRun;
- procedure DoResetDebugger;
- procedure DoContToCursor;
- procedure DoContUntilReturn;
- procedure Target;
- procedure DoCompilerMessages;
- procedure DoPrimaryFile;
- procedure DoClearPrimary;
- procedure DoUserScreenWindow;
- procedure DoCloseUserScreenWindow;
- procedure DoUserScreen;
- procedure DoOpenGDBWindow;
- procedure DoToggleBreak;
- procedure DoShowCallStack;
- procedure DoShowBreakpointList;
- procedure DoShowWatches;
- procedure DoAddWatch;
- procedure DoShowRegisters;
- procedure DoShowFPU;
- function AskRecompileIfModified:boolean;
- procedure DoInformation;
- procedure Messages;
- procedure Calculator;
- procedure DoAsciiTable;
- procedure ExecuteTool(Idx: integer);
- procedure SetSwitchesMode;
- procedure DoCompilerSwitch;
- procedure MemorySizes;
- procedure DoLinkerSwitch;
- procedure DoDebuggerSwitch;
- {$ifdef SUPPORT_REMOTE}
- procedure DoRemote;
- procedure TransferRemote;
- {$endif SUPPORT_REMOTE}
- procedure Directories;
- procedure Tools;
- procedure DoGrep;
- procedure Preferences;
- procedure EditorOptions(Editor: PEditor);
- procedure CodeComplete;
- procedure CodeTemplates;
- procedure BrowserOptions(Browser: PBrowserWindow);
- procedure DesktopOptions;
- procedure ResizeApplication(x, y : longint);
- procedure Mouse;
- procedure StartUp;
- procedure Colors;
- procedure OpenINI;
- procedure SaveINI;
- procedure SaveAsINI;
- procedure CloseAll;
- procedure WindowList;
- procedure HelpContents;
- procedure HelpHelpIndex;
- procedure HelpTopicSearch;
- procedure HelpPrevTopic;
- procedure HelpUsingHelp;
- procedure HelpFiles;
- procedure About;
- procedure CreateAnsiFile;
- public
- procedure SourceWindowClosed;
- function DoExecute(ProgramPath, Params, InFile, OutFile, ErrFile: string; ExecType: TExecType): boolean;
- private
- SaveCancelled: boolean;
- InsideDone : boolean;
- LastEvent: longint;
- procedure AddRecentFile(AFileName: string; CurX, CurY: sw_integer);
- function SearchRecentFile(AFileName: string): integer;
- procedure RemoveRecentFile(Index: integer);
- procedure CurDirChanged;
- procedure UpdatePrimaryFile;
- procedure UpdateINIFile;
- procedure UpdateRecentFileList;
- procedure UpdateTools;
- end;
- procedure PutEvent(TargetView: PView; E: TEvent);
- procedure PutCommand(TargetView: PView; What, Command: Word; InfoPtr: Pointer);
- var
- IDEApp: TIDEApp;
- implementation
- uses
- {$ifdef HasSignal}
- fpcatch,
- {$endif HasSignal}
- {$ifdef WinClipSupported}
- WinClip,
- {$endif WinClipSupported}
- {$ifdef Unix}
- fpKeys,
- {$endif Unix}
- FpDpAnsi,WConsts,
- Video,Mouse,Keyboard,
- Compiler,Version,
- {$ifdef FVISION}
- FVConsts,
- {$else}
- Commands,HelpCtx,
- {$endif}
- Dos,Memory,Menus,Dialogs,StdDlg,
- {$ifndef FVISION}
- ColorSel,
- {$endif FVISION}
- Systems,
- WUtils,WHlpView,WViews,WHTMLHlp,WHelp,WConsole,
- FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompil,FPHelp,
- FPTemplt,FPCalc,FPUsrScr,FPTools,
- {$ifndef NODEBUG}
- FPDebug,FPRegs,
- {$endif}
- FPRedir,
- FPDesk,FPCodCmp,FPCodTmp;
- type
- TTargetedEvent = record
- Target: PView;
- Event: TEvent;
- end;
- const
- TargetedEventHead : integer = 0;
- TargetedEventTail : integer = 0;
- var
- TargetedEvents : array[0..10] of TTargetedEvent;
- function IncTargetedEventPtr(I: integer): integer;
- begin
- Inc(I);
- if I>High(TargetedEvents) then I:=Low(TargetedEvents);
- IncTargetedEventPtr:=I;
- end;
- procedure PutEvent(TargetView: PView; E: TEvent);
- begin
- if IncTargetedEventPtr(TargetedEventHead)=TargetedEventTail then Exit;
- with TargetedEvents[TargetedEventHead] do
- begin
- Target:=TargetView;
- Event:=E;
- end;
- TargetedEventHead:=IncTargetedEventPtr(TargetedEventHead);
- end;
- procedure PutCommand(TargetView: PView; What, Command: Word; InfoPtr: Pointer);
- var E: TEvent;
- begin
- FillChar(E,Sizeof(E),0);
- E.What:=What;
- E.Command:=Command;
- E.InfoPtr:=InfoPtr;
- PutEvent(TargetView,E);
- end;
- function GetTargetedEvent(var P: PView; var E: TEvent): boolean;
- var OK: boolean;
- begin
- OK:=TargetedEventHead<>TargetedEventTail;
- if OK then
- begin
- with TargetedEvents[TargetedEventTail] do
- begin
- P:=Target;
- E:=Event;
- end;
- TargetedEventTail:=IncTargetedEventPtr(TargetedEventTail);
- end;
- GetTargetedEvent:=OK;
- end;
- function IDEUseSyntaxHighlight(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
- begin
- IDEUseSyntaxHighlight:=(Editor^.FileName='') or MatchesFileList(NameAndExtOf(Editor^.FileName),HighlightExts);
- end;
- function IDEUseTabsPattern(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
- begin
- { the commented code lead all new files
- to become with TAB use enabled which is wrong in my opinion PM }
- IDEUseTabsPattern:={(Editor^.FileName='') or }MatchesFileList(NameAndExtOf(Editor^.FileName),TabsPattern);
- end;
- constructor TIDEApp.Init;
- var R: TRect;
- begin
- {$ifndef EDITORS}
- {$ifdef TP}
- UseSyntaxHighlight:=IDEUseSyntaxHighlight;
- UseTabsPattern:=IDEUseTabsPattern;
- {$else TP}
- UseSyntaxHighlight:=@IDEUseSyntaxHighlight;
- UseTabsPattern:=@IDEUseTabsPattern;
- {$endif TP}
- {$endif}
- inherited Init;
- InitAdvMsgBox;
- InsideDone:=false;
- IsRunning:=true;
- MenuBar^.GetBounds(R); R.A.X:=R.B.X-8;
- New(ClockView, Init(R));
- ClockView^.GrowMode:=gfGrowLoX+gfGrowHiX;
- Application^.Insert(ClockView);
- New(ClipboardWindow, Init);
- Desktop^.Insert(ClipboardWindow);
- New(CalcWindow, Init); CalcWindow^.Hide;
- Desktop^.Insert(CalcWindow);
- New(CompilerMessageWindow, Init);
- CompilerMessageWindow^.Hide;
- Desktop^.Insert(CompilerMessageWindow);
- Message(@Self,evBroadcast,cmUpdate,nil);
- CurDirChanged;
- { heap viewer }
- GetExtent(R); Dec(R.B.X); R.A.X:=R.B.X-9; R.A.Y:=R.B.Y-1;
- New(HeapView, InitKb(R));
- if (StartupOptions and soHeapMonitor)=0 then HeapView^.Hide;
- Insert(HeapView);
- Drivers.ShowMouse;
- {$ifdef win32}
- // Win32ShowMouse;
- {$endif win32}
- end;
- procedure TIDEApp.InitDesktop;
- var
- R: TRect;
- begin
- GetExtent(R);
- Inc(R.A.Y);
- Dec(R.B.Y);
- Desktop:=New(PFPDesktop, Init(R));
- end;
- procedure TIDEApp.InitMenuBar;
- var R: TRect;
- WinPMI : PMenuItem;
- begin
- GetExtent(R); R.B.Y:=R.A.Y+1;
- WinPMI:=nil;
- {$ifdef WinClipSupported}
- if WinClipboardSupported then
- WinPMI:=NewLine(
- NewItem(menu_edit_copywin,'', kbNoKey, cmCopyWin, hcCopyWin,
- NewItem(menu_edit_pastewin,'', kbNoKey, cmPasteWin, hcPasteWin,
- nil)));
- {$endif WinClipSupported}
- MenuBar:=New(PAdvancedMenuBar, Init(R, NewMenu(
- NewSubMenu(menu_file,hcFileMenu, NewMenu(
- NewItem(menu_file_new,'',kbNoKey,cmNew,hcNew,
- NewItem(menu_file_template,'',kbNoKey,cmNewFromTemplate,hcNewFromTemplate,
- NewItem(menu_file_open,menu_key_file_open,kbF3,cmOpen,hcOpen,
- NewItem(menu_file_save,menu_key_file_save,kbF2,cmSave,hcSave,
- NewItem(menu_file_saveas,'',kbNoKey,cmSaveAs,hcSaveAs,
- NewItem(menu_file_saveall,'',kbNoKey,cmSaveAll,hcSaveAll,
- NewLine(
- NewItem(menu_file_changedir,'',kbNoKey,cmChangeDir,hcChangeDir,
- NewItem(menu_file_dosshell,'',kbNoKey,cmDOSShell,hcDOSShell,
- NewItem(menu_file_exit,menu_key_file_exit,kbNoKey,cmQuit,hcQuit,
- nil))))))))))),
- NewSubMenu(menu_edit,hcEditMenu, NewMenu(
- NewItem(menu_edit_undo,menu_key_edit_undo, kbAltBack, cmUndo, hcUndo,
- NewItem(menu_edit_redo,'', kbNoKey, cmRedo, hcRedo,
- {$ifdef DebugUndo}
- NewItem('~D~ump Undo','', kbNoKey, cmDumpUndo, hcUndo,
- NewItem('U~n~do All','', kbNoKey, cmUndoAll, hcUndo,
- NewItem('R~e~do All','', kbNoKey, cmRedoAll, hcRedo,
- {$endif DebugUndo}
- NewLine(
- NewItem(menu_edit_cut,menu_key_edit_cut, kbShiftDel, cmCut, hcCut,
- NewItem(menu_edit_copy,menu_key_edit_copy, kbCtrlIns, cmCopy, hcCut,
- NewItem(menu_edit_paste,menu_key_edit_paste, kbShiftIns, cmPaste, hcPaste,
- NewItem(menu_edit_clear,menu_key_edit_clear, kbCtrlDel, cmClear, hcClear,
- NewLine(
- NewItem(menu_edit_showclipboard,'', kbNoKey, cmShowClipboard, hcShowClipboard,
- WinPMI))))))
- {$ifdef DebugUndo}))){$endif DebugUndo}
- )))),
- NewSubMenu(menu_search,hcSearchMenu, NewMenu(
- NewItem(menu_search_find,'', kbNoKey, cmFind, hcFind,
- NewItem(menu_search_replace,'', kbNoKey, cmReplace, hcReplace,
- NewItem(menu_search_searchagain,'', kbNoKey, cmSearchAgain, hcSearchAgain,
- NewLine(
- NewItem(menu_search_jumpline,'', kbNoKey, cmJumpLine, hcGotoLine,
- NewItem(menu_search_findproc,'', kbNoKey, cmFindProcedure, hcFindProcedure,
- NewLine(
- NewItem(menu_search_objects,'', kbNoKey, cmObjects, hcObjects,
- NewItem(menu_search_modules,'', kbNoKey, cmModules, hcModules,
- NewItem(menu_search_globals,'', kbNoKey, cmGlobals, hcGlobals,
- NewLine(
- NewItem(menu_search_symbol,'', kbNoKey, cmSymbol, hcSymbol,
- nil))))))))))))),
- NewSubMenu(menu_run,hcRunMenu, NewMenu(
- NewItem(menu_run_run,menu_key_run_run, kbCtrlF9, cmRun, hcRun,
- NewItem(menu_run_stepover,menu_key_run_stepover, kbF8, cmStepOver, hcRun,
- NewItem(menu_run_traceinto,menu_key_run_traceinto, kbF7, cmTraceInto, hcRun,
- NewItem(menu_run_conttocursor,menu_key_run_conttocursor, kbF4, cmContToCursor, hcContToCursor,
- NewItem(menu_run_untilreturn,'', kbNoKey,cmUntilReturn,hcUntilReturn,
- NewItem(menu_run_parameters,'', kbNoKey, cmParameters, hcParameters,
- NewItem(menu_run_resetdebugger,menu_key_run_resetdebugger, kbCtrlF2, cmResetDebugger, hcResetDebugger,
- nil)))))))),
- NewSubMenu(menu_compile,hcCompileMenu, NewMenu(
- NewItem(menu_compile_compile,menu_key_compile_compile, kbAltF9, cmCompile, hcCompile,
- NewItem(menu_compile_make,menu_key_compile_make, kbF9, cmMake, hcMake,
- NewItem(menu_compile_build,'', kbNoKey, cmBuild, hcBuild,
- NewLine(
- NewItem(menu_compile_target,'', kbNoKey, cmTarget, hcTarget,
- NewItem(menu_compile_primaryfile,'', kbNoKey, cmPrimaryFile, hcPrimaryFile,
- NewItem(menu_compile_clearprimaryfile,'', kbNoKey, cmClearPrimary, hcClearPrimary,
- NewLine(
- NewItem(menu_compile_information,'', kbNoKey, cmInformation, hcInformation,
- NewItem(menu_compile_compilermessages,menu_key_compile_compilermessages, kbF12, cmCompilerMessages, hcCompilerMessages,
- nil))))))))))),
- NewSubMenu(menu_debug, hcDebugMenu, NewMenu(
- NewItem(menu_debug_output,'', kbNoKey, cmUserScreenWindow, hcUserScreenWindow,
- NewItem(menu_debug_userscreen,menu_key_debug_userscreen, kbAltF5, cmUserScreen, hcUserScreen,
- NewLine(
- {$ifdef SUPPORT_REMOTE}
- NewItem(menu_debug_remote,'', kbNoKey, cmTransferRemote, hcTransferRemote,
- {$endif SUPPORT_REMOTE}
- NewItem(menu_debug_registers,'', kbNoKey, cmRegisters, hcRegistersWindow,
- NewItem(menu_debug_fpu_registers,'', kbNoKey, cmFPURegisters, hcRegistersWindow,
- NewItem(menu_debug_addwatch,menu_key_debug_addwatch, kbCtrlF7, cmAddWatch, hcAddWatch,
- NewItem(menu_debug_watches,'', kbNoKey, cmWatches, hcWatchesWindow,
- NewItem(menu_debug_breakpoint,menu_key_debug_breakpoint, kbCtrlF8, cmToggleBreakpoint, hcToggleBreakpoint,
- NewItem(menu_debug_breakpointlist,'', kbNoKey, cmBreakpointList, hcBreakpointList,
- NewItem(menu_debug_callstack,menu_key_debug_callstack, kbCtrlF3, cmStack, hcStackWindow,
- NewLine(
- NewItem(menu_debug_gdbwindow,'', kbNoKey, cmOpenGDBWindow, hcOpenGDBWindow,
- nil
- {$ifdef SUPPORT_REMOTE}
- )
- {$endif SUPPORT_REMOTE}
- ))))))))))))),
- NewSubMenu(menu_tools, hcToolsMenu, NewMenu(
- NewItem(menu_tools_messages,menu_key_tools_messages, kbF11, cmToolsMessages, hcToolsMessages,
- NewItem(menu_tools_msgnext,menu_key_tools_msgnext, kbAltF8, cmToolsMsgNext, hcToolsMsgNext,
- NewItem(menu_tools_msgprev,menu_key_tools_msgprev, kbAltF7, cmToolsMsgPrev, hcToolsMsgPrev,
- NewLine(
- NewItem(menu_tools_grep,menu_key_tools_grep, kbShiftF2, cmGrep, hcGrep,
- NewItem(menu_tools_calculator, '', kbNoKey, cmCalculator, hcCalculator,
- NewItem(menu_tools_asciitable, '', kbNoKey, cmAsciiTable, hcAsciiTable,
- nil)))))))),
- NewSubMenu(menu_options, hcOptionsMenu, NewMenu(
- NewItem(menu_options_mode,'', kbNoKey, cmSwitchesMode, hcSwitchesMode,
- NewItem(menu_options_compiler,'', kbNoKey, cmCompiler, hcCompiler,
- NewItem(menu_options_memory,'', kbNoKey, cmMemorySizes, hcMemorySizes,
- NewItem(menu_options_linker,'', kbNoKey, cmLinker, hcLinker,
- NewItem(menu_options_debugger,'', kbNoKey, cmDebugger, hcDebugger,
- {$ifdef SUPPORT_REMOTE}
- NewItem(menu_options_remote,'', kbNoKey, cmRemoteDialog, hcRemoteDialog,
- {$endif SUPPORT_REMOTE}
- NewItem(menu_options_directories,'', kbNoKey, cmDirectories, hcDirectories,
- NewItem(menu_options_browser,'',kbNoKey, cmBrowser, hcBrowser,
- NewItem(menu_options_tools,'', kbNoKey, cmTools, hcTools,
- NewLine(
- NewSubMenu(menu_options_env, hcEnvironmentMenu, NewMenu(
- NewItem(menu_options_env_preferences,'', kbNoKey, cmPreferences, hcPreferences,
- NewItem(menu_options_env_editor,'', kbNoKey, cmEditor, hcEditor,
- NewItem(menu_options_env_codecomplete,'', kbNoKey, cmCodeCompleteOptions, hcCodeCompleteOptions,
- NewItem(menu_options_env_codetemplates,'', kbNoKey, cmCodeTemplateOptions, hcCodeTemplateOptions,
- NewItem(menu_options_env_desktop,'', kbNoKey, cmDesktopOptions, hcDesktopOptions,
- NewItem(menu_options_env_mouse,'', kbNoKey, cmMouse, hcMouse,
- NewItem(menu_options_env_startup,'', kbNoKey, cmStartup, hcStartup,
- NewItem(menu_options_env_colors,'', kbNoKey, cmColors, hcColors,
- {$ifdef Unix}
- NewItem(menu_options_learn_keys,'', kbNoKey, cmKeys, hcKeys,
- {$endif Unix}
- nil
- {$ifdef Unix}
- )
- {$endif Unix}
- ))))))))),
- NewLine(
- NewItem(menu_options_open,'', kbNoKey, cmOpenINI, hcOpenINI,
- NewItem(menu_options_save,'', kbNoKey, cmSaveINI, hcSaveINI,
- NewItem(menu_options_saveas,'', kbNoKey, cmSaveAsINI, hcSaveAsINI,
- nil
- {$ifdef SUPPORT_REMOTE}
- )
- {$endif SUPPORT_REMOTE}
- ))))))))))))))),
- NewSubMenu(menu_window, hcWindowMenu, NewMenu(
- NewItem(menu_window_tile,'', kbNoKey, cmTile, hcTile,
- NewItem(menu_window_cascade,'', kbNoKey, cmCascade, hcCascade,
- NewItem(menu_window_closeall,'', kbNoKey, cmCloseAll, hcCloseAll,
- NewLine(
- NewItem(menu_window_resize,menu_key_window_resize, kbCtrlF5, cmResize, hcResize,
- NewItem(menu_window_zoom,menu_key_window_zoom, kbF5, cmZoom, hcZoom,
- NewItem(menu_window_next,menu_key_window_next, kbF6, cmNext, hcNext,
- NewItem(menu_window_previous,menu_key_window_previous, kbShiftF6, cmPrev, hcPrev,
- NewItem(menu_window_hide,menu_key_window_hide, kbCtrlF6, cmHide, hcHide,
- NewItem(menu_window_close,menu_key_window_close, kbAltF3, cmClose, hcClose,
- NewLine(
- NewItem(menu_window_list,menu_key_window_list, kbAlt0, cmWindowList, hcWindowList,
- NewItem(menu_window_update,'', kbNoKey, cmUpdate, hcUpdate,
- nil)))))))))))))),
- NewSubMenu(menu_help, hcHelpMenu, NewMenu(
- NewItem(menu_help_contents,'', kbNoKey, cmHelpContents, hcHelpContents,
- NewItem(menu_help_index,menu_key_help_helpindex, kbShiftF1, cmHelpIndex, hcHelpIndex,
- NewItem(menu_help_topicsearch,menu_key_help_topicsearch, kbCtrlF1, cmHelpTopicSearch, hcHelpTopicSearch,
- NewItem(menu_help_prevtopic,menu_key_help_prevtopic, kbAltF1, cmHelpPrevTopic, hcHelpPrevTopic,
- NewItem(menu_help_using,'',kbNoKey, cmHelpUsingHelp, hcHelpUsingHelp,
- NewItem(menu_help_files,'',kbNoKey, cmHelpFiles, hcHelpFiles,
- NewLine(
- NewItem(menu_help_about,'',kbNoKey, cmAbout, hcAbout,
- nil))))))))),
- nil)))))))))))));
- DisableCommands(EditorCmds+SourceCmds+CompileCmds);
- // Update; Desktop is still nil at that point ...
- end;
- procedure TIDEApp.InitStatusLine;
- var
- R: TRect;
- begin
- GetExtent(R);
- R.A.Y := R.B.Y - 1;
- StatusLine:=New(PIDEStatusLine, Init(R,
- NewStatusDef(hcDragging, hcDragging,
- NewStatusKey(status_help, kbF1, cmHelp,
- StdStatusKeys(
- NewStatusKey('~'#24#25#26#27+'~ Move', kbNoKey, 65535,
- NewStatusKey('~Shift+'#24#25#26#27+'~ Size', kbNoKey, 65535,
- NewStatusKey('~'#17+'ÄÙ~ Done', kbNoKey, 65535,
- NewStatusKey('~Esc~ Cancel', kbNoKey, 65535,
- nil)))))),
- NewStatusDef(hcStackWindow, hcStackWindow,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_disassemble, kbAltI, cmDisassemble,
- StdStatusKeys(
- nil))),
- NewStatusDef(hcFirstCommand, hcLastNormalCommand,
- NewStatusKey(status_help, kbF1, cmHelp,
- StdStatusKeys(
- nil)),
- NewStatusDef(hcFirstNoAltXCommand, hcLastCommand,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey('', kbF10, cmMenu,
- NewStatusKey('', kbAltF3, cmClose,
- NewStatusKey('', kbF5, cmZoom,
- NewStatusKey('', kbCtrlF5, cmResize,
- NewStatusKey('', kbF6, cmNext,
- NewStatusKey('', kbShiftF6, cmPrev,
- nil))))))),
- NewStatusDef(hcHelpWindow, hcHelpWindow,
- NewStatusKey(status_help_on_help, kbF1, cmHelpUsingHelp,
- NewStatusKey(status_help_previoustopic, kbAltF1, cmHelpPrevTopic,
- NewStatusKey(status_help_index, kbShiftF1, cmHelpIndex,
- NewStatusKey(status_help_close, kbEsc, cmClose,
- StdStatusKeys(
- nil))))),
- NewStatusDef(hcSourceWindow, hcSourceWindow,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_save, kbF2, cmSave,
- NewStatusKey(status_open, kbF3, cmOpen,
- NewStatusKey(status_compile, kbAltF9, cmCompile,
- NewStatusKey(status_make, kbF9, cmMake,
- NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
- StdStatusKeys
- (
- nil))))))),
- NewStatusDef(hcASCIITableWindow, hcASCIITableWindow,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_transferchar, kbCtrlEnter, cmTransfer,
- StdStatusKeys(
- nil))),
- NewStatusDef(hcMessagesWindow, hcMessagesWindow,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_msggotosource, kbEnter, cmMsgGotoSource,
- NewStatusKey(status_msgtracksource, kbNoKey, cmMsgTrackSource,
- NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
- NewStatusKey('', kbEsc, cmClose,
- StdStatusKeys(
- nil)))))),
- NewStatusDef(hcCalcWindow, hcCalcWindow,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_close, kbEsc, cmClose,
- NewStatusKey(status_calculatorpaste, kbCtrlEnter, cmCalculatorPaste,
- StdStatusKeys(
- nil)))),
- NewStatusDef(0, $FFFF,
- NewStatusKey(status_help, kbF1, cmHelp,
- NewStatusKey(status_open, kbF3, cmOpen,
- NewStatusKey(status_compile, kbAltF9, cmCompile,
- NewStatusKey(status_make, kbF9, cmMake,
- NewStatusKey(status_localmenu, kbAltF10, cmLocalMenu,
- StdStatusKeys(
- nil)))))),
- nil))))))))))));
- end;
- procedure TIDEApp.Idle;
- begin
- inherited Idle;
- Message(Application,evIdle,0,nil);
- GiveUpTimeSlice;
- end;
- procedure TIDEApp.GetEvent(var Event: TEvent);
- var P: PView;
- begin
- { first of all dispatch queued targeted events }
- while GetTargetedEvent(P,Event) do
- P^.HandleEvent(Event);
- {$ifdef FVISION}
- {$ifdef HasSysMsgUnit}
- { Handle System events directly }
- Drivers.GetSystemEvent(Event); { Load system event }
- If (Event.What <> evNothing) Then
- Begin
- HandleEvent(Event);
- End;
- {$endif HasSysMsgUnit}
- {$endif FVISION}
- inherited GetEvent(Event);
- {$ifdef DEBUG}
- if (Event.What=evKeyDown) and (Event.KeyCode=kbAltF11) then
- begin
- {$ifdef HasSignal}
- Generate_SIGSEGV;
- {$else}
- Halt(1);
- {$endif}
- end;
- if (Event.What=evKeyDown) and (Event.KeyCode=kbCtrlF11) then
- begin
- RunError(250);
- end;
- {$endif DEBUG}
- if (Event.What=evKeyDown) and (Event.KeyCode=kbAltF12) then
- begin
- CreateAnsiFile;
- ClearEvent(Event);
- end;
- if Event.What<>evNothing then
- LastEvent:=GetDosTicks
- else
- begin
- if abs(GetDosTicks-LastEvent)>SleepTimeOut then
- GiveUpTimeSlice;
- end;
- end;
- procedure TIDEApp.HandleEvent(var Event: TEvent);
- var DontClear: boolean;
- TempS: string;
- ForceDlg: boolean;
- {$ifdef HasSignal}
- CtrlCCatched : boolean;
- {$endif HasSignal}
- begin
- {$ifdef HasSignal}
- if (Event.What=evKeyDown) and (Event.keyCode=kbCtrlC) and
- (CtrlCPressed) then
- begin
- CtrlCCatched:=true;
- {$ifdef DEBUG}
- Writeln(stderr,'One CtrlC caught');
- {$endif DEBUG}
- end
- else
- CtrlCCatched:=false;
- {$endif HasSignal}
- case Event.What of
- evKeyDown :
- begin
- DontClear:=true;
- { just for debugging purposes }
- end;
- evCommand :
- begin
- DontClear:=false;
- case Event.Command of
- cmUpdate : Message(Application,evBroadcast,cmUpdate,nil);
- { -- File menu -- }
- cmNew : NewEditor;
- cmNewFromTemplate: NewFromTemplate;
- cmOpen : begin
- ForceDlg:=false;
- if (OpenFileName<>'') and
- ((DirOf(OpenFileName)='') or (Pos(ListSeparator,OpenFileName)<>0)) then
- begin
- TempS:=LocateSourceFile(OpenFileName,false);
- if TempS='' then
- ForceDlg:=true
- else
- OpenFileName:=TempS;
- end;
- if ForceDlg then
- OpenSearch(OpenFileName)
- else
- Open(OpenFileName);
- OpenFileName:='';
- end;
- cmSaveAll : SaveAll;
- cmChangeDir : ChangeDir;
- cmDOSShell : DOSShell;
- cmRecentFileBase..
- cmRecentFileBase+10
- : OpenRecentFile(Event.Command-cmRecentFileBase);
- { -- Edit menu -- }
- cmShowClipboard : ShowClipboard;
- { -- Search menu -- }
- cmFindProcedure : FindProcedure;
- cmObjects : Objects;
- cmModules : Modules;
- cmGlobals : Globals;
- cmSymbol : SearchSymbol;
- { -- Run menu -- }
- cmParameters : Parameters;
- cmStepOver : DoStepOver;
- cmTraceInto : DoTraceInto;
- cmRun : DoRun;
- cmResetDebugger : DoResetDebugger;
- cmContToCursor : DoContToCursor;
- cmUntilReturn : DoContUntilReturn;
- { -- Compile menu -- }
- cmCompile : DoCompile(cCompile);
- cmBuild : DoCompile(cBuild);
- cmMake : DoCompile(cMake);
- cmTarget : Target;
- cmPrimaryFile : DoPrimaryFile;
- cmClearPrimary : DoClearPrimary;
- cmInformation : DoInformation;
- cmCompilerMessages : DoCompilerMessages;
- { -- Debug menu -- }
- cmUserScreen : DoUserScreen;
- cmToggleBreakpoint : DoToggleBreak;
- cmStack : DoShowCallStack;
- cmBreakpointList : DoShowBreakpointList;
- cmWatches : DoShowWatches;
- cmAddWatch : DoAddWatch;
- cmOpenGDBWindow : DoOpenGDBWindow;
- cmRegisters : DoShowRegisters;
- cmFPURegisters : DoShowFPU;
- { -- Options menu -- }
- cmSwitchesMode : SetSwitchesMode;
- cmCompiler : DoCompilerSwitch;
- cmMemorySizes : MemorySizes;
- cmLinker : DoLinkerSwitch;
- cmDebugger : DoDebuggerSwitch;
- {$ifdef SUPPORT_REMOTE}
- cmRemoteDialog : DoRemote;
- cmTransferRemote: TransferRemote;
- {$endif SUPPORT_REMOTE}
- cmDirectories : Directories;
- cmTools : Tools;
- cmPreferences : Preferences;
- cmEditor : EditorOptions(nil);
- cmEditorOptions : EditorOptions(Event.InfoPtr);
- cmCodeTemplateOptions: CodeTemplates;
- cmCodeCompleteOptions: CodeComplete;
- cmBrowser : BrowserOptions(nil);
- cmBrowserOptions : BrowserOptions(Event.InfoPtr);
- cmMouse : Mouse;
- cmStartup : StartUp;
- cmDesktopOptions: DesktopOptions;
- cmColors : Colors;
- {$ifdef Unix}
- cmKeys : LearnKeysDialog;
- {$endif Unix}
- cmOpenINI : OpenINI;
- cmSaveINI : SaveINI;
- cmSaveAsINI : SaveAsINI;
- { -- Tools menu -- }
- cmToolsMessages : Messages;
- cmCalculator : Calculator;
- cmAsciiTable : DoAsciiTable;
- cmGrep : DoGrep;
- cmToolsBase+1..
- cmToolsBase+MaxToolCount
- : ExecuteTool(Event.Command-cmToolsBase);
- { -- Window menu -- }
- cmCloseAll : CloseAll;
- cmWindowList : WindowList;
- cmUserScreenWindow: DoUserScreenWindow;
- { -- Help menu -- }
- cmHelp,
- cmHelpContents : HelpContents;
- cmHelpIndex : HelpHelpIndex;
- { cmHelpTopicSearch: HelpTopicSearch;}
- cmHelpPrevTopic : HelpPrevTopic;
- cmHelpUsingHelp : HelpUsingHelp;
- cmHelpFiles : HelpFiles;
- cmAbout : About;
- cmShowReadme : ShowReadme;
- {$ifdef FVISION}
- cmResizeApp : ResizeApplication(Event.Id, Event.InfoWord);
- cmQuitApp : Message(@Self, evCommand, cmQuit, nil);
- {$endif FVISION}
- else DontClear:=true;
- end;
- if DontClear=false then ClearEvent(Event);
- end;
- evBroadcast :
- case Event.Command of
- cmSaveCancelled :
- SaveCancelled:=true;
- cmUpdateTools :
- UpdateTools;
- cmCommandSetChanged :
- UpdateMenu(MenuBar^.Menu);
- cmUpdate :
- Update;
- cmSourceWndClosing :
- begin
- with PSourceWindow(Event.InfoPtr)^ do
- if Editor^.FileName<>'' then
- AddRecentFile(Editor^.FileName,Editor^.CurPos.X,Editor^.CurPos.Y);
- {$ifndef NODEBUG}
- if assigned(Debugger) and (PView(Event.InfoPtr)=Debugger^.LastSource) then
- Debugger^.LastSource:=nil;
- {$endif}
- end;
- end;
- end;
- inherited HandleEvent(Event);
- {$ifdef HasSignal}
- { Reset flag if CrtlC was handled }
- if CtrlCCatched and (Event.What=evNothing) then
- begin
- CtrlCPressed:=false;
- {$ifdef DEBUG}
- Writeln(stderr,'One CtrlC handled');
- {$endif DEBUG}
- end;
- {$endif HasSignal}
- end;
- procedure TIDEApp.GetTileRect(var R: TRect);
- begin
- Desktop^.GetExtent(R);
- { Leave the compiler messages window in the bottom }
- if assigned(CompilerMessageWindow) and (CompilerMessageWindow^.GetState(sfVisible)) then
- R.B.Y:=Min(CompilerMessageWindow^.Origin.Y,R.B.Y);
- { Leave the messages window in the bottom }
- if assigned(MessagesWindow) and (MessagesWindow^.GetState(sfVisible)) then
- R.B.Y:=Min(MessagesWindow^.Origin.Y,R.B.Y);
- { Leave the watch window in the bottom }
- if assigned(WatchesWindow) and (WatchesWindow^.GetState(sfVisible)) then
- R.B.Y:=Min(WatchesWindow^.Origin.Y,R.B.Y);
- end;
- {****************************************************************************
- Switch Screens
- ****************************************************************************}
- procedure TIDEApp.ShowUserScreen;
- begin
- if Assigned(UserScreen) then
- UserScreen^.SaveIDEScreen;
- DoneSysError;
- DoneEvents;
- { DoneKeyboard should be called last to
- restore the keyboard correctly PM }
- {$ifndef go32v2}
- DoneScreen;
- {$endif ndef go32v2}
- DoneKeyboard;
- If UseMouse then
- DoneMouse
- else
- ButtonCount:=0;
- DoneDosMem;
- if Assigned(UserScreen) then
- UserScreen^.SwitchToConsoleScreen;
- end;
- procedure TIDEApp.ShowIDEScreen;
- begin
- if Assigned(UserScreen) then
- UserScreen^.SaveConsoleScreen;
- InitDosMem;
- InitKeyboard;
- If UseMouse then
- InitMouse
- else
- ButtonCount:=0;
- {$ifndef go32v2}
- InitScreen;
- {$endif ndef go32v2}
- {$ifdef win32}
- { write the empty screen to dummy console handle }
- UpdateScreen(true);
- {$endif ndef win32}
- InitEvents;
- InitSysError;
- CurDirChanged;
- {$ifndef win32}
- Message(Application,evBroadcast,cmUpdate,nil);
- {$endif win32}
- {$ifdef win32}
- // Win32ShowMouse;
- {$endif win32}
- if Assigned(UserScreen) then
- UserScreen^.SwitchBackToIDEScreen;
- {$ifdef win32}
- { This message was sent when the VideoBuffer was smaller
- than was the IdeApp thought => writes to random memory and random crashes... PM }
- Message(Application,evBroadcast,cmUpdate,nil);
- {$endif win32}
- {$ifdef Unix}
- SetKnownKeys;
- {$endif Unix}
- {$ifndef win32}
- {$ifndef go32v2}
- UpdateScreen(true);
- {$endif go32v2}
- {$endif win32}
- end;
- function TIDEApp.AutoSave: boolean;
- var IOK,SOK,DOK: boolean;
- begin
- IOK:=true; SOK:=true; DOK:=true;
- if (AutoSaveOptions and asEnvironment)<>0 then
- begin
- IOK:=WriteINIFile(false);
- if IOK=false then
- ErrorBox(error_saving_cfg_file,nil);
- end;
- if (AutoSaveOptions and asEditorFiles)<>0 then { was a typo here ("=0") - Gabor }
- SOK:=SaveAll;
- if (AutoSaveOptions and asDesktop)<>0 then
- begin
- { destory all help & browser windows - we don't want to store them }
- { UserScreenWindow is also not registered PM }
- DoCloseUserScreenWindow;
- {$IFNDEF NODEBUG}
- DoneDisassemblyWindow;
- {$ENDIF}
- CloseHelpWindows;
- CloseAllBrowsers;
- DOK:=SaveDesktop;
- if DOK=false then
- ErrorBox(error_saving_dsk_file,nil);
- end;
- AutoSave:=IOK and SOK and DOK;
- end;
- function TIDEApp.DoExecute(ProgramPath, Params, InFile,OutFile,ErrFile: string; ExecType: TExecType): boolean;
- var CanRun: boolean;
- ConsoleMode : TConsoleMode;
- {$ifndef Unix}
- PosExe: sw_integer;
- {$endif Unix}
- begin
- SaveCancelled:=false;
- CanRun:=AutoSave;
- if (CanRun=false) and (SaveCancelled=false) then
- CanRun:=true; { do not care about .DSK or .INI saving problems - just like TP }
- if CanRun then
- begin
- if UserScreen=nil then
- begin
- ErrorBox(error_user_screen_not_avail,nil);
- Exit;
- end;
- if ExecType<>exNoSwap then
- ShowUserScreen;
- SaveConsoleMode(ConsoleMode);
- if ExecType=exDosShell then
- WriteShellMsg
- else if ExecType<>exNoSwap then
- Writeln('Running "'+ProgramPath+' '+Params+'"');
- { DO NOT use COMSPEC for exe files as the
- ExitCode is lost in those cases PM }
- {$ifndef Unix}
- posexe:=Pos('.EXE',UpCaseStr(ProgramPath));
- { if programpath was three char long => bug }
- if (posexe>0) and (posexe=Length(ProgramPath)-3) then
- begin
- {$endif Unix}
- if (InFile='') and (OutFile='') and (ErrFile='') then
- DosExecute(ProgramPath,Params)
- else
- begin
- if ErrFile='' then
- ErrFile:='stderr';
- ExecuteRedir(ProgramPath,Params,InFile,OutFile,ErrFile);
- end;
- {$ifndef Unix}
- end
- else if (InFile='') and (OutFile='') and (ErrFile='') then
- DosExecute(GetEnv('COMSPEC'),'/C '+ProgramPath+' '+Params)
- else
- begin
- if ErrFile='' then
- ErrFile:='stderr';
- ExecuteRedir(GetEnv('COMSPEC'),'/C '+ProgramPath+' '+Params,
- InFile,OutFile,ErrFile);
- end;
- {$endif Unix}
- {$ifdef Unix}
- if (DebuggeeTTY='') and (OutFile='') and (ExecType<>exDosShell) then
- begin
- Write(' Press any key to return to IDE');
- InitKeyBoard;
- Keyboard.GetKeyEvent;
- while (Keyboard.PollKeyEvent<>0) do
- Keyboard.GetKeyEvent;
- DoneKeyboard;
- end;
- {$endif}
- RestoreConsoleMode(ConsoleMode);
- if ExecType<>exNoSwap then
- ShowIDEScreen;
- end;
- DoExecute:=CanRun;
- end;
- procedure TIDEApp.Update;
- begin
- SetCmdState([cmSaveAll],IsThereAnyEditor);
- SetCmdState([cmCloseAll,cmWindowList],IsThereAnyWindow);
- SetCmdState([cmTile,cmCascade],IsThereAnyVisibleWindow);
- SetCmdState([cmFindProcedure,cmObjects,cmModules,cmGlobals,cmSymbol{,cmInformation}],IsSymbolInfoAvailable);
- {$ifndef NODEBUG}
- SetCmdState([cmResetDebugger,cmUntilReturn],assigned(debugger) and debugger^.debuggee_started);
- {$endif}
- SetCmdState([cmToolsMsgNext,cmToolsMsgPrev],MessagesWindow<>nil);
- UpdateTools;
- UpdateRecentFileList;
- UpdatePrimaryFile;
- UpdateINIFile;
- Message(Application,evBroadcast,cmCommandSetChanged,nil);
- end;
- procedure TIDEApp.SourceWindowClosed;
- begin
- if not IsClosing then
- Update;
- end;
- procedure TIDEApp.CurDirChanged;
- begin
- Message(Application,evBroadcast,cmUpdateTitle,nil);
- UpdatePrimaryFile;
- UpdateINIFile;
- UpdateMenu(MenuBar^.Menu);
- end;
- procedure TIDEApp.UpdatePrimaryFile;
- begin
- SetMenuItemParam(SearchMenuItem(MenuBar^.Menu,cmPrimaryFile),SmartPath(PrimaryFile));
- SetCmdState([cmClearPrimary],PrimaryFile<>'');
- if PrimaryFile<>'' then
- SetCmdState(CompileCmds,true);
- UpdateMenu(MenuBar^.Menu);
- Message(ProgramInfoWindow,evBroadcast,cmUpdate,nil);
- end;
- procedure TIDEApp.UpdateINIFile;
- begin
- SetMenuItemParam(SearchMenuItem(MenuBar^.Menu,cmSaveINI),SmartPath(IniFileName));
- end;
- procedure TIDEApp.UpdateRecentFileList;
- var P: PMenuItem;
- {ID,}I: word;
- FileMenu: PMenuItem;
- begin
- { ID:=cmRecentFileBase;}
- FileMenu:=SearchSubMenu(MenuBar^.Menu,menuFile);
- repeat
- { Inc(ID);
- P:=SearchMenuItem(FileMenu^.SubMenu,ID);
- if FileMenu^.SubMenu^.Default=P then
- FileMenu^.SubMenu^.Default:=FileMenu^.SubMenu^.Items;
- if P<>nil then RemoveMenuItem(FileMenu^.SubMenu,P);}
- P:=GetMenuItemBefore(FileMenu^.SubMenu,nil);
- if (P<>nil) then
- begin
- if (cmRecentFileBase<P^.Command) and (P^.Command<=cmRecentFileBase+MaxRecentFileCount) then
- begin
- RemoveMenuItem(FileMenu^.SubMenu,P);
- if FileMenu^.SubMenu^.Default=P then
- FileMenu^.SubMenu^.Default:=FileMenu^.SubMenu^.Items;
- end
- else
- P:=nil;
- end;
- until P=nil;
- P:=GetMenuItemBefore(FileMenu^.SubMenu,nil);
- if (P<>nil) and IsSeparator(P) then
- RemoveMenuItem(FileMenu^.SubMenu,P);
- if RecentFileCount>0 then
- AppendMenuItem(FileMenu^.SubMenu,NewLine(nil));
- for I:=1 to RecentFileCount do
- begin
- P:=NewItem('~'+IntToStr(I)+'~ '+ShrinkPath(SmartPath(RecentFiles[I].FileName),27),' ',
- kbNoKey,cmRecentFileBase+I,hcRecentFileBase+I,nil);
- AppendMenuItem(FileMenu^.SubMenu,P);
- end;
- end;
- procedure TIDEApp.UpdateTools;
- var P: PMenuItem;
- { ID,}I: word;
- ToolsMenu: PMenuItem;
- S1,S2,S3: string;
- W: word;
- begin
- { ID:=cmToolsBase;}
- ToolsMenu:=SearchSubMenu(MenuBar^.Menu,menuTools);
- repeat
- P:=GetMenuItemBefore(ToolsMenu^.SubMenu,nil);
- if (P<>nil) then
- begin
- if (cmToolsBase<P^.Command) and (P^.Command<=cmToolsBase+MaxToolCount) then
- begin
- RemoveMenuItem(ToolsMenu^.SubMenu,P);
- if ToolsMenu^.SubMenu^.Default=P then
- ToolsMenu^.SubMenu^.Default:=ToolsMenu^.SubMenu^.Items;
- end
- else
- P:=nil;
- end;
- until P=nil;
- P:=GetMenuItemBefore(ToolsMenu^.SubMenu,nil);
- if (P<>nil) and IsSeparator(P) then
- RemoveMenuItem(ToolsMenu^.SubMenu,P);
- if GetToolCount>0 then
- AppendMenuItem(ToolsMenu^.SubMenu,NewLine(nil));
- for I:=1 to GetToolCount do
- begin
- GetToolParams(I-1,S1,S2,S3,W);
- P:=NewItem(S1,KillTilde(GetHotKeyName(W)),W,cmToolsBase+I,hcToolsBase+I,nil);
- AppendMenuItem(ToolsMenu^.SubMenu,P);
- end;
- end;
- procedure TIDEApp.DosShell;
- var
- s : string;
- begin
- {$ifdef Unix}
- s:=GetEnv('SHELL');
- if s='' then
- if ExistsFile('/bin/sh') then
- s:='/bin/sh';
- {$else}
- s:=GetEnv('COMSPEC');
- if s='' then
- if ExistsFile('c:\command.com') then
- s:='c:\command.com'
- else
- begin
- s:='command.com';
- if Not LocateExeFile(s) then
- s:='';
- end;
- {$endif}
- if s='' then
- ErrorBox(msg_errorexecutingshell,nil)
- else
- DoExecute(s, '', '', '', '', exDosShell);
- { In case we have something that the compiler touched }
- AskToReloadAllModifiedFiles;
- end;
- procedure TIDEApp.ShowReadme;
- var R,R2: TRect;
- D: PCenterDialog;
- M: PFPMemo;
- VSB: PScrollBar;
- S: PFastBufStream;
- begin
- New(S, Init(ReadmeName, stOpenRead, 4096));
- if S^.Status=stOK then
- begin
- R.Assign(0,0,63,18);
- New(D, Init(R, 'Free Pascal IDE'));
- with D^ do
- begin
- GetExtent(R);
- R.Grow(-2,-2); Inc(R.B.Y);
- R2.Copy(R); R2.Move(1,0); R2.A.X:=R2.B.X-1;
- New(VSB, Init(R2)); VSB^.GrowMode:=0; Insert(VSB);
- New(M, Init(R,nil,VSB,nil));
- M^.LoadFromStream(S);
- M^.ReadOnly:=true;
- Insert(M);
- end;
- InsertOK(D);
- ExecuteDialog(D,nil);
- end;
- Dispose(S, Done);
- end;
- {$I FPMFILE.INC}
- {$I FPMEDIT.INC}
- {$I FPMSRCH.INC}
- {$I FPMRUN.INC}
- {$I FPMCOMP.INC}
- {$I FPMDEBUG.INC}
- {$I FPMTOOLS.INC}
- {$I FPMOPTS.INC}
- {$I FPMWND.INC}
- {$I FPMHELP.INC}
- {$I fpmansi.inc}
- procedure TIDEApp.AddRecentFile(AFileName: string; CurX, CurY: sw_integer);
- begin
- if SearchRecentFile(AFileName)<>-1 then Exit;
- if RecentFileCount>0 then
- Move(RecentFiles[1],RecentFiles[2],SizeOf(RecentFiles[1])*Min(RecentFileCount,High(RecentFiles)-1));
- if RecentFileCount<High(RecentFiles) then Inc(RecentFileCount);
- with RecentFiles[1] do
- begin
- FileName:=AFileName;
- LastPos.X:=CurX; LastPos.Y:=CurY;
- end;
- UpdateRecentFileList;
- end;
- function TIDEApp.SearchRecentFile(AFileName: string): integer;
- var Idx,I: integer;
- begin
- Idx:=-1;
- for I:=1 to RecentFileCount do
- if UpcaseStr(AFileName)=UpcaseStr(RecentFiles[I].FileName) then
- begin Idx:=I; Break; end;
- SearchRecentFile:=Idx;
- end;
- procedure TIDEApp.RemoveRecentFile(Index: integer);
- begin
- if Index<RecentFileCount then
- Move(RecentFiles[Index+1],RecentFiles[Index],SizeOf(RecentFiles[1])*(RecentFileCount-Index));
- Dec(RecentFileCount);
- UpdateRecentFileList;
- end;
- function TIDEApp.GetPalette: PPalette;
- var P: string;
- begin
- P:=AppPalette;
- GetPalette:=@P;
- end;
- function TIDEApp.IsClosing: Boolean;
- begin
- IsClosing:=InsideDone;
- end;
- destructor TIDEApp.Done;
- begin
- InsideDone:=true;
- IsRunning:=false;
- inherited Done;
- Desktop:=nil;
- RemoveBrowsersCollection;
- DoneHelpSystem;
- end;
- END.
- {
- $Log$
- Revision 1.26 2003-09-29 14:36:59 peter
- * win32 fixed
- Revision 1.25 2003/01/31 11:01:00 pierre
- * fix a bug in cmQuitApp handling
- Revision 1.24 2002/12/12 00:06:41 pierre
- Use fpregs unit
- Revision 1.23 2002/11/28 12:58:15 pierre
- + remote support additions
- Revision 1.22 2002/10/12 19:43:07 hajny
- * missing HasSignal conditionals added (needed for FPC/2)
- Revision 1.21 2002/09/13 07:16:56 pierre
- * avoid RTE 201 if closing file with position outside integer bounds
- Revision 1.20 2002/09/09 06:58:51 pierre
- + adapted to FastBufStream.readline method
- Revision 1.19 2002/09/07 15:40:43 peter
- * old logs removed and tabs fixed
- Revision 1.18 2002/09/03 13:58:05 pierre
- * fix bug about Recent file list not updated correctly when opening a file from the list
- Revision 1.17 2002/08/26 13:02:15 pierre
- * avoid a crash with fvision
- Revision 1.16 2002/08/13 08:59:12 pierre
- + Run menu changes depending on wether the debuggee is running or not
- Revision 1.15 2002/07/12 14:17:39 pierre
- * try to avoid memory corruption if UserScreen is smaller than IDE screen on win32
- Revision 1.14 2002/06/10 08:12:17 pierre
- * System messages must be handled by the application directly
- Revision 1.13 2002/05/30 15:03:23 pierre
- + ResizeApplication pethod for fvision
- Revision 1.12 2002/05/29 22:38:13 pierre
- Asciitab now in fvision
- Revision 1.11 2002/04/25 13:34:17 pierre
- * fix the disappearing desktop for win32
- Revision 1.10 2002/04/12 08:58:22 pierre
- + add RTE(250) for Ctrl+F11 in DEBUG mode
- Revision 1.9 2002/03/20 14:52:01 pierre
- + deliberatly generate a SIGSEGV if Alt+F11 is pressed (DEBUG code)
- Revision 1.8 2002/01/24 09:21:42 pierre
- * only disable Alt-X in Options|Compiler dialog
- }
|