unit ce_main; {$I ce_defines.inc} interface uses Classes, SysUtils, LazFileUtils, SynEditKeyCmds, SynHighlighterLFM, Forms, StdCtrls, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls, Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process, XMLPropStorage, SynExportHTML, ce_common, ce_dmdwrap, ce_nativeproject, ce_synmemo, ce_writableComponent, ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, ce_search, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_todolist, ce_observer, ce_toolseditor, ce_procinput, ce_optionseditor, ce_symlist, ce_mru, ce_processes, ce_infos, ce_dubproject, ce_dialogs, ce_dubprojeditor, (*ce_gdb,*) ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils; type TCEApplicationOptions = class; TAnchorDockSplitterEx = class(TAnchorDockSplitter) public property OnMouseWheel; end; { TCEMainForm } TCEMainForm = class(TForm, ICEMultiDocObserver, ICEEditableShortCut, ICEProjectObserver) actFileCompAndRun: TAction; actFileSaveAll: TAction; actFileClose: TAction; actFileAddToProj: TAction; actFileNewRun: TAction; actFileNew: TAction; actFileOpen: TAction; actFileSaveAs: TAction; actFileSave: TAction; actFileCompAndRunWithArgs: TAction; actEdFind: TAction; actEdFindNext: TAction; actFileOpenContFold: TAction; actFileHtmlExport: TAction; actFileUnittest: TAction; actFileCompileAndRunOut: TAction; actFileSaveCopyAs: TAction; actFileCompile: TAction; actFileRun: TAction; actFileDscanner: TAction; actFileRunOut: TAction; actFileRunDub: TAction; actFileRunDubOut: TAction; actFileNewDubScript: TAction; actProjGroupCompile: TAction; actProjSelUngrouped: TAction; actProjAddToGroup: TAction; actProjNewGroup: TAction; actProjOpenGroup: TAction; actProjSaveGroup: TAction; actProjSaveGroupAs: TAction; actProjNewDubJson: TAction; actProjNewNative: TAction; actSetRunnableSw: TAction; actLayoutSave: TAction; actProjOpenContFold: TAction; actProjOptView: TAction; actProjSource: TAction; actProjRun: TAction; actProjRunWithArgs: TAction; actProjCompile: TAction; actProjCompileAndRun: TAction; actProjCompAndRunWithArgs: TAction; actProjClose: TAction; actProjOpts: TAction; actProjOpen: TAction; actProjSave: TAction; actProjSaveAs: TAction; actEdMacPlay: TAction; actEdMacStartStop: TAction; actEdCut: TAction; actEdRedo: TAction; actEdUndo: TAction; actEdPaste: TAction; actEdCopy: TAction; actEdIndent: TAction; actEdUnIndent: TAction; Actions: TActionList; ApplicationProperties1: TApplicationProperties; imgList: TImageList; mainMenu: TMainMenu; MenuItem1: TMenuItem; MenuItem10: TMenuItem; MenuItem11: TMenuItem; MenuItem12: TMenuItem; MenuItem13: TMenuItem; MenuItem14: TMenuItem; MenuItem15: TMenuItem; MenuItem16: TMenuItem; MenuItem17: TMenuItem; MenuItem18: TMenuItem; MenuItem19: TMenuItem; MenuItem2: TMenuItem; MenuItem20: TMenuItem; MenuItem21: TMenuItem; MenuItem22: TMenuItem; MenuItem23: TMenuItem; MenuItem24: TMenuItem; MenuItem25: TMenuItem; MenuItem26: TMenuItem; MenuItem27: TMenuItem; MenuItem28: TMenuItem; MenuItem29: TMenuItem; MenuItem3: TMenuItem; MenuItem30: TMenuItem; MenuItem31: TMenuItem; MenuItem32: TMenuItem; MenuItem33: TMenuItem; MenuItem34: TMenuItem; MenuItem35: TMenuItem; MenuItem36: TMenuItem; MenuItem37: TMenuItem; MenuItem38: TMenuItem; MenuItem39: TMenuItem; MenuItem40: TMenuItem; MenuItem41: TMenuItem; MenuItem42: TMenuItem; MenuItem43: TMenuItem; MenuItem44: TMenuItem; MenuItem45: TMenuItem; MenuItem46: TMenuItem; MenuItem47: TMenuItem; MenuItem48: TMenuItem; MenuItem49: TMenuItem; MenuItem50: TMenuItem; MenuItem51: TMenuItem; MenuItem52: TMenuItem; MenuItem53: TMenuItem; MenuItem54: TMenuItem; MenuItem55: TMenuItem; MenuItem56: TMenuItem; MenuItem57: TMenuItem; MenuItem58: TMenuItem; MenuItem59: TMenuItem; MenuItem60: TMenuItem; MenuItem61: TMenuItem; MenuItem62: TMenuItem; MenuItem63: TMenuItem; MenuItem64: TMenuItem; MenuItem65: TMenuItem; MenuItem66: TMenuItem; MenuItem67: TMenuItem; MenuItem68: TMenuItem; MenuItem69: TMenuItem; MenuItem70: TMenuItem; MenuItem71: TMenuItem; MenuItem72: TMenuItem; MenuItem73: TMenuItem; MenuItem74: TMenuItem; MenuItem75: TMenuItem; MenuItem76: TMenuItem; MenuItem77: TMenuItem; MenuItem78: TMenuItem; MenuItem79: TMenuItem; MenuItem80: TMenuItem; MenuItem81: TMenuItem; MenuItem82: TMenuItem; MenuItem83: TMenuItem; MenuItem84: TMenuItem; MenuItem85: TMenuItem; MenuItem86: TMenuItem; MenuItem87: TMenuItem; MenuItem88: TMenuItem; MenuItem89: TMenuItem; MenuItem90: TMenuItem; MenuItem91: TMenuItem; MenuItem92: TMenuItem; MenuItem93: TMenuItem; MenuItem94: TMenuItem; MenuItem95: TMenuItem; MenuItem96: TMenuItem; MenuItem97: TMenuItem; mnuLayout: TMenuItem; mnuItemMruFile: TMenuItem; mnuItemMruProj: TMenuItem; mnuItemWin: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; MenuItem7: TMenuItem; MenuItem8: TMenuItem; MenuItem9: TMenuItem; procedure actFileCompileExecute(Sender: TObject); procedure actFileDscannerExecute(Sender: TObject); procedure actFileNewDubScriptExecute(Sender: TObject); procedure actFileRunDubExecute(Sender: TObject); procedure actFileRunDubOutExecute(Sender: TObject); procedure actFileRunExecute(Sender: TObject); procedure actFileRunOutExecute(Sender: TObject); procedure actFileSaveCopyAsExecute(Sender: TObject); procedure actNewGroupExecute(Sender: TObject); procedure actProjAddToGroupExecute(Sender: TObject); procedure actProjGroupCompileExecute(Sender: TObject); procedure actProjNewDubJsonExecute(Sender: TObject); procedure actProjNewGroupExecute(Sender: TObject); procedure actProjNewNativeExecute(Sender: TObject); procedure actProjOpenGroupExecute(Sender: TObject); procedure actProjSaveGroupAsExecute(Sender: TObject); procedure actProjSaveGroupExecute(Sender: TObject); procedure actProjSelUngroupedExecute(Sender: TObject); procedure actSetRunnableSwExecute(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure MenuItem77Click(Sender: TObject); procedure updateDocumentBasedAction(sender: TObject); procedure updateProjectBasedAction(sender: TObject); procedure updateDocEditBasedAction(sender: TObject); procedure actFileCompileAndRunOutExecute(Sender: TObject); procedure actEdFindExecute(Sender: TObject); procedure actEdFindNextExecute(Sender: TObject); procedure actFileAddToProjExecute(Sender: TObject); procedure actFileCloseExecute(Sender: TObject); procedure actFileCompAndRunExecute(Sender: TObject); procedure actFileCompAndRunWithArgsExecute(Sender: TObject); procedure actFileHtmlExportExecute(Sender: TObject); procedure actFileOpenContFoldExecute(Sender: TObject); procedure actFileSaveAllExecute(Sender: TObject); procedure actEdIndentExecute(Sender: TObject); procedure actFileUnittestExecute(Sender: TObject); procedure actLayoutSaveExecute(Sender: TObject); procedure actProjCompAndRunWithArgsExecute(Sender: TObject); procedure actProjCompileAndRunExecute(Sender: TObject); procedure actProjCompileExecute(Sender: TObject); procedure actEdCopyExecute(Sender: TObject); procedure actEdCutExecute(Sender: TObject); procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); procedure actEdMacPlayExecute(Sender: TObject); procedure actEdMacStartStopExecute(Sender: TObject); procedure actFileNewExecute(Sender: TObject); procedure actFileNewRunExecute(Sender: TObject); procedure actFileOpenExecute(Sender: TObject); procedure actProjOpenContFoldExecute(Sender: TObject); procedure actProjOpenExecute(Sender: TObject); procedure actEdPasteExecute(Sender: TObject); procedure actProjCloseExecute(Sender: TObject); procedure actProjOptsExecute(Sender: TObject); procedure actEdRedoExecute(Sender: TObject); procedure actFileSaveAsExecute(Sender: TObject); procedure actFileSaveExecute(Sender: TObject); procedure actProjOptViewExecute(Sender: TObject); procedure actProjRunExecute(Sender: TObject); procedure actProjRunWithArgsExecute(Sender: TObject); procedure actProjSaveAsExecute(Sender: TObject); procedure actProjSaveExecute(Sender: TObject); procedure actEdUndoExecute(Sender: TObject); procedure actProjSourceExecute(Sender: TObject); procedure actEdUnIndentExecute(Sender: TObject); procedure ApplicationProperties1Exception(Sender: TObject; E: Exception); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormDropFiles(Sender: TObject; const FileNames: array of string); protected procedure DoShow; override; private fRunnableCompiler: TCECompiler; fRunnableDestination: string; fSymStringExpander: ICESymStringExpander; fProjectGroup: ICEProjectGroup; fCovModUt: boolean; fDscanUnittests: boolean; fAlwaysUseDest: boolean; fDoc: TCESynMemo; fFirstTimeCoedit: boolean; fActionHandler: TCEActionProviderSubject; fMultidoc: ICEMultiDocHandler; fScCollectCount: Integer; fUpdateCount: NativeInt; fProject: ICECommonProject; fFreeProj: ICECommonProject; fDubProject: TCEDubProject; fNativeProject: TCENativeProject; fProjMru: TCEMRUProjectList; fFileMru: TCEMRUDocumentList; fWidgList: TCEWidgetList; fMesgWidg: TCEMessagesWidget; fEditWidg: TCEEditorWidget; fProjWidg: TCEProjectInspectWidget; fPrjCfWidg: TCEProjectConfigurationWidget; fFindWidg: TCESearchWidget; fExplWidg: TCEMiniExplorerWidget; fLibMWidg: TCELibManEditorWidget; fTlsEdWidg: TCEToolsEditorWidget; fPrInpWidg: TCEProcInputWidget; fTodolWidg: TCETodoListWidget; fOptEdWidg: TCEOptionEditorWidget; fSymlWidg: TCESymbolListWidget; fInfoWidg: TCEInfoWidget; fDubProjWidg: TCEDubProjectEditorWidget; fPrjGrpWidg: TCEProjectGroupWidget; //fGdbWidg: TCEGdbWidget; fDfmtWidg: TCEDfmtWidget; fRunProjAfterCompArg: boolean; fRunProjAfterCompile: boolean; fIsCompilingGroup: boolean; fGroupCompilationCnt: integer; fFirstShown: boolean; fProjFromCommandLine: boolean; fInitialized: boolean; fRunnableSw: string; fRunProc: TCEProcess; fMsgs: ICEMessagesDisplay; fMainMenuSubj: TCEMainMenuSubject; fAppliOpts: TCEApplicationOptions; procedure updateMainMenuProviders; procedure updateFloatingWidgetOnTop(onTop: boolean); // action provider handling; procedure clearActProviderEntries; procedure collectedActProviderEntries; // ICEMultiDocObserver procedure docNew(aDoc: TCESynMemo); procedure docClosing(aDoc: TCESynMemo); procedure docFocused(aDoc: TCESynMemo); procedure docChanged(aDoc: TCESynMemo); // ICEProjectObserver procedure projNew(aProject: ICECommonProject); procedure projChanged(aProject: ICECommonProject); procedure projClosing(aProject: ICECommonProject); procedure projFocused(aProject: ICECommonProject); procedure projCompiling(aProject: ICECommonProject); procedure projCompiled(aProject: ICECommonProject; success: boolean); // ICEEditableShortcut function scedWantFirst: boolean; function scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean; procedure scedSendItem(const category, identifier: string; aShortcut: TShortcut); procedure scedSendDone; //Init - Fina procedure getCMdParams; procedure InitMRUs; procedure InitWidgets; procedure InitDocking; procedure LoadSettings; procedure SaveSettings; procedure LoadDocking; procedure SaveDocking; procedure LoadLastDocsAndProj; procedure SaveLastDocsAndProj; procedure FreeRunnableProc; // widget interfaces subroutines procedure updateWidgetMenuEntry(sender: TObject); procedure widgetShowFromAction(sender: TObject); // run & exec sub routines function runnableExename: string; procedure asyncprocOutput(sender: TObject); procedure asyncprocTerminate(sender: TObject); procedure unittestDone(Sender: TObject); function compileRunnable(unittest: boolean = false): boolean; procedure executeRunnable(unittest: boolean = false; redirect: boolean = true; const runArgs: string = ''); procedure runFile(outside: boolean); procedure dubFile(outside: boolean); // file sub routines procedure newFile; procedure saveFile(aDocument: TCESynMemo); procedure openFile(const aFilename: string); // project sub routines procedure saveProjSource(const aEditor: TCESynMemo); procedure newNativeProj; procedure newDubProj; procedure saveProj; procedure saveProjAs(const aFilename: string); procedure openProj(const aFilename: string); procedure closeProj; procedure showProjTitle; // mru procedure mruChange(Sender: TObject); procedure mruFileItemClick(Sender: TObject); procedure mruProjItemClick(Sender: TObject); procedure mruClearClick(Sender: TObject); // layout procedure setSplitterWheelEvent; procedure DockSplitterMw(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure LockTopWindow(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure layoutMnuItemClick(sender: TObject); procedure layoutLoadFromFile(const aFilename: string); procedure layoutSaveToFile(const aFilename: string); procedure layoutUpdateMenu; public constructor create(aOwner: TComponent); override; destructor destroy; override; procedure UpdateDockCaption(Exclude: TControl = nil); override; end; TCEPersistentMainShortcuts = class(TWritableLfmTextComponent) private fCol: TCollection; procedure setCol(aValue: TCollection); published property shortcut: TCollection read fCol write setCol; public constructor create(aOwner: TComponent); override; destructor destroy; override; // procedure assign(aValue: TPersistent); override; procedure assignTo(aValue: TPersistent); override; end; TCEPersistentMainMrus = class(TWritableLfmTextComponent) private fProjMruPt: TCEMRUFileList; fFileMruPt: TCEMRUFileList; procedure setProjMru(aValue: TCEMRUFileList); procedure setFileMru(aValue: TCEMRUFileList); published property mostRecentFiles: TCEMRUFileList read fFileMruPt write setFileMru; property mostRecentprojects: TCEMRUFileList read fProjMruPt write setProjMru; public procedure setTargets(projs: TCEMRUFileList; files: TCEMRUFileList); end; TCELastDocsAndProjs = class(TWritableLfmTextComponent) private fDocuments: TStringList; fProject: string; fDocIndex: integer; fProjectGroup: string; fProjectIndex: integer; procedure setDocuments(aValue: TStringList); protected procedure beforeSave; override; procedure afterLoad; override; published property documentIndex: integer read fDocIndex write fDocIndex; property documents: TStringList read fDocuments write setDocuments; property project: string read fProject write fProject; property projectGroup: string read fProjectGroup write fProjectGroup; property projectIndex: integer read fProjectIndex write fProjectIndex; public constructor create(aOwner: TComponent); override; destructor destroy; override; procedure Assign(aSource: TPersistent); override; procedure AssignTo(aDestination: TPersistent); override; end; TCEApplicationOptionsBase = class(TWritableLfmTextComponent) private fFloatingWidgetOnTop: boolean; fReloadLastDocuments: boolean; fCovModUt: boolean; fMaxRecentProjs: integer; fMaxRecentDocs: integer; fDcdPort: word; fRunnableDest: TCEPathname; fAlwaysUseDest: boolean; fDscanUnittests: boolean; fAutoSaveProjectFiles: boolean; fFlatLook: boolean; fDetectMain: boolean; fDetectRunnableImports: boolean; function getAdditionalPATH: string; procedure setAdditionalPATH(const value: string); function getDubCompiler: TCECompiler; procedure setDubCompiler(value: TCECompiler); function getRunnableCompiler: TCECompiler; procedure setRunnableCompiler(value: TCECompiler); function getNativeProjecCompiler: TCECompiler; procedure setNativeProjecCompiler(value: TCECompiler); procedure setRunnableDestination(const value: TCEPathname); procedure setFlatLook(value: boolean); published property additionalPATH: string read getAdditionalPATH write setAdditionalPath; property coverModuleTests: boolean read fCovModUt write fCovModUt; property floatingWidgetOnTop: boolean read fFloatingWidgetOnTop write fFloatingWidgetOnTop; property reloadLastDocuments: boolean read fReloadLastDocuments write fReloadLastDocuments; property maxRecentProjects: integer read fMaxRecentProjs write fMaxRecentProjs; property maxRecentDocuments: integer read fMaxRecentDocs write fMaxRecentDocs; property dubCompiler: TCECompiler read getDubCompiler write setDubCompiler; property nativeProjectCompiler: TCECompiler read getNativeProjecCompiler write setNativeProjecCompiler; property runnableCompiler: TCECompiler read getRunnableCompiler write setRunnableCompiler; property runnableDestination: TCEPathname read fRunnableDest write setRunnableDestination; property runnableDestinationAlways: boolean read fAlwaysUseDest write fAlwaysUseDest; property dscanUnittests: boolean read fDscanUnittests write fDscanUnittests default true; property autoSaveProjectFiles: boolean read fAutoSaveProjectFiles write fAutoSaveProjectFiles default false; property flatLook: boolean read fFlatLook write setFlatLook; property detectMain: boolean read fDetectMain write fDetectMain; property detectRunnableImports: boolean read fDetectRunnableImports write fDetectRunnableImports; // published for ICEEditableOptions but stored by DCD wrapper since it reloads before CEMainForm property dcdPort: word read fDcdPort write fDcdPort stored false; // TODO-cmaintenance: remove this property from version 3 update 1 property nativeProjecCompiler: TCECompiler read getNativeProjecCompiler write setNativeProjecCompiler stored false; end; TCEApplicationOptions = class(TCEApplicationOptionsBase, ICEEditableOptions) private fBackup:TCEApplicationOptionsBase; // function optionedWantCategory(): string; function optionedWantEditorKind: TOptionEditorKind; function optionedWantContainer: TPersistent; procedure optionedEvent(anEvent: TOptionEditorEvent); function optionedOptionsModified: boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure assign(src: TPersistent); override; procedure assignTo(dst: TPersistent); override; end; var CEMainForm: TCEMainForm; implementation {$R *.lfm} uses SynMacroRecorder, ce_dcd; {$REGION TCEApplicationOptions ------------------------------------------------------} constructor TCEApplicationOptions.Create(AOwner: TComponent); begin inherited; fBackup := TCEApplicationOptionsBase.Create(self); EntitiesConnector.addObserver(self); fDscanUnittests := true; end; function TCEApplicationOptionsBase.getDubCompiler: TCECompiler; begin exit(ce_dubproject.getDubCompiler); end; function TCEApplicationOptionsBase.getNativeProjecCompiler: TCECompiler; begin exit(ce_nativeproject.getNativeProjectCompiler); end; procedure TCEApplicationOptionsBase.setDubCompiler(value: TCECompiler); begin ce_dubproject.setDubCompiler(value); end; procedure TCEApplicationOptionsBase.setNativeProjecCompiler(value: TCECompiler); begin ce_nativeproject.setNativeProjectCompiler(value); end; function TCEApplicationOptionsBase.getRunnableCompiler: TCECompiler; begin exit(CEMainForm.fRunnableCompiler); end; procedure TCEApplicationOptionsBase.setRunnableCompiler(value: TCECompiler); begin case value of ldc: if not exeInSysPath('ldmd2' + exeExt) then value := dmd; gdc: if not exeInSysPath('gdmd' + exeExt) then value := dmd; end; CEMainForm.fRunnableCompiler:=value; end; procedure TCEApplicationOptionsBase.setRunnableDestination(const value: TCEPathname); begin fRunnableDest := value; if (length(fRunnableDest) > 0) and (fRunnableDest[length(fRunnableDest)] <> DirectorySeparator) then fRunnableDest += DirectorySeparator; end; procedure TCEApplicationOptionsBase.setFlatLook(value: boolean); begin fFlatLook := value; end; function TCEApplicationOptionsBase.getAdditionalPATH: string; begin exit(ce_common.additionalPath); end; procedure TCEApplicationOptionsBase.setAdditionalPath(const value: string); var str: TStringList; cat: string; i: integer; begin str := TStringList.Create; try str.Delimiter:= PathSeparator; str.DelimitedText:= value; for i := str.Count-1 downto 0 do if not str[i].dirExists then str.Delete(i); cat := str.DelimitedText; ce_common.additionalPath := cat; finally str.Free; end; end; destructor TCEApplicationOptions.Destroy; begin EntitiesConnector.removeObserver(self); inherited; end; procedure TCEApplicationOptions.assign(src: TPersistent); begin if src = CEMainForm then begin fMaxRecentProjs:= CEMainForm.fProjMru.maxCount; fMaxRecentDocs:= CEMainForm.fFileMru.maxCount; fDcdPort := DcdWrapper.port; fCovModUt:= CEMainForm.fCovModUt; fRunnableDest := CEMainForm.fRunnableDestination; fAlwaysUseDest := CEMainForm.fAlwaysUseDest; fDscanUnittests := CEMainForm.fDscanUnittests; end else if src = fBackup then begin fCovModUt:=fBackup.fCovModUt; fDcdPort:=fBackup.fDcdPort; fMaxRecentDocs:= fBackup.fMaxRecentDocs; fMaxRecentProjs:= fBackup.fMaxRecentProjs; fReloadLastDocuments:=fBackup.fReloadLastDocuments; fFloatingWidgetOnTop := fBackup.fFloatingWidgetOnTop; fFlatLook:=fBackup.fFlatLook; CEMainForm.fRunnableDestination := fBackup.fRunnableDest; CEmainForm.fAlwaysUseDest := fBackup.fAlwaysUseDest; CEMainForm.fDscanUnittests := fDscanUnittests; end else inherited; end; procedure TCEApplicationOptions.assignTo(dst: TPersistent); var i: integer; begin if dst = CEMainForm then begin CEMainForm.fCovModUt:= fCovModUt; CEMainForm.fProjMru.maxCount := fMaxRecentProjs; CEMainForm.fFileMru.maxCount := fMaxRecentDocs; CEMainForm.updateFloatingWidgetOnTop(fFloatingWidgetOnTop); CEMainForm.fRunnableDestination := fRunnableDest; CEMainForm.fAlwaysUseDest := fAlwaysUseDest; CEMainForm.fDscanUnittests := fDscanUnittests; DcdWrapper.port:=fDcdPort; for i := 0 to CEMainForm.fWidgList.Count-1 do CEMainForm.fWidgList.widget[i].toolbarFlat:=fFlatLook; end else if dst = fBackup then begin fBackup.fMaxRecentDocs:= fMaxRecentDocs; fBackup.fMaxRecentProjs:= fMaxRecentProjs; fBackup.fReloadLastDocuments:=fReloadLastDocuments; fBackup.fFloatingWidgetOnTop:=fFloatingWidgetOnTop; fBackup.fDcdPort:=fDcdPort; fBackup.fCovModUt:=fCovModUt; fBackup.fRunnableDest:= fRunnableDest; fBackup.fAlwaysUseDest := fAlwaysUseDest; fBackup.fDscanUnittests:= fDscanUnittests; fBackup.fFlatLook:= fFlatLook; end else inherited; end; function TCEApplicationOptions.optionedWantCategory(): string; begin exit('Application'); end; function TCEApplicationOptions.optionedWantEditorKind: TOptionEditorKind; begin exit(oekGeneric); end; function TCEApplicationOptions.optionedWantContainer: TPersistent; begin AssignTo(fBackup); exit(self); end; procedure TCEApplicationOptions.optionedEvent(anEvent: TOptionEditorEvent); begin case anEvent of oeeCancel: begin Assign(fBackup); AssignTo(CEMainForm); end; oeeAccept: begin AssignTo(CEMainForm); AssignTo(fBackup);end; oeeSelectCat: begin Assign(CEMainForm); AssignTo(fBackup); end; oeeChange: AssignTo(CEMainForm); end; end; function TCEApplicationOptions.optionedOptionsModified: boolean; begin exit(false); end; {$ENDREGION} {$REGION TCELastDocsAndProjs ---------------------------------------------------} constructor TCELastDocsAndProjs.create(aOwner: TComponent); begin inherited; fDocuments := TStringList.Create; end; destructor TCELastDocsAndProjs.destroy; begin fDocuments.Free; inherited; end; procedure TCELastDocsAndProjs.Assign(aSource: TPersistent); var itf: ICECommonProject = nil; begin if aSource = CEMainForm then begin itf := CEMainForm.fFreeProj; if itf <> nil then fProject := itf.filename; fProjectGroup := getProjectGroup.groupFilename; if itf = CEMainForm.fProject then fProjectIndex:=-1 else fProjectIndex := getProjectGroup.getProjectIndex; end else inherited; end; procedure TCELastDocsAndProjs.AssignTo(aDestination: TPersistent); var itf: ICECommonProject = nil; dst: TCEMainForm; hdl: ICEMultiDocHandler; mem: TCESynMemo = nil; begin if aDestination is TCEMainForm then begin dst := TCEMainForm(aDestination); if dst.fProjFromCommandLine then exit; itf := dst.fProject; if (itf <> nil) and (itf.filename = fProject) and (itf.filename.fileExists) then exit; if fProject.isNotEmpty and fProject.fileExists then begin dst.openProj(fProject); hdl := getMultiDocHandler; if assigned(hdl) then mem := hdl.findDocument(dst.fProject.filename); if mem.isNotNil then if dst.fProject.getFormat = pfNative then mem.Highlighter := LfmSyn else mem.Highlighter := JsSyn; end; if fProjectGroup.isNotEmpty and fProjectGroup.fileExists then begin getProjectGroup.openGroup(fProjectGroup); end; if (fProjectIndex = -1) and (dst.fFreeProj <> nil) then dst.fFreeProj.activate; end else inherited; end; procedure TCELastDocsAndProjs.setDocuments(aValue: TStringList); begin fDocuments.Assign(aValue); end; procedure TCELastDocsAndProjs.beforeSave; var i: integer; docHandler: ICEMultiDocHandler; document: TCESynMemo; str: string; begin docHandler := getMultiDocHandler; if docHandler = nil then exit; // for i:= 0 to docHandler.documentCount-1 do begin document := docHandler.document[i]; str := document.fileName; if (str <> document.tempFilename) and str.fileExists then begin fDocuments.Add(str); if document.Focused then documentIndex := i; end; end; end; procedure TCELastDocsAndProjs.afterLoad; var docHandler: ICEMultiDocHandler; str: string; focusedName: string = ''; i: integer; begin docHandler := getMultiDocHandler; if docHandler = nil then exit; // for i := 0 to fDocuments.Count-1 do begin str := fDocuments[i]; if str.fileExists then begin docHandler.openDocument(str); if i = fDocIndex then focusedName := str; end; end; // if focusedName.isNotEmpty then docHandler.openDocument(focusedName); end; {$ENDREGION} {$REGION Actions shortcuts -----------------------------------------------------} constructor TCEPersistentMainShortcuts.create(aOwner: TComponent); begin inherited; fCol := TCollection.Create(TCEPersistentShortcut); end; destructor TCEPersistentMainShortcuts.destroy; begin fCol.Free; inherited; end; procedure TCEPersistentMainShortcuts.setCol(aValue: TCollection); begin fCol.Assign(aValue); end; procedure TCEPersistentMainShortcuts.assign(aValue: TPersistent); var itm: TCEPersistentShortcut; i: Integer; begin fCol.Clear; if aValue = CEMainForm then for i := 0 to CEMainForm.Actions.ActionCount-1 do begin if CEMainForm.Actions.Actions[i].Owner <> CEMainForm then continue; itm := TCEPersistentShortcut(fCol.Add); itm.shortcut := TAction(CEMainForm.Actions.Actions[i]).Shortcut; itm.actionName := CEMainForm.Actions.Actions[i].Name; end else inherited; end; procedure TCEPersistentMainShortcuts.assignTo(aValue: TPersistent); var itm: TCEPersistentShortcut; i, j: Integer; begin if aValue = CEMainForm then for i:= 0 to fCol.Count-1 do begin itm := TCEPersistentShortcut(fCol.Items[i]); for j := 0 to CEMainForm.Actions.ActionCount-1 do if CEMainForm.Actions.Actions[i].Name = itm.actionName then begin TAction(CEMainForm.Actions.Actions[i]).Shortcut := itm.shortcut; break; end; end else inherited; end; {$ENDREGION} {$REGION TCEPersistentMainMrus -------------------------------------------------} procedure TCEPersistentMainMrus.setProjMru(aValue: TCEMRUFileList); begin fProjMruPt.assign(aValue); end; procedure TCEPersistentMainMrus.setFileMru(aValue: TCEMRUFileList); begin fFileMruPt.assign(aValue); end; procedure TCEPersistentMainMrus.setTargets(projs: TCEMRUFileList; files: TCEMRUFileList); begin fFileMruPt := files; fProjMruPt := projs; end; {$ENDREGION} {$REGION Standard Comp/Obj------------------------------------------------------} constructor TCEMainForm.create(aOwner: TComponent); begin inherited create(aOwner); fMainMenuSubj := TCEMainMenuSubject.create; fActionHandler := TCEActionProviderSubject.create; // EntitiesConnector.addObserver(self); // InitMRUs; InitWidgets; InitDocking; LoadSettings; layoutUpdateMenu; fMultidoc := getMultiDocHandler; OnDragDrop:= @ddHandler.DragDrop; OnDragOver:= @ddHandler.DragOver; // updateMainMenuProviders; EntitiesConnector.forceUpdate; fSymStringExpander:= getSymStringExpander; fProjectGroup := getProjectGroup; // getCMdParams; // fInitialized := true; end; procedure TCEMainForm.getCMdParams; var value: string; lst: TStringList; begin if application.ParamCount > 0 then begin value := application.Params[1]; if value.isNotEmpty then begin lst := TStringList.Create; try lst.DelimitedText := value; for value in lst do begin if value.isEmpty then continue; if isEditable(value.extractFileExt) then openFile(value) else if isValidNativeProject(value) or isValidDubProject(value) then begin // so far CE can only open 1 project at a time openProj(value); fProjFromCommandLine := true; break; end end; finally lst.Free; end; end; end; value := application.GetOptionValue('p', 'project'); if value.isNotEmpty and value.fileExists then openProj(value); value := application.GetOptionValue('f', 'files'); if value.isNotEmpty then begin lst := TStringList.Create; try lst.DelimitedText := value; for value in lst do begin if value.fileExists then openFile(value); end; finally lst.Free; end; end; end; procedure TCEMainForm.InitMRUs; begin fProjMru := TCEMRUProjectList.Create; fFileMru := TCEMRUDocumentList.Create; fProjMru.objectTag := mnuItemMruProj; fFileMru.objectTag := mnuItemMruFile; fProjMru.OnChange := @mruChange; fFileMru.OnChange := @mruChange; end; procedure TCEMainForm.InitWidgets; var widg: TCEWidget; act: TAction; itm: TMenuItem; begin fWidgList := TCEWidgetList.Create; fMesgWidg := TCEMessagesWidget.create(self); fEditWidg := TCEEditorWidget.create(self); fProjWidg := TCEProjectInspectWidget.create(self); fPrjCfWidg := TCEProjectConfigurationWidget.create(self); fFindWidg := TCESearchWidget.create(self); fExplWidg := TCEMiniExplorerWidget.create(self); fLibMWidg := TCELibManEditorWidget.create(self); fTlsEdWidg := TCEToolsEditorWidget.create(self); fPrInpWidg := TCEProcInputWidget.create(self); fTodolWidg := TCETodoListWidget.create(self); fOptEdWidg := TCEOptionEditorWidget.create(self); fSymlWidg := TCESymbolListWidget.create(self); fInfoWidg := TCEInfoWidget.create(self); fDubProjWidg:= TCEDubProjectEditorWidget.create(self); fDfmtWidg := TCEDfmtWidget.create(self); fPrjGrpWidg := TCEProjectGroupWidget.create(self); //fGdbWidg := TCEGdbWidget.create(self); getMessageDisplay(fMsgs); fWidgList.addWidget(@fMesgWidg); fWidgList.addWidget(@fEditWidg); fWidgList.addWidget(@fProjWidg); fWidgList.addWidget(@fPrjCfWidg); fWidgList.addWidget(@fFindWidg); fWidgList.addWidget(@fExplWidg); fWidgList.addWidget(@fLibMWidg); fWidgList.addWidget(@fTlsEdWidg); fWidgList.addWidget(@fPrInpWidg); fWidgList.addWidget(@fTodolWidg); fWidgList.addWidget(@fOptEdWidg); fWidgList.addWidget(@fSymlWidg); fWidgList.addWidget(@fInfoWidg); fWidgList.addWidget(@fDubProjWidg); fWidgList.addWidget(@fDfmtWidg); fWidgList.addWidget(@fPrjGrpWidg); //fWidgList.addWidget(@fGdbWidg); fWidgList.sort(@CompareWidgCaption); for widg in fWidgList do begin act := TAction.Create(self); act.Category := 'Window'; act.Caption := widg.Caption; act.OnExecute := @widgetShowFromAction; act.Tag := ptrInt(widg); act.ImageIndex := 25; act.OnUpdate:= @updateWidgetMenuEntry; itm := TMenuItem.Create(self); itm.Action := act; itm.Tag := ptrInt(widg); mnuItemWin.Add(itm); end; end; procedure TCEMainForm.LockTopWindow(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin //TODO-cdocking: top splitter pos can change even if locked (e.g after resize) accept := GetKeyShiftState = [ssCtrl]; end; procedure TCEMainForm.DockSplitterMw(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); var offs: integer; splt: TAnchorDockSplitter; begin offs := -480 div WheelDelta; splt := TAnchorDockSplitter(sender); splt.MoveSplitter(offs); if splt.ResizeAnchor in [akLeft, akRight] then Mouse.CursorPos:= Point(Mouse.CursorPos.X + offs, Mouse.CursorPos.Y) else Mouse.CursorPos:= Point(Mouse.CursorPos.X, Mouse.CursorPos.Y + offs); Handled := true; end; //TODO-cdocking: set splitter MW event when a new widget is docked procedure TCEMainForm.setSplitterWheelEvent; var i: integer; widg: TCEWidget; site: TControl; anchl: TAnchorKind; begin for i := 0 to fWidgList.Count-1 do begin widg := fWidgList.widget[i]; if not widg.isDockable then continue; for anchl in [low(anchl) .. high(anchl)] do if GetDockSplitterOrParent(DockMaster.GetSite(widg), anchl, site) then begin if site is TAnchorDockHostSite then begin if TAnchorDockHostSite(site).BoundSplitter.isNotNil then TAnchorDockSplitterEx(TAnchorDockHostSite(site).BoundSplitter).OnMouseWheel:=@DockSplitterMw; end else if site is TAnchorDockSplitter then TAnchorDockSplitterEx(TAnchorDockSplitter(site)).OnMouseWheel:=@DockSplitterMw; end; end; end; procedure TCEMainForm.InitDocking; var i: Integer; widg: TCEWidget; aManager: TAnchorDockManager; topsite : TControl; topsplt : TAnchorDockSplitter; begin DockMaster.MakeDockSite(Self, [akBottom], admrpChild); DockMaster.OnShowOptions := @ShowAnchorDockOptions; DockMaster.HeaderStyle := adhsPoints; DockMaster.HideHeaderCaptionFloatingControl := true; // this is a fix copied from Laz. if DockManager is TAnchorDockManager then begin aManager:=TAnchorDockManager(DockManager); aManager.PreferredSiteSizeAsSiteMinimum:=false; end; // makes widget dockable for i := 0 to fWidgList.Count-1 do begin widg := fWidgList.widget[i]; if not widg.isDockable then continue; DockMaster.MakeDockable(widg, true); DockMaster.GetAnchorSite(widg).Header.HeaderPosition := adlhpTop; end; // load existing or default docking if FileExists(getCoeditDocPath + 'docking.xml') then LoadDocking else begin Height := 0; // center DockMaster.ManualDock(DockMaster.GetAnchorSite(fEditWidg), DockMaster.GetSite(Self), alBottom); DockMaster.ManualDock(DockMaster.GetAnchorSite(fMesgWidg), DockMaster.GetSite(fEditWidg), alBottom); // left DockMaster.GetAnchorSite(fSymlWidg).Width := 160; DockMaster.GetAnchorSite(fFindWidg).Width := 160; DockMaster.ManualDock(DockMaster.GetAnchorSite(fSymlWidg), DockMaster.GetSite(fEditWidg), alLeft); DockMaster.ManualDock(DockMaster.GetAnchorSite(fFindWidg), DockMaster.GetAnchorSite(fSymlWidg), alBottom, fSymlWidg); // right DockMaster.GetAnchorSite(fProjWidg).Width := 260; DockMaster.GetAnchorSite(fPrjCfWidg).Width := 260; DockMaster.ManualDock(DockMaster.GetAnchorSite(fProjWidg), DockMaster.GetSite(fEditWidg), alRight); DockMaster.ManualDock(DockMaster.GetAnchorSite(fPrjCfWidg), DockMaster.GetAnchorSite(fProjWidg), alBottom, fProjWidg); // close remaining and header to top for i := 0 to fWidgList.Count-1 do begin widg := fWidgList.widget[i]; if not widg.isDockable then continue; DockMaster.GetAnchorSite(widg).Header.HeaderPosition := adlhpTop; if not DockMaster.GetAnchorSite(widg).HasParent then DockMaster.GetAnchorSite(widg).Close; end; end; // lock space between the menu and the widgets if GetDockSplitterOrParent(DockMaster.GetSite(fEditWidg), akTop, topsite) then begin if topsite is TAnchorDockHostSite then if TAnchorDockHostSite(topsite).BoundSplitter.isNotNil then begin TAnchorDockHostSite(topsite).BoundSplitter.MoveSplitter(-500); TAnchorDockHostSite(topsite).BoundSplitter.OnCanOffset:= @LockTopWindow; end; end else if GetDockSplitter(DockMaster.GetSite(fEditWidg), akTop, topsplt) then begin topsplt.MoveSplitter(-500); topsplt.OnCanOffset:= @LockTopWindow; end; end; procedure TCEMainForm.LoadSettings; var fname: string; begin // project and files MRU fname := getCoeditDocPath + 'mostrecent.txt'; if fname.fileExists then with TCEPersistentMainMrus.create(nil) do try setTargets(fFileMru, fProjMru); loadFromFile(fname); finally Free; end; // shortcuts for the actions standing in the main action list fname := getCoeditDocPath + 'mainshortcuts.txt'; if fname.fileExists then with TCEPersistentMainShortcuts.create(nil) do try loadFromFile(fname); assignTo(self); finally Free; end; // globals opts fAppliOpts := TCEApplicationOptions.Create(self); fname := getCoeditDocPath + 'application.txt'; if fname.fileExists then begin fAppliOpts.loadFromFile(fname); fAppliOpts.assignTo(self); end else fFirstTimeCoedit := true; end; procedure TCEMainForm.SaveSettings; begin if not fInitialized then exit; // project and files MRU with TCEPersistentMainMrus.create(nil) do try setTargets(fFileMru, fProjMru); saveToFile(getCoeditDocPath + 'mostrecent.txt'); finally Free; end; // shortcuts for the actions standing in the main action list with TCEPersistentMainShortcuts.create(nil) do try assign(self); saveToFile(getCoeditDocPath + 'mainshortcuts.txt'); finally Free; end; // globals opts fAppliOpts.assign(self); fAppliOpts.saveToFile(getCoeditDocPath + 'application.txt'); end; procedure TCEMainForm.SaveDocking; var xcfg: TXMLConfigStorage; i: NativeInt; begin if not fInitialized then exit; if not Visible then exit; // DockMaster.RestoreLayouts.Clear; if WindowState = wsMinimized then WindowState := wsNormal; // does not save minimized/undocked windows to prevent bugs for i:= 0 to fWidgList.Count-1 do begin if not fWidgList.widget[i].isDockable then continue; if DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState = wsMinimized then DockMaster.GetAnchorSite(fWidgList.widget[i]).Close else if not DockMaster.GetAnchorSite(fWidgList.widget[i]).HasParent then DockMaster.GetAnchorSite(fWidgList.widget[i]).Close; end; // forceDirectory(getCoeditDocPath); xcfg := TXMLConfigStorage.Create(getCoeditDocPath + 'docking.xml.tmp', false); try DockMaster.SaveLayoutToConfig(xcfg); xcfg.WriteToDisk; // TODO-cdocking: remove this when AnchorDocking wont save anymore invalid layout with TMemoryStream.Create do try LoadFromFile(getCoeditDocPath + 'docking.xml.tmp'); if Size < 10000 then begin SaveToFile(getCoeditDocPath + 'docking.xml'); SysUtils.DeleteFile(getCoeditDocPath + 'docking.xml.tmp'); end; finally free; end; finally xcfg.Free; end; // xcfg := TXMLConfigStorage.Create(getCoeditDocPath + 'dockingopts.xml',false); try DockMaster.SaveSettingsToConfig(xcfg); xcfg.WriteToDisk; finally xcfg.Free; end; end; procedure TCEMainForm.LoadDocking; var xcfg: TXMLConfigStorage; str: TMemoryStream; begin if fileExists(getCoeditDocPath + 'docking.xml') then begin xcfg := TXMLConfigStorage.Create(getCoeditDocPath + 'docking.xml', true); try try DockMaster.LoadLayoutFromConfig(xcfg, false); except exit; end; str := TMemoryStream.Create; try xcfg.SaveToStream(str); str.saveToFile(getCoeditDocPath + 'docking.bak') finally str.Free; end; finally xcfg.Free; end; end; if fileExists(getCoeditDocPath + 'dockingopts.xml') then begin xcfg := TXMLConfigStorage.Create(getCoeditDocPath + 'dockingopts.xml', true); try try DockMaster.LoadSettingsFromConfig(xcfg); except exit; end; str := TMemoryStream.Create; try xcfg.SaveToStream(str); str.saveToFile(getCoeditDocPath + 'dockingopts.bak') finally str.Free; end; finally xcfg.Free; end; end; end; procedure TCEMainForm.FreeRunnableProc; var fname: string; begin if fRunProc.isNil then exit; // fname := fRunProc.Executable; if getprocInputHandler.process = fRunProc then begin getMessageDisplay.message('the execution of a runnable module ' + 'has been implicitly aborted', fDoc, amcEdit, amkWarn); getprocInputHandler.addProcess(nil); end; killProcess(fRunProc); if fname.fileExists and (fname.extractFilePath = GetTempDir(false)) then sysutils.DeleteFile(fname); end; procedure TCEMainForm.SaveLastDocsAndProj; begin with TCELastDocsAndProjs.create(nil) do try assign(self); saveToFile(getCoeditDocPath + 'lastdocsandproj.txt'); finally free; end; end; procedure TCEMainForm.LoadLastDocsAndProj; begin with TCELastDocsAndProjs.create(nil) do try loadFromFile(getCoeditDocPath + 'lastdocsandproj.txt'); assignTo(self); finally free; end; end; procedure TCEMainForm.DoShow; begin inherited; if (not fFirstShown) then begin // TODO-cbetterfix: clipboard doesn't work first time it's used on a reloaded doc. // see: http://forum.lazarus.freepascal.org/index.php/topic,30616.0.htm if fAppliOpts.reloadLastDocuments then LoadLastDocsAndProj; if fProject = nil then newNativeProj; DockMaster.ResetSplitters; if fFirstTimeCoedit then actFileNewRun.Execute; fFirstShown := true; end; setSplitterWheelEvent; end; procedure TCEMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin // saving doesnt work when csDestroying in comp.state (i.e in destroy) if CloseAction = caFree then SaveDocking; end; procedure TCEMainForm.MenuItem77Click(Sender: TObject); begin fOptEdWidg.showWidget; end; destructor TCEMainForm.destroy; begin SaveSettings; // fWidgList.Free; fProjMru.Free; fFileMru.Free; FreeRunnableProc; // fMainMenuSubj.Free; fActionHandler.Free; EntitiesConnector.removeObserver(self); inherited; end; procedure TCEMainForm.UpdateDockCaption(Exclude: TControl = nil); begin // otherwise dockmaster puts the widget list. Caption := 'Coedit'; end; procedure TCEMainForm.ApplicationProperties1Exception(Sender: TObject;E: Exception); begin if fMesgWidg.isNil then dlgOkError(E.Message) else fMsgs.message(E.Message, nil, amcApp, amkErr); end; procedure TCEMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); var i: Integer; begin canClose := false; SaveLastDocsAndProj; if (fFreeProj <> nil) then begin if fFreeProj.modified and (dlgFileChangeClose(fFreeProj.filename) = mrCancel) then exit; fFreeProj.getProject.Free; fFreeProj := nil; end; for i := fMultidoc.documentCount-1 downto 0 do if not fMultidoc.closeDocument(i) then exit; if fProjectGroup.groupModified then if (dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel) then exit; canClose := true; fProjectGroup.closeGroup; end; procedure TCEMainForm.updateDocumentBasedAction(sender: TObject); begin TAction(sender).Enabled := fDoc.isNotNil; end; procedure TCEMainForm.updateProjectBasedAction(sender: TObject); begin TAction(sender).Enabled := fProject <> nil; end; procedure TCEMainForm.updateDocEditBasedAction(sender: TObject); begin if fDoc.isNotNil and fDoc.Focused then TAction(sender).Enabled := true else TAction(sender).Enabled := false; end; procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); begin Handled := false; if fUpdateCount > 0 then exit; Inc(fUpdateCount); try clearActProviderEntries; collectedActProviderEntries; if AAction.isNotNil then if not AAction.Update then TAction(AAction).enabled := true; updateMainMenuProviders; finally Dec(fUpdateCount); end; end; procedure TCEMainForm.updateMainMenuProviders; var i, j: Integer; itm: TMenuItem; doneUpdate: boolean = false; begin for j := 0 to fMainMenuSubj.observersCount-1 do begin // try to update existing entry. for i := 0 to mainMenu.Items.Count-1 do if PtrInt(fMainMenuSubj.observers[j]) = mainMenu.Items[i].Tag then begin (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuUpdate(mainMenu.Items[i]); doneUpdate := true; break; end; if doneUpdate then continue; // otherwise propose to create a new entry itm := TMenuItem.Create(Self); (fMainMenuSubj.observers[j] as ICEMainMenuProvider).menuDeclare(itm); itm.Tag:= PtrInt(fMainMenuSubj.observers[j]); case itm.Count > 0 of true: mainMenu.Items.Add(itm); false: itm.Free; end; end; end; procedure TCEMainForm.mruChange(Sender: TObject); var srcLst: TCEMruFileList; trgMnu: TMenuItem; itm: TMenuItem; fname: string; clickTrg: TNotifyEvent; begin srcLst := TCEMruFileList(Sender); if srcLst.isNil then exit; trgMnu := TMenuItem(srcLst.objectTag); if trgMnu.isNil then exit; if fUpdateCount > 0 then exit; Inc(fUpdateCount); try if srcLst = fFileMru then clickTrg := @mruFileItemClick else if srcLst = fProjMru then clickTrg := @mruProjItemClick; trgMnu.Clear; for fname in srcLst do begin itm := TMenuItem.Create(trgMnu); itm.Hint := fname; itm.Caption := fname.extractFileName + ' - (' + fname + ')'; itm.OnClick := clickTrg; trgMnu.Add(itm); end; trgMnu.AddSeparator; itm := TMenuItem.Create(trgMnu); itm.Caption := 'Clear'; itm.OnClick := @mruClearClick; itm.Tag := PtrInt(srcLst); trgMnu.Add(itm); finally Dec(fUpdateCount); end; end; procedure TCEMainForm.mruClearClick(Sender: TObject); var srcLst: TCEMruFileList; begin srcLst := TCEMruFileList(TmenuItem(Sender).Tag); if srcLst.isNil then exit; // srcLst.Clear; end; {$ENDREGION} {$REGION ICEMultiDocMonitor ----------------------------------------------------} procedure TCEMainForm.docNew(aDoc: TCESynMemo); begin fDoc := aDoc; end; procedure TCEMainForm.docClosing(aDoc: TCESynMemo); begin if aDoc <> fDoc then exit; fDoc := nil; end; procedure TCEMainForm.docFocused(aDoc: TCESynMemo); begin fDoc := aDoc; end; procedure TCEMainForm.docChanged(aDoc: TCESynMemo); begin fDoc := aDoc; end; {$ENDREGION} {$REGION ICEProjectObserver ----------------------------------------------------} procedure TCEMainForm.projNew(aProject: ICECommonProject); begin fProject := aProject; case fProject.getFormat of pfNative: fNativeProject := TCENativeProject(fProject.getProject); pfDub: fDubProject := TCEDubProject(fProject.getProject); end; if not fProject.inGroup then fFreeProj := aProject; end; procedure TCEMainForm.projChanged(aProject: ICECommonProject); begin showProjTitle; end; procedure TCEMainForm.projClosing(aProject: ICECommonProject); begin if aProject = fFreeProj then fFreeProj := nil; if fProject <> aProject then exit; fProject := nil; fDubProject := nil; fNativeProject := nil; showProjTitle; end; procedure TCEMainForm.projFocused(aProject: ICECommonProject); begin fProject := aProject; case fProject.getFormat of pfNative: fNativeProject := TCENativeProject(fProject.getProject); pfDub: fDubProject := TCEDubProject(fProject.getProject); end; if not fProject.inGroup then fFreeProj := aProject else if (fProject = fFreeProj) and (fProject.inGroup) then fFreeProj := nil; showProjTitle; end; procedure TCEMainForm.projCompiling(aProject: ICECommonProject); begin end; procedure TCEMainForm.projCompiled(aProject: ICECommonProject; success: boolean); var runArgs: string = ''; runprev: boolean = true; i: integer; begin if not fIsCompilingGroup then begin if fRunProjAfterCompile and assigned(fProject) then begin if not success then runprev := dlgYesNo('last build failed, continue and run ?') = mrYes; if runprev then begin if fRunProjAfterCompArg and not InputQuery('Execution arguments', '', runargs) then runargs := ''; fProject.run(runargs); end; end; fRunProjAfterCompile := false; fRunProjAfterCompArg := false; end else begin fGroupCompilationCnt += 1; if (fGroupCompilationCnt = fProjectGroup.projectCount) then begin for i:= 0 to fProjectGroup.projectCount-1 do if not fProjectGroup.getProject(i).compiled then begin fMsgs.message('error, the project group is not fully compiled', nil, amcAll, amkErr); exit; end; fMsgs.message('the project group is successfully compiled', nil, amcAll, amkInf); end; end; end; {$ENDREGION} {$REGION ICEEditableShortCut ---------------------------------------------------} function TCEMainForm.scedWantFirst: boolean; begin fScCollectCount := 0; result := true; end; function TCEMainForm.scedWantNext(out category, identifier: string; out aShortcut: TShortcut): boolean; var act: TCustomAction; begin act := TCustomAction(Actions.Actions[fScCollectCount]); category := act.Category; identifier := act.Caption; aShortcut := act.ShortCut; // fScCollectCount += 1; result := fScCollectCount < actions.ActionCount; end; procedure TCEMainForm.scedSendItem(const category, identifier: string; aShortcut: TShortcut); var act: TCustomAction; i: integer; begin for i:= 0 to Actions.ActionCount-1 do begin act := TCustomAction(Actions.Actions[i]); if act.Category <> category then continue; if act.Caption <> identifier then continue; act.ShortCut := aShortcut; end; end; procedure TCEMainForm.scedSendDone; begin end; {$ENDREGION} {$REGION TCEActionProviderHandler ----------------------------------------------} procedure TCEMainForm.clearActProviderEntries; var prov: ICEActionProvider; act: TContainedAction; i, j: Integer; begin for i:= 0 to fActionHandler.observersCount-1 do begin prov := fActionHandler[i] as ICEActionProvider; if not prov.actHandlerWantRecollect then continue; // for j := Actions.ActionCount-1 downto 0 do begin act := Actions.Actions[j]; if act.Owner = Self then continue; if act.Tag <> PtrInt(prov) then continue; // act.ActionList := nil; end; end; end; procedure TCEMainForm.collectedActProviderEntries; var prov: ICEActionProvider; act: TCustomAction; cat: string; i: Integer; procedure addAction; begin act.ActionList := Actions; act.Tag := ptrInt(prov); act.Category := cat; // act := nil; cat := ''; end; begin for i:= 0 to fActionHandler.observersCount-1 do begin prov := fActionHandler[i] as ICEActionProvider; if not prov.actHandlerWantFirst then continue; // act := nil; cat := ''; while prov.actHandlerWantNext(cat, act) do addAction; addAction; end; end; {$ENDREGION} {$REGION file ------------------------------------------------------------------} procedure TCEMainForm.actFileHtmlExportExecute(Sender: TObject); var exp: TSynExporterHTML; begin if fDoc.isNil then exit; exp := TSynExporterHTML.Create(nil); try with TOpenDialog.Create(nil) do try if Execute then begin exp.Highlighter := fDoc.Highlighter; exp.Title := fDoc.fileName; exp.ExportAsText:=true; exp.ExportAll(fDoc.Lines); exp.SaveToFile(filename); end; finally Free; end; finally exp.Free; end; end; procedure TCEMainForm.newFile; begin TCESynMemo.Create(nil); end; procedure TCEMainForm.openFile(const aFilename: string); begin fMultidoc.openDocument(aFilename); end; procedure TCEMainForm.saveFile(aDocument: TCESynMemo); begin if (aDocument.Highlighter = LfmSyn) or (aDocument.Highlighter = JsSyn) then saveProjSource(aDocument) else if aDocument.fileName.fileExists then aDocument.save; end; procedure TCEMainForm.mruFileItemClick(Sender: TObject); begin openFile(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actFileOpenExecute(Sender: TObject); begin with TOpenDialog.Create(nil) do try filter := DdiagFilter; if execute then openFile(filename); finally free; end; end; procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject); begin if fProject = nil then exit; if not fProject.filename.fileExists then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; getExplorer.browse(fProject.filename.extractFilePath); end; procedure TCEMainForm.actFileNewExecute(Sender: TObject); begin newFile; fDoc.setFocus; end; procedure TCEMainForm.actFileNewRunExecute(Sender: TObject); const body: array[boolean] of string = ( LineEnding, ' // this file can be directly executed using menu file/compile & run' + LineEnding + ' // phobos and libman imports are allowed' + LineEnding + ' writeln("hello runnable module");' + LineEnding ); begin newFile; fDoc.Text := 'module runnable;' + LineEnding + LineEnding + 'import std.stdio;' + LineEnding + LineEnding + 'void main(string[] args)' + LineEnding + '{' + LineEnding + body[fFirstTimeCoedit] + '}'; fDoc.setFocus; end; procedure TCEMainForm.actFileSaveAsExecute(Sender: TObject); begin if fDoc.isNil then exit; // with TSaveDialog.Create(nil) do try Filter := DdiagFilter; if execute then fDoc.saveToFile(filename); finally free; end; end; procedure TCEMainForm.actFileSaveExecute(Sender: TObject); var str: string; begin if fDoc.isNil then exit; // str := fDoc.fileName; if (str <> fDoc.tempFilename) and str.fileExists then saveFile(fDoc) else actFileSaveAs.Execute; end; procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); begin if fDoc.isNil then exit; if fProject = nil then exit; if fProject.filename = fDoc.fileName then exit; // if fProject.getFormat = pfNative then begin if fDoc.fileName.fileExists and not fDoc.isTemporary then fNativeProject.addSource(fDoc.fileName) else dlgOkInfo('the file has not been added to the project because it does not exist'); end else getMessageDisplay.message('use the DUB project editor to add a source to a DUB project', nil, amcApp, amkHint); end; procedure TCEMainForm.actFileCloseExecute(Sender: TObject); begin if fDoc.isNotNil then getMultiDocHandler.closeDocument(fDoc); end; procedure TCEMainForm.actFileSaveAllExecute(Sender: TObject); var i: Integer; begin for i:= 0 to fMultidoc.documentCount-1 do saveFile(fMultidoc.document[i]); end; procedure TCEMainForm.FormDropFiles(Sender: TObject;const FileNames: array of string); var fname: string; begin for fname in FileNames do begin if isEditable(fname) then openFile(fname) else if isValidNativeProject(fname) or isValidDubProject(fname) then begin openProj(fname); break; end else openFile(fname); end; end; procedure TCEMainForm.actFileSaveCopyAsExecute(Sender: TObject); var str: TStringList; begin if fDoc.isNil then exit; with TSaveDialog.create(nil) do try if fDoc.isDSource then Filter:= DdiagFilter; if execute then begin str := TStringList.create; try str.assign(fDoc.Lines); str.saveToFile(FileName); finally str.free; end; end; finally free; end; end; {$ENDREGION} {$REGION edit ------------------------------------------------------------------} procedure TCEMainForm.actEdCopyExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.CopyToClipboard; end; procedure TCEMainForm.actEdCutExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.CutToClipboard; end; procedure TCEMainForm.actEdPasteExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.PasteFromClipboard; end; procedure TCEMainForm.actEdUndoExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.Undo; end; procedure TCEMainForm.actEdRedoExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.Redo; end; procedure TCEMainForm.actEdMacPlayExecute(Sender: TObject); begin if fDoc.isNotNil then fEditWidg.macRecorder.PlaybackMacro(fDoc); end; procedure TCEMainForm.actEdMacStartStopExecute(Sender: TObject); begin if fDoc.isNotNil then begin if fEditWidg.macRecorder.State = msRecording then fEditWidg.macRecorder.Stop else fEditWidg.macRecorder.RecordMacro(fDoc); end; end; procedure TCEMainForm.actEdIndentExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.ExecuteCommand(ecBlockIndent, '', nil); end; procedure TCEMainForm.actEdUnIndentExecute(Sender: TObject); begin if fDoc.isNotNil then fDoc.ExecuteCommand(ecBlockUnIndent, '', nil); end; procedure TCEMainForm.actEdFindExecute(Sender: TObject); var win: TAnchorDockHostSite; str: string; begin win := DockMaster.GetAnchorSite(fFindWidg); if win.isNil then exit; win.Show; win.BringToFront; if fDoc.isNil then exit; // if fDoc.SelAvail then str := fDoc.SelText else str := fDoc.Identifier; ffindwidg.cbToFind.Text := str; ffindwidg.cbToFindChange(nil); end; procedure TCEMainForm.actEdFindNextExecute(Sender: TObject); begin ffindwidg.actFindNextExecute(nil); end; {$ENDREGION} {$REGION run -------------------------------------------------------------------} function TCEMainForm.runnableExename: string; begin result := ''; if fDoc.isNil then exit; result := stripFileExt(fDoc.fileName) + exeExt; if fDoc.isTemporary then exit; if fRunnableDestination.isNotEmpty then begin if not fAlwaysUseDest and assigned(fProject) and not fProject.isSource(fDoc.fileName) then exit; if FilenameIsAbsolute(fRunnableDestination) then begin if fRunnableDestination.dirExists then result := fRunnableDestination + stripFileExt(fDoc.fileName.extractFileName) + exeExt; end else begin result := fDoc.fileName.extractFilePath + fRunnableDestination + stripFileExt(fDoc.fileName.extractFileName) + exeExt; end; end; end; procedure TCEMainForm.asyncprocOutput(sender: TObject); var proc: TCEProcess; lst: TStringList; str: string; begin proc := TCEProcess(sender); lst := TStringList.Create; try proc.getFullLines(lst); //processOutputToStrings(proc, lst); if proc = fRunProc then for str in lst do fMsgs.message(str, fDoc, amcEdit, amkBub) else // dmd used to compile runnable for str in lst do fMsgs.message(str, fDoc, amcEdit, amkAuto); finally lst.Free; end; end; procedure TCEMainForm.asyncprocTerminate(sender: TObject); var proc: TCEProcess; inph: TObject; begin proc := TCEProcess(sender); asyncprocOutput(sender); inph := EntitiesConnector.getSingleService('ICEProcInputHandler'); if (inph <> nil) then (inph as ICEProcInputHandler).removeProcess(proc); if (proc.ExitStatus <> 0) then fMsgs.message(format('error: the process (%s) has returned the signal %d', [proc.Executable, proc.ExitStatus]), fDoc, amcEdit, amkErr); end; procedure TCEMainForm.actSetRunnableSwExecute(Sender: TObject); var form: TForm; memo: TMemo; i, j: integer; cur: string; begin if fRunnableSw = '' then fRunnableSw := '-vcolumns'#13'-w'#13'-wi'; form := TForm.Create(nil); form.BorderIcons:= [biSystemMenu]; memo := TMemo.Create(form); memo.Align := alClient; memo.BorderSpacing.Around:=4; memo.Text := fRunnableSw; memo.Parent := form; form.ShowModal; // fRunnableSw := ''; for i := memo.Lines.Count-1 downto 0 do begin cur := memo.Lines[i]; // duplicated item j := memo.Lines.IndexOf(cur); if (j > -1) and (j < i) then continue; // not a switch if cur.length < 2 then continue; if cur[1] <> '-' then continue; // added dynamically when needed if cur = '-unittest' then continue; if cur = '-main' then continue; // would break some internal stuff if (cur.length > 2) and (cur[1..3] = '-of') then continue; RemoveTrailingChars(cur, [#0..#30]); fRunnableSw += (cur + #13); end; if fRunnableSw.isNotEmpty and (fRunnableSw[fRunnableSw.length] = #13) then fRunnableSw := fRunnableSw[1..fRunnableSw.length-1]; if fRunnableSw.isEmpty then fRunnableSw := '-vcolumns'#13'-w'#13'-wi'; // form.Free; end; function TCEMainForm.compileRunnable(unittest: boolean = false): boolean; var i: integer; fname: string; dmdproc: TCEProcess; lst: TStringList = nil; firstLineFlags: string = ''; asObj: boolean = false; begin result := false; fMsgs.clearByData(fDoc); FreeRunnableProc; if fDoc.isNil then exit; if fDoc.Lines.Count = 0 then exit; firstlineFlags := fDoc.Lines[0]; i := firstlineFlags.length; if (i > 18) and (firstlineFlags.upperCase[1..17] = '#!RUNNABLE-FLAGS:') then begin firstlineFlags := fSymStringExpander.expand(firstlineFlags[18..i]); lst := TStringList.Create; CommandToList(firstlineFlags, lst); for i:= lst.Count-1 downto 0 do begin if (lst[i].length > 2) and (lst[i][1..3] = '-of') then begin lst.Delete(i); fMsgs.message('the option "-of" is not be handled in the runnable modules', fDoc, amcEdit, amkWarn); end else if lst[i] = '-c' then begin if not unittest then asObj:=true else begin lst.Delete(i); fMsgs.message('the option "-c" is not be handled when a module is tested', fDoc, amcEdit, amkWarn); end; end; end; end; dmdproc := TCEProcess.Create(nil); try fMsgs.message('compiling ' + shortenPath(fDoc.fileName, 25), fDoc, amcEdit, amkInf); if fDoc.fileName.fileExists then fDoc.save else fDoc.saveTempFile; fname := stripFileExt(runnableExename); if fRunnableSw.isEmpty then fRunnableSw := '-vcolumns'#13'-w'#13'-wi'; {$IFDEF RELEASE} dmdProc.ShowWindow := swoHIDE; {$ENDIF} dmdproc.OnReadData := @asyncprocOutput; dmdproc.OnTerminate:= @asyncprocTerminate; dmdproc.Options := [poUsePipes, poStderrToOutPut]; case fRunnableCompiler of dmd: dmdProc.Executable:='dmd' + exeExt; ldc: dmdProc.Executable:='ldmd2' + exeExt; gdc: dmdProc.Executable:='gdmd' + exeExt; end; dmdproc.Parameters.Add(fDoc.fileName); if not asObj then dmdproc.Parameters.Add('-of' + fname + exeExt) else dmdproc.Parameters.Add('-of' + fname + objExt); dmdproc.Parameters.Add('-J' + fDoc.fileName.extractFilePath); dmdproc.Parameters.AddText(fRunnableSw); if lst.isNotNil and (lst.Count <> 0) then dmdproc.Parameters.AddStrings(lst); if fAppliOpts.detectMain and not fDoc.implementMain then dmdproc.Parameters.Add('-main'); if unittest then begin if not fAppliOpts.detectMain then dmdproc.Parameters.Add('-main'); dmdproc.Parameters.Add('-unittest'); if fCovModUt then dmdproc.Parameters.Add('-cov'); end else dmdproc.Parameters.Add('-version=runnable_module'); if fAppliOpts.detectRunnableImports then LibMan.getLibsForSource(fDoc.Lines, dmdproc.Parameters, dmdproc.Parameters) else begin LibMan.getLibFiles(nil, dmdproc.Parameters); LibMan.getLibSources(nil, dmdproc.Parameters); end; deleteDups(dmdproc.Parameters); dmdproc.Execute; while dmdproc.Running do application.ProcessMessages; if not asObj then sysutils.DeleteFile(fname + objExt); if (dmdProc.ExitStatus = 0) then begin result := true; fMsgs.message(shortenPath(fDoc.fileName, 25) + ' successfully compiled', fDoc, amcEdit, amkInf); end else begin fMsgs.message(format('error: the process (%s) has returned the signal %d', [dmdproc.Executable, dmdproc.ExitStatus]), fDoc, amcEdit, amkErr); fMsgs.message(shortenPath(fDoc.fileName, 25) + ' has not been compiled', fDoc, amcEdit, amkErr); end; finally dmdproc.Free; if lst.isNotNil then lst.Free; end; end; procedure TCEMainForm.executeRunnable(unittest: boolean = false; redirect: boolean = true; const runArgs: string = ''); var lst: TStringList; fname: string; begin if fDoc.isNil then exit; fname := runnableExename; if not fname.fileExists then exit; fRunProc := TCEProcess.Create(nil); if redirect then begin fRunProc.Options := [poStderrToOutPut, poUsePipes]; fRunProc.ShowWindow := swoHIDE; fRunProc.OnReadData := @asyncprocOutput; fRunProc.OnTerminate:= @asyncprocTerminate; end else begin {$IFNDEF WINDOWS} fRunProc.Options := fRunProc.Options + [poNewConsole]; {$ENDIF} end; lst := TStringList.Create; try fRunProc.CurrentDirectory := fRunProc.Executable.extractFileDir; if runArgs.isNotEmpty then begin CommandToList(fSymStringExpander.expand(runArgs), lst); fRunProc.Parameters.AddStrings(lst); end; fRunProc.Executable := fname; if unittest and fCovModUt then fRunProc.OnTerminate:=@unittestDone; if redirect then getprocInputHandler.addProcess(fRunProc); fRunProc.Execute; finally lst.Free; end; end; procedure TCEMainForm.unittestDone(Sender: TObject); var fullcov: boolean; fname, covname: string; lst: TStringList; i: integer; begin asyncprocTerminate(sender); if fCovModUt then begin fname := stripFileExt(fDoc.fileName); fullcov := true; covname := ReplaceStr(fname + '.lst', DirectorySeparator, '-'); {$IFDEF WINDOWS} covname := ReplaceStr(covname, DriveSeparator, '-'); {$ENDIF} if covname.fileExists then begin lst := TStringList.Create; try lst.LoadFromFile(covname); for i := 0 to lst.Count-1 do if lst[i][1..7] = '0000000' then begin fMsgs.message(format('%s(%d): %s', [fDoc.fileName, i+1, 'not covered by the unittests']), fDoc, amcEdit, amkWarn); fullcov := false; end; sysutils.DeleteFile(covname); sysutils.DeleteFile('__main.lst'); if fullcov then fMsgs.message(shortenPath(fDoc.fileName, 25) + ' is 100% covered by the unittests', fDoc, amcEdit, amkInf); finally lst.free; end; end else fMsgs.message('the coverage file cannot be found', fDoc, amcEdit, amkWarn); end; end; procedure TCEMainForm.actFileUnittestExecute(Sender: TObject); begin if fDoc.isNil then exit; if compileRunnable(true) then executeRunnable(true, true); end; procedure TCEMainForm.actFileCompAndRunExecute(Sender: TObject); begin if fDoc.isNil then exit; if compileRunnable(false) then executeRunnable(false, true); end; procedure TCEMainForm.actFileCompileAndRunOutExecute(Sender: TObject); begin if fDoc.isNil then exit; if compileRunnable(false) then executeRunnable(false, false); end; procedure TCEMainForm.actFileCompAndRunWithArgsExecute(Sender: TObject); var runargs: string = ''; begin if fDoc.isNil then exit; if not InputQuery('Execution arguments', '', runargs) then exit; if compileRunnable(false) then executeRunnable(false, true, runargs); end; procedure TCEMainForm.actFileCompileExecute(Sender: TObject); begin compileRunnable(false); end; procedure TCEMainForm.actFileDscannerExecute(Sender: TObject); var lst: TStringList; prc: TProcess; pth: string; msg: string; begin if fDoc.isNil then exit; if fDoc.isTemporary and fDoc.modified then fDoc.saveTempFile; pth := exeFullName('dscanner' + exeExt); if not pth.fileExists then exit; prc := TProcess.Create(nil); lst := TStringList.Create; try prc.Executable:=pth; prc.Options := [poUsePipes, poStderrToOutPut {$IFDEF WINDOWS}, poNewConsole{$ENDIF}]; prc.ShowWindow:= swoHIDE; prc.Parameters.Add(fDoc.fileName); prc.Parameters.Add('-S'); if not fDscanUnittests then prc.Parameters.Add('--skipTests'); prc.Execute; processOutputToStrings(prc, lst); for msg in lst do fMsgs.message(msg, fDoc, amcEdit, amkAuto); finally prc.Free; lst.Free; end; end; procedure TCEMainForm.actFileNewDubScriptExecute(Sender: TObject); begin newFile; fDoc.Text := '/+ dub.sdl:' + LineEnding + ' name "dub_script" +/' + LineEnding + 'module dub_script;' + LineEnding + LineEnding + 'import std.stdio;' + LineEnding + LineEnding + 'void main(string[] args)' + LineEnding + '{' + LineEnding + '}'; fDoc.setFocus; end; procedure TCEMainForm.actFileRunDubExecute(Sender: TObject); begin dubFile(false); end; procedure TCEMainForm.actFileRunDubOutExecute(Sender: TObject); begin dubFile(true); end; procedure TCEMainForm.dubFile(outside: boolean); begin if fDoc = nil then exit; FreeRunnableProc; fRunProc := TCEProcess.Create(nil); if fDoc.fileName.fileExists then fDoc.save else fDoc.saveTempFile; fRunProc.Executable:= exeFullName('dub' + exeExt); fRunProc.Parameters.Add(fDoc.fileName); fRunProc.Execute; if not outside then begin fRunProc.Options := [poStderrToOutPut, poUsePipes]; fRunProc.ShowWindow := swoHIDE; fRunProc.OnReadData := @asyncprocOutput; fRunProc.OnTerminate:= @asyncprocTerminate; getprocInputHandler.addProcess(fRunProc); end else begin {$IFNDEF WINDOWS} fRunProc.Options := fRunProc.Options + [poNewConsole]; {$ENDIF} end; case fAppliOpts.runnableCompiler of gdc: fRunProc.Parameters.add('--compiler=gdc'); ldc: fRunProc.Parameters.add('--compiler=ldc2'); end; fRunProc.execute; end; procedure TCEMainForm.runFile(outside: boolean); var fname: string; older: boolean = false; exist: boolean = false; const messg: string = 'Either the runnable does not exist or it is older than its source.' + LineEnding + 'Do you wish to recompile it ?'; begin if fDoc.isNil then exit; FreeRunnableProc; fname := runnableExename; if fname.fileExists then begin exist := true; older := FileAge(fname) < FileAge(fDoc.fileName); end; if (not exist) or (older) then begin if dlgYesNo(messg) = mrYes then compileRunnable else if not exist then exit; end; if fname.fileExists then executeRunnable(false, not outside); end; procedure TCEMainForm.actFileRunExecute(Sender: TObject); begin runFile(false); end; procedure TCEMainForm.actFileRunOutExecute(Sender: TObject); begin runFile(true); end; procedure TCEMainForm.actFileOpenContFoldExecute(Sender: TObject); begin if fDoc.isNil then exit; if not fDoc.fileName.fileExists then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; getExplorer.browse(fDoc.fileName.extractFilePath); end; procedure TCEMainForm.actProjCompileExecute(Sender: TObject); begin if fAppliOpts.autoSaveProjectFiles then saveModifiedProjectFiles(fProject); fProject.compile; end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin fRunProjAfterCompile := true; if fAppliOpts.autoSaveProjectFiles then saveModifiedProjectFiles(fProject); fProject.compile; end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); begin fRunProjAfterCompile := true; fRunProjAfterCompArg := true; if fAppliOpts.autoSaveProjectFiles then saveModifiedProjectFiles(fProject); fProject.compile; end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); begin if fProject.binaryKind <> executable then begin dlgOkInfo('Non executable projects cant be run'); exit; end; if (not fProject.targetUpToDate) then if dlgYesNo('The project output is not up-to-date, rebuild ?') = mrYes then begin if fAppliOpts.autoSaveProjectFiles then saveModifiedProjectFiles(fProject); fProject.compile; end; if fProject.outputFilename.fileExists or (fProject.getFormat = pfDub) then fProject.run; end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); var runargs: string = ''; begin if InputQuery('Execution arguments', '', runargs) then fProject.run(runargs); end; {$ENDREGION} {$REGION view ------------------------------------------------------------------} procedure TCEMainForm.updateWidgetMenuEntry(sender: TObject); var widg: TCEWidget; act: TAction; begin if sender.isNil then exit; act := TAction(sender); if act.Tag = 0 then exit; // widg := TCEWidget(act.Tag); if widg.isDockable then begin if DockMaster.GetAnchorSite(widg).GetTopParent = DockMaster.GetAnchorSite(widg) then act.Enabled := true else act.Enabled := not widg.Parent.IsVisible end else act.Enabled := not widg.IsVisible; end; procedure TCEMainForm.widgetShowFromAction(sender: TObject); var widg: TCEWidget; begin widg := TCEWidget( TComponent(sender).tag ); if widg.isNil then exit; // widg.showWidget; end; procedure TCEMainForm.layoutLoadFromFile(const aFilename: string); var xcfg: TXMLConfigStorage; begin if not aFilename.fileExists then exit; // xcfg := TXMLConfigStorage.Create(aFilename, true); try DockMaster.RestoreLayouts.Clear; DockMaster.LoadLayoutFromConfig(xcfg, false); finally xcfg.Free; end; end; procedure TCEMainForm.layoutSaveToFile(const aFilename: string); var xcfg: TXMLConfigStorage; i: NativeInt; begin DockMaster.RestoreLayouts.Clear; for i:= 0 to fWidgList.Count-1 do begin if not fWidgList.widget[i].isDockable then continue; if DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState = wsMinimized then DockMaster.GetAnchorSite(fWidgList.widget[i]).Close else if not DockMaster.GetAnchorSite(fWidgList.widget[i]).HasParent then DockMaster.GetAnchorSite(fWidgList.widget[i]).Close; end; // forceDirectory(aFilename.extractFilePath); xcfg := TXMLConfigStorage.Create(aFilename + '.tmp', false); try DockMaster.SaveLayoutToConfig(xcfg); xcfg.WriteToDisk; // prevent any invalid layout to be saved (AnchorDocking bug) // TODO-cdocking: remove this when AnchorDocking wont save anymore invalid layout with TMemoryStream.Create do try LoadFromFile(aFilename + '.tmp'); if Size < 10000 then begin SaveToFile(aFilename); SysUtils.DeleteFile(aFilename + '.tmp'); end else getMessageDisplay.message('prevented an invalid layout to be saved', nil, amcApp, amkWarn); finally free; end; finally xcfg.Free; end; end; procedure TCEMainForm.layoutUpdateMenu; var lst: TStringList; itm: TMenuItem; i: NativeInt; begin mnuLayout.Clear; // itm := TMenuItem.Create(self); itm.Action := actLayoutSave; mnuLayout.Add(itm); mnuLayout.AddSeparator; // lst := TStringList.Create; try listFiles(lst, getCoeditDocPath + 'layouts' + DirectorySeparator); for i := 0 to lst.Count-1 do begin itm := TMenuItem.Create(self); itm.Caption := lst[i].extractFileName; itm.Caption := stripFileExt(itm.Caption); itm.OnClick := @layoutMnuItemClick; itm.ImageIndex := 32; mnuLayout.Add(itm); end; finally lst.Free; end; end; procedure TCEMainForm.layoutMnuItemClick(sender: TObject); begin layoutLoadFromFile(getCoeditDocPath + 'layouts' + DirectorySeparator + TMenuItem(sender).Caption + '.xml'); end; procedure TCEMainForm.actLayoutSaveExecute(Sender: TObject); var fname: string = ''; begin if not InputQuery('New layout name', '', fname) then exit; // fname := fname.extractFileName; if fname.extractFileExt <> '.xml' then fname += '.xml'; layoutSaveToFile(getCoeditDocPath + 'layouts' + DirectorySeparator + fname); layoutUpdateMenu; end; procedure TCEMainForm.updateFloatingWidgetOnTop(onTop: boolean); var widg: TCEWidget; const fstyle: array[boolean] of TFormStyle = (fsNormal, fsStayOnTop); begin for widg in fWidgList do if widg.Parent.isNotNil and widg.Parent.Parent.isNil and widg.isDockable then begin TForm(widg.Parent).FormStyle := fstyle[onTop]; //TODO-cbugfix: floating widg on top from true to false, widg remains on top // OK on linux (LCL 1.6.0), initially observed on win & LCL 1.4.2 if TForm(widg.Parent).Visible then if not onTop then TForm(widg.Parent).SendToBack; end; end; {$ENDREGION} {$REGION project ---------------------------------------------------------------} procedure TCEMainForm.showProjTitle; begin if (fProject <> nil) and fProject.filename.fileExists then caption := format('Coedit - %s', [shortenPath(fProject.filename, 30)]) else caption := 'Coedit'; end; procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); var fname: string; begin if fProject = nil then exit; if fProject.filename <> aEditor.fileName then exit; // fname := fProject.filename; fProject.getProject.Free; aEditor.saveToFile(fname); openProj(fname); end; procedure TCEMainForm.closeProj; begin if fProject = nil then exit; // if fProject = fFreeProj then begin fProject.getProject.Free; fFreeProj := nil; end; fProject := nil; fNativeProject := nil; fDubProject := nil; showProjTitle; end; procedure TCEMainForm.actProjNewDubJsonExecute(Sender: TObject); begin if (fProject <> nil) and not fProject.inGroup and fProject.modified and (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; newDubProj; end; procedure TCEMainForm.actProjNewNativeExecute(Sender: TObject); begin if (fProject <> nil) and not fProject.inGroup and fProject.modified and (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; newNativeProj; end; procedure TCEMainForm.newNativeProj; begin fNativeProject := TCENativeProject.Create(nil); fNativeProject.Name := 'CurrentProject'; fProject := fNativeProject as ICECommonProject; showProjTitle; end; procedure TCEMainForm.newDubProj; begin fDubProject := TCEDubProject.create(nil); fDubProject.json.Add('name', ''); fDubProject.beginModification; fDubProject.endModification; fProject := fDubProject as ICECommonProject; showProjTitle; end; procedure TCEMainForm.saveProj; begin fProject.saveToFile(fProject.filename); end; procedure TCEMainForm.saveProjAs(const aFilename: string); begin fProject.saveToFile(aFilename); showProjTitle; end; procedure TCEMainForm.openProj(const aFilename: string); begin closeProj; if aFilename.extractFileExt.upperCase = '.JSON' then newDubProj else newNativeProj; // fProject.loadFromFile(aFilename); showProjTitle; end; procedure TCEMainForm.mruProjItemClick(Sender: TObject); begin if (fProject <> nil) and not fProject.inGroup and fProject.modified and (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; openProj(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actProjCloseExecute(Sender: TObject); begin if (fProject <> nil) and not fProject.inGroup and fProject.modified and (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; closeProj; end; procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject); begin with TSaveDialog.Create(nil) do try if execute then saveProjAs(filename); finally Free; end; end; procedure TCEMainForm.actProjSaveExecute(Sender: TObject); begin if fProject = nil then exit; if fProject.filename.isNotEmpty then saveProj else actProjSaveAs.Execute; end; procedure TCEMainForm.actProjOpenExecute(Sender: TObject); begin if (fProject <> nil) and fProject.modified and (dlgFileChangeClose(fProject.filename) = mrCancel) then exit; with TOpenDialog.Create(nil) do try if execute then openProj(filename); finally Free; end; end; procedure TCEMainForm.actProjOptsExecute(Sender: TObject); var win: TControl = nil; begin if assigned(fProject) then case fProject.getFormat of pfDub: win := DockMaster.GetAnchorSite(fDubProjWidg); pfNative: win := DockMaster.GetAnchorSite(fPrjCfWidg); end else win := DockMaster.GetAnchorSite(fPrjCfWidg); if win.isNotNil then begin win.Show; win.BringToFront; end; end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin if fProject = nil then exit; if not fProject.filename.fileExists then exit; // openFile(fProject.filename); fDoc.isProjectDescription := true; if fProject.getFormat = pfNative then fDoc.Highlighter := LfmSyn else fDoc.Highlighter := JsSyn; end; procedure TCEMainForm.actProjOptViewExecute(Sender: TObject); begin if fProject = nil then exit; dlgOkInfo(fProject.getCommandLine); end; procedure TCEMainForm.actProjOpenGroupExecute(Sender: TObject); begin if (fProject <> nil) and not fProject.inGroup and fProject.modified then begin if dlgFileChangeClose(fProject.filename) = mrCancel then exit; fProject.getProject.Free; end; if fProjectGroup.groupModified then begin if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then exit; end; fProjectGroup.closeGroup; with TOpenDialog.Create(nil) do try if execute then fProjectGroup.openGroup(filename); finally free; end; end; procedure TCEMainForm.actProjSaveGroupAsExecute(Sender: TObject); begin with TSaveDialog.Create(nil) do try if execute then fProjectGroup.saveGroup(filename); finally free; end; end; procedure TCEMainForm.actProjSaveGroupExecute(Sender: TObject); begin if not fProjectGroup.groupFilename.fileExists then actProjSaveGroupAs.Execute else fProjectGroup.saveGroup(fProjectGroup.groupFilename); end; procedure TCEMainForm.actProjSelUngroupedExecute(Sender: TObject); begin if fFreeProj <> nil then fFreeProj.activate; end; procedure TCEMainForm.actNewGroupExecute(Sender: TObject); begin if fProjectGroup.groupModified then begin if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then exit; end; fProjectGroup.closeGroup; end; procedure TCEMainForm.actProjAddToGroupExecute(Sender: TObject); begin if fFreeProj = nil then exit; if fFreeProj.inGroup then exit; fProjectGroup.addProject(fFreeProj); fFreeProj := nil; end; procedure TCEMainForm.actProjGroupCompileExecute(Sender: TObject); var i: integer; begin if fProjectGroup.projectCount = 0 then exit; fGroupCompilationCnt := 0; fIsCompilingGroup := true; fMsgs.message('start compiling a project group...', nil, amcAll, amkInf); for i:= 0 to fProjectGroup.projectCount-1 do begin //TODO-cprojectgroup: verify that compilation is not paralell since the projects use an async proc. fProjectGroup.getProject(i).activate; fProject.compile; end; end; procedure TCEMainForm.actProjNewGroupExecute(Sender: TObject); begin if fProjectGroup.groupModified then begin if dlgFileChangeClose(fProjectGroup.groupFilename) = mrCancel then exit; end; fProjectGroup.closeGroup; end; {$ENDREGION} initialization registerClasses([TCEPersistentMainShortcuts, TCEPersistentMainMrus, TCELastDocsAndProjs, TCEApplicationOptionsBase, TCEApplicationOptions]); end.