unit ce_main; {$MODE OBJFPC}{$H+} {$INTERFACES CORBA} interface uses Classes, SysUtils, FileUtil, SynEditKeyCmds, SynHighlighterLFM, Forms, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls, Graphics, Dialogs, Menus, ActnList, ExtCtrls, process, XMLPropStorage, ComCtrls, dynlibs, ce_common, ce_dmdwrap, ce_project, ce_dcd, ce_plugin, ce_synmemo, ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_projconf, ce_search, ce_staticexplorer, ce_miniexplorer, ce_libman, ce_libmaneditor, ce_customtools, ce_observer; type TCEMainForm = class; // TODO-cfeature: input handling // TODO-cfeature: options // TODO-cwidget: options editor // TODO-cwidget: custom tools editor // TODO-cfeature: tools menu (** * Encapsulates the options in a writable component. *) TCEOptions = class(TComponent) private fFileMru, fProjMru: TMruFileList; fLeft, FTop, fWidth, fHeight: Integer; fErrorFlg: boolean; procedure setFileMru(aValue: TMruFileList); procedure setProjMru(aValue: TMruFileList); procedure saveLayout(str: TStream); procedure loadLayout(str: TStream); // procedure readerPropNoFound(Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); procedure readerError(Reader: TReader; const Message: string; var Handled: Boolean); published property APP_Left: Integer read fLeft write fLeft; property APP_Top: Integer read fTop write fTop; property APP_Width: Integer read fWidth write fWidth; property APP_Height: Integer read fHeight write fHeight; // property MRU_Files: TMruFileList read fFileMru write setFileMru; property MRU_Projects: TMruFileList read fProjMru write setProjMru; public constructor create(aOwner: TComponent); override; destructor destroy; override; procedure defineProperties(Filer: TFiler); override; procedure saveToFile(const aFilename: string); procedure loadFromFile(const aFilename: string); procedure beforeSave; procedure afterLoad; // property hasLoaded: boolean read fErrorFlg; end; { TCEMainForm } TCEMainForm = class(TForm, ICEMultiDocObserver) 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; actProjOpenContFold: TAction; actProjOptView: TAction; actProjSource: TAction; actProjRun: TAction; actProjRunWithArgs: TAction; actProjCompile: TAction; actProjCompileAndRun: TAction; actProjCompAndRunWithArgs: TAction; actProjClose: TAction; actProjOpts: TAction; actProjNew: 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; mnuItemMruFile: TMenuItem; mnuItemMruProj: TMenuItem; mnuItemWin: TMenuItem; MenuItem4: TMenuItem; MenuItem5: TMenuItem; MenuItem6: TMenuItem; MenuItem7: TMenuItem; MenuItem8: TMenuItem; MenuItem9: TMenuItem; 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 actFileOpenContFoldExecute(Sender: TObject); procedure actFileSaveAllExecute(Sender: TObject); procedure actEdIndentExecute(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 actProjNewExecute(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 ApplicationProperties1ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormDropFiles(Sender: TObject; const FileNames: array of String); private fDoc: TCESynMemo; fUpdateCount: NativeInt; fProject: TCEProject; fPlugList: TCEPlugDescriptorList; fWidgList: TCEWidgetList; fMesgWidg: TCEMessagesWidget; fEditWidg: TCEEditorWidget; fProjWidg: TCEProjectInspectWidget; fPrjCfWidg: TCEProjectConfigurationWidget; fStExpWidg: TCEStaticExplorerWidget; fFindWidg: TCESearchWidget; fExplWidg: TCEMiniExplorerWidget; fLibMWidg: TCELibManEditorWidget; fProjMru: TMruFileList; fFileMru: TMruFileList; fLibMan: TLibraryManager; fTools: TCETools; // ICEMultiDocObserver procedure docNew(const aDoc: TCESynMemo); procedure docClosing(const aDoc: TCESynMemo); procedure docFocused(const aDoc: TCESynMemo); procedure docChanged(const aDoc: TCESynMemo); //Init - Fina procedure getCMdParams; procedure checkCompilo; procedure InitLibMan; procedure InitTools; procedure InitMRUs; procedure InitWidgets; procedure InitPlugins; procedure InitDocking; procedure InitSettings; procedure SaveSettings; procedure LoadDocking; procedure SaveDocking; procedure KillPlugs; // widget interfaces subroutines procedure checkWidgetActions(const aWidget: TCEWidget); procedure widgetShowFromAction(sender: TObject); // run & exec sub routines procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = mcUnknown); procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); procedure compileProject(const aProject: TCEProject); procedure runProject(const aProject: TCEProject; const runArgs: string = ''); // file sub routines procedure newFile; function findFile(const aFilename: string): NativeInt; procedure saveFile(const edIndex: NativeInt); procedure saveFileAs(const edIndex: NativeInt; const aFilename: string); // project sub routines procedure saveProjSource(const aEditor: TCESynMemo); procedure newProj; procedure saveProj; procedure saveProjAs(const aFilename: string); procedure openProj(const aFilename: string); procedure closeProj; procedure addSource(const aFilename: string); // mru procedure mruChange(Sender: TObject); procedure mruFileItemClick(Sender: TObject); procedure mruProjItemClick(Sender: TObject); procedure mruClearClick(Sender: TObject); public constructor create(aOwner: TComponent); override; destructor destroy; override; procedure UpdateDockCaption(Exclude: TControl = nil); override; // procedure openFile(const aFilename: string); function expandSymbolicString(const symString: string): string; // property WidgetList: TCEWidgetList read fWidgList; property MessageWidget: TCEMessagesWidget read fMesgWidg; property LibraryManager: TLibraryManager read fLibMan; end; procedure PlugDispatchToHost(aPlugin: TCEPlugin; opCode: LongWord; data0: Integer; data1, data2: Pointer); cdecl; var CEMainForm: TCEMainForm; implementation {$R *.lfm} uses SynMacroRecorder, strutils; {$REGION Standard Comp/Obj------------------------------------------------------} constructor TCEMainForm.create(aOwner: TComponent); begin inherited create(aOwner); EntitiesConnector.addObserver(self); // InitMRUs; InitLibMan; InitTools; InitWidgets; InitDocking; InitSettings; // newProj; checkCompilo; getCMdParams; end; procedure TCEMainForm.checkCompilo; const msg = 'Coedit recquires DMD or DUB to be setup on this system' + LineEnding + 'If DMD is setup please add it to the system PATH variable before using Coedit'; begin if exeInSysPath('dmd') or exeInSysPath('dub') then exit; ce_common.dlgOkError(msg); close; end; procedure TCEMainForm.getCMdParams; var value: string; str: TStringList; begin if application.ParamCount > 0 then begin value := application.Params[1]; if value <> '' then begin str := TStringList.Create; try str.DelimitedText := value; for value in str do begin if fileExists(value) then openFile(value); end; finally str.Free; end; end; end; value := application.GetOptionValue('plugs'); if value <> 'OFF' then InitPlugins; value := application.GetOptionValue('p', 'project'); if (value <> '') and fileExists(value) then openProj(value); value := application.GetOptionValue('f', 'files'); if value <> '' then begin str := TStringList.Create; try str.DelimitedText := value; for value in str do begin if fileExists(value) then openFile(value); end; finally str.Free; end; end; end; procedure TCEMainForm.InitLibMan; var fname: string; begin fLibMan := TLibraryManager.create(self); fname := getDocPath + 'libraryManager.txt'; if fileExists(fname) then fLibMan.loadFromFile(fname); end; procedure TCEMainForm.InitTools; var fname: string; begin fTools := TCETools.create(self); fname := getDocPath + 'tools.txt'; if fileExists(fname) then fTools.loadFromFile(fname); end; procedure TCEMainForm.InitMRUs; begin fProjMru := TMruFileList.Create; fFileMru := TMruFileList.Create; fProjMru.objectTag := mnuItemMruProj; fFileMru.objectTag := mnuItemMruFile; fProjMru.OnChange := @mruChange; fFileMru.OnChange := @mruChange; end; procedure TCEMainForm.InitPlugins; var pth: string; fname: string; i: NativeInt; lst: TStringList; hdl: TLibHandle; plg: PPlugDescriptor; begin fPlugList := TCEPlugDescriptorList.Create; pth := extractFilePath(application.ExeName) + 'plugins'; lst := TStringList.Create; try listFiles(lst, pth, false); for i := 0 to lst.Count-1 do begin fname := lst.Strings[i]; if extractFileExt(fname) <> '.' + SharedSuffix then continue; hdl := LoadLibrary(fname); if hdl = NilHandle then continue; plg := new(PPlugDescriptor); plg^.Handle := hdl; plg^.HostCreatePlug := THostCreatePlug(GetProcAddress(hdl, 'createPlug')); plg^.HostDestroyPlug := THostDestroyPlug(GetProcAddress(hdl, 'destroyPlug')); plg^.HostDispatchToPlug := THostDispatchToPlug(GetProcAddress(hdl, 'dispatchToPlug')); if plg^.HostCreatePlug <> nil then plg^.Plugin := plg^.HostCreatePlug(@PlugDispatchToHost); if (plg^.HostCreatePlug = nil) or (plg^.HostDestroyPlug = nil) or (plg^.HostDispatchToPlug = nil) then begin Dispose(plg); {$IFDEF RELEASE} FreeLibrary(Hdl); {$ENDIF} continue; end; fPlugList.addPlugin(plg); end; finally lst.Free; end; 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); fStExpWidg:= TCEStaticExplorerWidget.create(self); fFindWidg := TCESearchWidget.create(self); fExplWidg := TCEMiniExplorerWidget.create(self); fLibMWidg := TCELibManEditorWidget.create(self); fWidgList.addWidget(@fMesgWidg); fWidgList.addWidget(@fEditWidg); fWidgList.addWidget(@fProjWidg); fWidgList.addWidget(@fPrjCfWidg); fWidgList.addWidget(@fStExpWidg); fWidgList.addWidget(@fFindWidg); fWidgList.addWidget(@fExplWidg); fWidgList.addWidget(@fLibMWidg); 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; itm := TMenuItem.Create(self); itm.Action := act; itm.Tag := ptrInt(widg); mnuItemWin.Add(itm); end; end; procedure TCEMainForm.InitDocking; var i: NativeInt; aManager: TAnchorDockManager; begin DockMaster.MakeDockSite(Self, [akBottom], admrpChild); DockMaster.OnShowOptions := @ShowAnchorDockOptions; DockMaster.HeaderStyle := adhsPoints; DockMaster.HideHeaderCaptionFloatingControl := true; if DockManager is TAnchorDockManager then begin aManager:=TAnchorDockManager(DockManager); aManager.PreferredSiteSizeAsSiteMinimum:=false; end; Height := 0; for i := 0 to fWidgList.Count-1 do begin DockMaster.MakeDockable(fWidgList.widget[i],true); DockMaster.GetAnchorSite(fWidgList.widget[i]).Header.HeaderPosition := adlhpTop; end; DockMaster.ManualDock(DockMaster.GetAnchorSite(fEditWidg), DockMaster.GetSite(Self), alBottom); DockMaster.ManualDock(DockMaster.GetAnchorSite(fMesgWidg), DockMaster.GetSite(Self), alBottom); DockMaster.ManualDock(DockMaster.GetAnchorSite(fStExpWidg), DockMaster.GetSite(Self), alLeft); DockMaster.ManualDock(DockMaster.GetAnchorSite(fFindWidg), DockMaster.GetAnchorSite(fStExpWidg), alBottom, fStExpWidg); width := width - fProjWidg.Width; DockMaster.ManualDock(DockMaster.GetAnchorSite(fProjWidg), DockMaster.GetSite(Self), alRight); DockMaster.ManualDock(DockMaster.GetAnchorSite(fPrjCfWidg), DockMaster.GetAnchorSite(fProjWidg), alBottom, fProjWidg); DockMaster.GetAnchorSite(fEditWidg).Header.HeaderPosition := adlhpTop; DockMaster.GetAnchorSite(fExplWidg).Close; DockMaster.GetAnchorSite(fLibMWidg).Close; LoadDocking; end; procedure TCEMainForm.InitSettings; var fname1: string; fname2: string; opts: TCEOptions; begin fname1 := getDocPath + 'options.txt'; fname2 := getDocPath + 'options.bak'; opts := TCEOptions.create(nil); try if fileExists(fname1) then begin opts.loadFromFile(fname1); if opts.hasLoaded then begin if fileExists(fname2) then sysutils.deleteFile(fname2); if not fileExists(fname2) then fileutil.copyFile(fname1, fname2, false); end; end; finally opts.Free; end; end; procedure TCEMainForm.SaveSettings; var opts: TCEOptions; begin opts := TCEOptions.create(nil); try forceDirectory(getDocPath); fLibMan.saveToFile(getDocPath + 'libraryManager.txt'); fTools.saveToFile(getDocPath + 'tools.txt'); opts.saveToFile(getDocPath + 'options.txt'); finally opts.Free; end; end; procedure TCEMainForm.SaveDocking; var xcfg: TXMLConfigStorage; i: NativeInt; begin if WindowState = wsMinimized then WindowState := wsNormal; for i:= 0 to fWidgList.Count-1 do begin if DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState = wsMinimized then DockMaster.GetAnchorSite(fWidgList.widget[i]).WindowState := wsNormal; DockMaster.GetAnchorSite(fWidgList.widget[i]).Show; end; if not Visible then exit; // forceDirectory(getDocPath); xcfg := TXMLConfigStorage.Create(getDocPath + 'docking.xml',false); try DockMaster.SaveLayoutToConfig(xcfg); xcfg.WriteToDisk; finally xcfg.Free; end; // xcfg := TXMLConfigStorage.Create(getDocPath + '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(getDocPath + 'docking.xml') then begin xcfg := TXMLConfigStorage.Create(getDocPath + 'docking.xml', true); try try DockMaster.LoadLayoutFromConfig(xcfg, false); except exit; end; str := TMemoryStream.Create; try xcfg.SaveToStream(str); str.saveToFile(getDocPath + 'docking.bak') finally str.Free; end; finally xcfg.Free; end; end; if fileExists(getDocPath + 'dockingopts.xml') then begin xcfg := TXMLConfigStorage.Create(getDocPath + 'dockingopts.xml', true); try try DockMaster.LoadSettingsFromConfig(xcfg); except exit; end; str := TMemoryStream.Create; try xcfg.SaveToStream(str); str.saveToFile(getDocPath + 'dockingopts.bak') finally str.Free; end; finally xcfg.Free; end; end; end; procedure TCEMainForm.KillPlugs; var descr: TPlugDescriptor; i: NativeInt; begin if fPlugList = nil then exit; for i := 0 to fPlugList.Count-1 do begin descr := fPlugList.plugin[i]; descr.HostDestroyPlug(descr.Plugin); {$IFDEF RELEASE} FreeLibrary(descr.Handle); {$ENDIF} end; while fPlugList.Count <> 0 do begin Dispose(PPlugDescriptor(fPlugList.Items[fPlugList.Count-1])); fPlugList.Delete(fPlugList.Count-1); end; fPlugList.Free; end; destructor TCEMainForm.destroy; begin EntitiesConnector.removeObserver(self); SaveSettings; // KillPlugs; // fWidgList.Free; fProjMru.Free; fFileMru.Free; fProject.Free; // 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 = nil then ce_common.dlgOkError(E.Message) else fMesgWidg.addCeErr(E.Message); end; procedure TCEMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); var i: NativeInt; ed: TCESynMemo; begin canClose := false; if fProject <> nil then if fProject.modified then if ce_common.dlgOkCancel('last project modifications are not saved, quit anyway ?') <> mrOK then exit; for i := 0 to fEditWidg.editorCount-1 do begin ed := fEditWidg.editor[i]; if ed.modified then if ce_common.dlgOkCancel(format ('last "%s" modifications are not saved, quit anyway ?', [shortenPath(ed.fileName, 25)])) <> mrOK then exit; end; canClose := true; // saving doesnt work when csDestroying in comp.state. SaveDocking; end; procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); var hasEd: boolean; hasProj: boolean; begin if fEditWidg = nil then exit; if fUpdateCount > 0 then exit; Inc(fUpdateCount); try hasEd := fDoc <> nil; if hasEd then begin actEdCopy.Enabled := fDoc.SelAvail and fEditWidg.Focused; // allows copy/cut/paste by shortcut on widgets actEdCut.Enabled := fDoc.SelAvail and fEditWidg.Focused; // actEdPaste.Enabled := fDoc.CanPaste and fEditWidg.Focused; {$IFDEF MSWINDOWS} // close file : raises a segfault on linux UndoStuff.>>fList<<.Count... actEdUndo.Enabled := fDoc.CanUndo; actEdRedo.Enabled := fDoc.CanRedo; {$ENDIF} actEdMacPlay.Enabled := true; actEdMacStartStop.Enabled := true; actEdIndent.Enabled := true; actEdUnIndent.Enabled := true; // actFileCompAndRun.Enabled := fDoc.isDSource; actFileCompAndRunWithArgs.Enabled := fDoc.isDSource; actFileSave.Enabled := true; actFileSaveAs.Enabled := true; actFileClose.Enabled := true; actFileSaveAll.Enabled := true; end else begin actEdCopy.Enabled := false; actEdCut.Enabled := false ; actEdPaste.Enabled := false; {$IFDEF MSWINDOWS} actEdUndo.Enabled := false; actEdRedo.Enabled := false; {$ENDIF} actEdMacPlay.Enabled := false; actEdMacStartStop.Enabled := false; actEdIndent.Enabled := false; actEdUnIndent.Enabled := false; // actFileCompAndRun.Enabled := false; actFileCompAndRunWithArgs.Enabled := false; actFileSave.Enabled := false; actFileSaveAs.Enabled := false; actFileClose.Enabled := false; actFileSaveAll.Enabled := false; end; hasProj := fProject <> nil; actProjSave.Enabled := hasProj; actProjSaveAs.Enabled := hasProj; actProjOpts.Enabled := hasProj; actProjClose.Enabled := hasProj; actProjCompile.Enabled := hasProj; actProjCompileAndRun.Enabled := hasProj; actProjCompAndRunWithArgs.Enabled := hasProj; actProjRun.Enabled := hasProj; actProjRunWithArgs.Enabled := hasProj; actProjSource.Enabled := hasProj; actProjOptView.Enabled := hasProj; actFileAddToProj.Enabled := hasEd and hasProj; finally Dec(fUpdateCount); end; end; procedure TCEMainForm.checkWidgetActions(const aWidget: TCEWidget); var tlt: string; cnt, i: NativeInt; prt, itm: TMenuItem; begin tlt := aWidget.contextName; if tlt = '' then exit; cnt := aWidget.contextActionCount; if cnt = 0 then exit; // prt := TMenuItem.Create(self); prt.Caption := tlt; mainMenu.Items.Add(prt); for i := 0 to cnt-1 do begin itm := TMenuItem.Create(prt); itm.Action := aWidget.contextAction(i); prt.Add(itm); end; end; procedure TCEMainForm.mruChange(Sender: TObject); var srcLst: TMruFileList; trgMnu: TMenuItem; itm: TMenuItem; fname: string; clickTrg: TNotifyEvent; i: NativeInt; begin srcLst := TMruFileList(Sender); if srcLst = nil then exit; trgMnu := TMenuItem(srcLst.objectTag); if trgMnu = nil 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 i:= 0 to srcLst.Count-1 do begin fname := srcLst.Strings[i]; itm := TMenuItem.Create(trgMnu); itm.Hint := fname; itm.Caption := shortenPath(fname, 50); 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: TMruFileList; begin srcLst := TMruFileList(TmenuItem(Sender).Tag); if srcLst = nil then exit; // srcLst.Clear; end; procedure TCEMainForm.ApplicationProperties1ShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); begin CanShow := true; {if EditWidget.currentEditor <> nil then if EditWidget.currentEditor.Focused then begin HintStr := EditWidget.getEditorHint; CanShow := HintStr <> ''; end;} end; {$ENDREGION} {$REGION ICEMultiDocMonitor ----------------------------------------------------} procedure TCEMainForm.docNew(const aDoc: TCESynMemo); begin fDoc := aDoc; end; procedure TCEMainForm.docClosing(const aDoc: TCESynMemo); begin if aDoc <> fDoc then exit; fDoc := nil; end; procedure TCEMainForm.docFocused(const aDoc: TCESynMemo); begin fDoc := aDoc; end; procedure TCEMainForm.docChanged(const aDoc: TCESynMemo); begin fDoc := aDoc; end; {$ENDREGION} {$REGION file ------------------------------------------------------------------} procedure TCEMainForm.newFile; begin if fEditWidg = nil then exit; fEditWidg.addEditor; end; function TCEMainForm.findFile(const aFilename: string): NativeInt; var i: NativeInt; begin result := -1; if fEditWidg = nil then exit; for i := 0 to fEditWidg.editorCount-1 do if fEditWidg.editor[i].fileName = aFilename then exit(i); end; procedure TCEMainForm.openFile(const aFilename: string); var i: NativeInt; begin if fEditWidg = nil then exit; // i := findFile(aFilename); if i > -1 then begin fEditWidg.PageControl.PageIndex := i; exit; end; i := fEditWidg.editorCount; fEditWidg.addEditor; fEditWidg.editor[i].loadFromFile(aFilename); fEditWidg.focusedEditorChanged; fFileMru.Insert(0,aFilename); end; procedure TCEMainForm.saveFile(const edIndex: NativeInt); var str: string; begin if fEditWidg = nil then exit; if edIndex >= fEditWidg.editorCount then exit; // if fEditWidg.editor[edIndex].Highlighter = LfmSyn then begin saveProjSource(fEditWidg.editor[edIndex]); exit; end; // str := fEditWidg.editor[edIndex].fileName; if str = '' then exit; fEditWidg.editor[edIndex].save; end; procedure TCEMainForm.saveFileAs(const edIndex: NativeInt; const aFilename: string); begin if fEditWidg = nil then exit; if edIndex < 0 then exit; if edIndex >= fEditWidg.editorCount then exit; // fEditWidg.editor[edIndex].saveToFile(aFilename); fFileMru.Insert(0, aFilename); end; procedure TCEMainForm.mruFileItemClick(Sender: TObject); begin openFile(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actFileOpenExecute(Sender: TObject); begin if fEditWidg = nil then exit; // with TOpenDialog.Create(nil) do try filter := DdiagFilter; if execute then begin openFile(filename); end; finally free; end; end; procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject); begin if fProject = nil then exit; if not fileExists(fProject.fileName) then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; fExplWidg.expandPath(extractFilePath(fProject.fileName)); end; procedure TCEMainForm.actFileNewExecute(Sender: TObject); begin newFile; end; procedure TCEMainForm.actFileNewRunExecute(Sender: TObject); begin newFile; fDoc.Text := 'module runnable;' + LineEnding + '' + LineEnding + 'import std.stdio;' + LineEnding + '' + LineEnding + 'void main(string args[])' + LineEnding + '{' + 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 + '}'; end; procedure TCEMainForm.actFileSaveAsExecute(Sender: TObject); begin if fEditWidg = nil then exit; if fEditWidg.editorIndex < 0 then exit; // with TSaveDialog.Create(nil) do try Filter := DdiagFilter; if execute then saveFileAs(fEditWidg.editorIndex, filename); finally free; end; end; procedure TCEMainForm.actFileSaveExecute(Sender: TObject); var str: string; begin if fDoc = nil then exit; // str := fDoc.fileName; if (str <> fDoc.tempFilename) and (fileExists(str)) then saveFile(fEditWidg.editorIndex) else actFileSaveAs.Execute; end; procedure TCEMainForm.actFileAddToProjExecute(Sender: TObject); var str: string; begin if fEditWidg = nil then exit; if fEditWidg.editorIndex < 0 then exit; if fEditWidg.editor[fEditWidg.editorIndex].isProjectSource then exit; // str := fEditWidg.editor[fEditWidg.editorIndex].fileName; if fileExists(str) then fProject.addSource(str) else dlgOkInfo('the file has not been added to the project because it does not exist'); end; procedure TCEMainForm.actFileCloseExecute(Sender: TObject); begin if fDoc = nil then exit; if fDoc.modified then if dlgOkCancel( 'The latest mdofifications are not saved, continue ?') = mrCancel then exit; // fEditWidg.removeEditor(fEditWidg.editorIndex); end; procedure TCEMainForm.actFileSaveAllExecute(Sender: TObject); var i: NativeInt; begin for i:= 0 to fEditWidg.editorCount-1 do saveFile(i); end; procedure TCEMainForm.FormDropFiles(Sender: TObject;const FileNames: array of String); var i: NativeInt; begin for i:= low(FileNames) to high(FileNames) do openFile(FileNames[i]); end; {$ENDREGION} {$REGION edit ------------------------------------------------------------------} procedure TCEMainForm.actEdCopyExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.CopyToClipboard; end; procedure TCEMainForm.actEdCutExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.CutToClipboard; end; procedure TCEMainForm.actEdPasteExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.PasteFromClipboard; end; procedure TCEMainForm.actEdUndoExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.Undo; end; procedure TCEMainForm.actEdRedoExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.Redo; end; procedure TCEMainForm.actEdMacPlayExecute(Sender: TObject); begin if assigned(fDoc) then fEditWidg.macRecorder.PlaybackMacro(fDoc); end; procedure TCEMainForm.actEdMacStartStopExecute(Sender: TObject); begin if assigned(fDoc) 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 assigned(fDoc) then fDoc.ExecuteCommand(ecBlockIndent, '', nil); end; procedure TCEMainForm.actEdUnIndentExecute(Sender: TObject); begin if assigned(fDoc) then fDoc.ExecuteCommand(ecBlockUnIndent, '', nil); end; procedure TCEMainForm.actEdFindExecute(Sender: TObject); var win: TAnchorDockHostSite; str: string; begin win := DockMaster.GetAnchorSite(fFindWidg); if win = nil then exit; win.Show; win.BringToFront; if fDoc = nil 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 -------------------------------------------------------------------} procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = mcUnknown); var str: TMemoryStream; lns: TStringList; readCnt: LongInt; readSz: LongInt; ioBuffSz: LongInt; dt: PMessageItemData; i: NativeInt; msg: string; begin If not (poUsePipes in aProcess.Options) then exit; // readCnt := 0; ioBuffSz := aProcess.PipeBufferSize; str := TMemorystream.Create; lns := TStringList.Create; readSz := 0; try repeat str.SetSize(readSz + ioBuffSz); readCnt := aProcess.Output.Read((str.Memory + readSz)^, ioBuffSz); Inc(readSz, readCnt); until readCnt = 0; Str.SetSize(readSz); lns.LoadFromStream(Str); for i:= 0 to lns.Count-1 do begin msg := lns.Strings[i]; dt := newMessageData; dt^.ctxt := aCtxt; dt^.project := fProject; dt^.position := getLineFromDmdMessage(msg); if openFileFromDmdMessage(msg) then dt^.ctxt := mcEditor; dt^.editor := fDoc; fEditWidg.endUpdatebyDelay; // messages would be cleared by the delayed module name detection. fMesgWidg.addMessage(msg, dt); application.ProcessMessages; end; finally str.Free; lns.Free; fMesgWidg.scrollToBack; end; end; procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); var editor: TCESynMemo; dmdproc: TProcess; runproc: TProcess; fname: string; begin dmdproc := TProcess.Create(nil); runproc := TProcess.Create(nil); editor := fEditWidg.editor[edIndex]; try fMesgWidg.ClearMessages(mcEditor); fMesgWidg.addCeInf('compiling ' + editor.fileName, mcEditor); if fileExists(editor.fileName) then editor.save else editor.saveToFile(editor.tempFilename); fname := editor.fileName[1..length(editor.fileName) - length(extractFileExt(editor.fileName))]; {$IFDEF RELEASE} dmdProc.ShowWindow := swoHIDE; {$ENDIF} dmdproc.Options := [poStdErrToOutput, poUsePipes]; dmdproc.Executable := DCompiler; dmdproc.Parameters.Add(editor.fileName); dmdproc.Parameters.Add('-w'); dmdproc.Parameters.Add('-wi'); dmdproc.Parameters.Add('-of' + fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF}); LibraryManager.getLibFiles(nil, dmdproc.Parameters); LibraryManager.getLibSources(nil, dmdproc.Parameters); dmdproc.Execute; repeat ProcessOutputToMsg(dmdproc, mcEditor) until not dmdproc.Running; if (dmdProc.ExitStatus = 0) then begin ProcessOutputToMsg(dmdproc, mcEditor); fMesgWidg.addCeInf(editor.fileName + ' successfully compiled', mcEditor ); runproc.Options := [poStderrToOutPut, poUsePipes]; runproc.CurrentDirectory := extractFilePath(runProc.Executable); runproc.Parameters.DelimitedText := expandSymbolicString(runArgs); runproc.Executable := fname {$IFDEF WINDOWS}+ '.exe'{$ENDIF}; runproc.Execute; repeat ProcessOutputToMsg(runproc, mcEditor) until not runproc.Running; {$IFDEF MSWINDOWS} sysutils.DeleteFile(fname + '.exe'); sysutils.DeleteFile(fname + '.obj'); {$ELSE} sysutils.DeleteFile(fname); sysutils.DeleteFile(fname + '.o'); {$ENDIF} end else begin ProcessOutputToMsg(dmdproc, mcEditor); fMesgWidg.addCeErr(editor.fileName + ' has not been compiled', mcEditor ); end; finally dmdproc.Free; runproc.Free; end; end; procedure TCEMainForm.compileProject(const aProject: TCEProject); var dmdproc: TProcess; ppproc: TProcess; olddir, prjpath: string; i: NativeInt; begin fMesgWidg.ClearAllMessages; //for i := 0 to fWidgList.Count-1 do //fWidgList.widget[i].projCompile(aProject); with fProject.currentConfiguration do begin if preBuildProcess.executable <> '' then if exeInSysPath(preBuildProcess.executable) then begin ppproc := TProcess.Create(nil); try preBuildProcess.setProcess(ppproc); for i:= 0 to ppproc.Parameters.Count-1 do ppproc.Parameters.Strings[i] := expandSymbolicString(ppproc.Parameters.Strings[i]); if ppproc.CurrentDirectory = '' then ppproc.CurrentDirectory := extractFilePath(ppproc.Executable); ppproc.Execute; if not (poWaitOnExit in ppproc.Options) then if poUsePipes in ppproc.Options then repeat ProcessOutputToMsg(ppproc, mcProject) until not ppproc.Running; finally ppproc.Free; end; end else fMesgWidg.addCeWarn('the pre-compilation executable does not exist', mcProject); end; if aProject.Sources.Count = 0 then begin fMesgWidg.addCeWarn('the project has no source files', mcProject); exit; end; olddir := ''; dmdproc := TProcess.Create(nil); getDir(0, olddir); try fMesgWidg.addCeInf( 'compiling ' + aProject.fileName, mcProject); application.ProcessMessages; prjpath := extractFilePath(aProject.fileName); if directoryExists(prjpath) then begin chDir(prjpath); dmdProc.CurrentDirectory := prjpath; end; {$IFDEF RELEASE} dmdProc.ShowWindow := swoHIDE; {$ENDIF} dmdproc.Options := [poStdErrToOutput, poUsePipes]; dmdproc.Executable := DCompiler; aProject.getOpts(dmdproc.Parameters); dmdproc.Execute; repeat ProcessOutputToMsg(dmdproc, mcProject) until not dmdproc.Running; if (dmdProc.ExitStatus = 0) then fMesgWidg.addCeInf(aProject.fileName + ' successfully compiled', mcProject) else fMesgWidg.addCeErr(aProject.fileName + ' has not been compiled', mcProject); with fProject.currentConfiguration do begin if postBuildProcess.executable <> '' then if exeInSysPath(postBuildProcess.executable) then begin ppproc := TProcess.Create(nil); try postBuildProcess.setProcess(ppproc); for i:= 0 to ppproc.Parameters.Count-1 do ppproc.Parameters.Strings[i] := expandSymbolicString(ppproc.Parameters.Strings[i]); if ppproc.CurrentDirectory = '' then ppproc.CurrentDirectory := extractFilePath(ppproc.Executable); ppproc.Execute; if not (poWaitOnExit in ppproc.Options) then if poUsePipes in ppproc.Options then repeat ProcessOutputToMsg(ppproc, mcProject) until not ppproc.Running; finally ppproc.Free; end; end else fMesgWidg.addCeWarn('the post-compilation executable does not exist', mcProject); end; finally dmdproc.Free; chDir(olddir); end; end; procedure TCEMainForm.runProject(const aProject: TCEProject; const runArgs: string = ''); var runproc: TProcess; procname, prm: string; i: NativeInt; begin if aProject.currentConfiguration.outputOptions.binaryKind <> executable then exit; //for i := 0 to fWidgList.Count-1 do //fWidgList.widget[i].projRun(aProject); runproc := TProcess.Create(nil); try aProject.currentConfiguration.runOptions.setProcess(runProc); prm := ''; i := 1; repeat prm := ExtractDelimited(i, runArgs, [' ']); prm := expandSymbolicString(prm); if prm <> '' then runProc.Parameters.AddText(prm); Inc(i); until prm = ''; procname := aProject.outputFilename; if not fileExists(procname) then begin fMesgWidg.addCeErr('output executable missing: ' + procname, mcProject); exit; end; // If poWaitonExit and if there are a lot of output then Coedit hangs. if poWaitonExit in runproc.Options then begin runproc.Options := runproc.Options - [poStderrToOutPut, poUsePipes]; runproc.Options := runproc.Options + [poNewConsole]; end; runproc.Executable := procname; if runproc.CurrentDirectory = '' then runproc.CurrentDirectory := extractFilePath(runproc.Executable); runproc.Execute; repeat ProcessOutputToMsg(runproc, mcProject) until not runproc.Running; finally runproc.Free; end; end; procedure TCEMainForm.actFileCompAndRunExecute(Sender: TObject); begin if fEditWidg = nil then exit; if fEditWidg.editorIndex < 0 then exit; // compileAndRunFile(fEditWidg.editorIndex); end; procedure TCEMainForm.actFileCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin if fEditWidg = nil then exit; if fEditWidg.editorIndex < 0 then exit; // runargs := ''; if InputQuery('Execution arguments', '', runargs) then compileAndRunFile(fEditWidg.editorIndex, runargs); end; procedure TCEMainForm.actFileOpenContFoldExecute(Sender: TObject); begin if fDoc = nil then exit; if not fileExists(fDoc.fileName) then exit; // DockMaster.GetAnchorSite(fExplWidg).Show; fExplWidg.expandPath(extractFilePath(fDoc.fileName)); end; procedure TCEMainForm.actProjCompileExecute(Sender: TObject); begin compileProject(fProject); end; procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject); begin compileProject(fProject); runProject(fProject); end; procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject); var runargs: string; begin compileProject(fProject); // runargs := ''; if InputQuery('Execution arguments', '', runargs) then runProject(fProject, runargs); end; procedure TCEMainForm.actProjRunExecute(Sender: TObject); var i: Integer; dt: double; label _rbld, _run; begin if fProject.currentConfiguration.outputOptions.binaryKind <> executable then begin // TODO-cfeature: define an alternative exe name for shared lib: // e.g: the dll produced by the proj. is the input filename of an host app. dlgOkInfo('Non executable projects cant be run'); exit; end; if not fileExists(fProject.outputFilename) then begin if dlgOkCancel('The project output is missing, build ?') <> mrOK then exit; goto _rbld; end; dt := fileAge(fProject.outputFilename); for i := 0 to fProject.Sources.Count-1 do begin if fileAge(fProject.getAbsoluteSourceName(i)) > dt then if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then goto _rbld else break; end; goto _run; _rbld: compileProject(fProject); _run: if fileExists(fProject.outputFilename) then runProject(fProject); end; procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject); var runargs: string; begin runargs := ''; if InputQuery('Execution arguments', '', runargs) then runProject(fProject, runargs); end; {$ENDREGION} {$REGION view ------------------------------------------------------------------} procedure TCEMainForm.widgetShowFromAction(sender: TObject); var widg: TCEWidget; win: TControl; begin widg := TCEWidget( TComponent(sender).tag ); if widg = nil then exit; win := DockMaster.GetAnchorSite(widg); if win = nil then exit; win.Show; win.BringToFront; end; {$ENDREGION} {$REGION project ---------------------------------------------------------------} procedure TCEMainForm.saveProjSource(const aEditor: TCESynMemo); begin if fProject = nil then exit; if fProject.fileName <> aEditor.fileName then exit; // aEditor.saveToFile(fProject.fileName); openProj(fProject.fileName); end; procedure TCEMainForm.closeProj; begin fProject.Free; fProject := nil; end; procedure TCEMainForm.newProj; begin fProject := TCEProject.Create(nil); fProject.Name := 'CurrentProject'; fProject.libraryManager := fLibMan; end; procedure TCEMainForm.saveProj; begin fProject.saveToFile(fProject.fileName); end; procedure TCEMainForm.saveProjAs(const aFilename: string); begin fProject.fileName := aFilename; fProject.saveToFile(fProject.fileName); fProjMru.Insert(0,fProject.fileName); end; procedure TCEMainForm.openProj(const aFilename: string); begin closeProj; newProj; fProject.loadFromFile(aFilename); fProjMru.Insert(0,aFilename); end; procedure TCEMainForm.mruProjItemClick(Sender: TObject); begin openProj(TMenuItem(Sender).Hint); end; procedure TCEMainForm.actProjNewExecute(Sender: TObject); begin if fProject <> nil then if fProject.modified then if dlgOkCancel( 'The latest mdofifications are not saved, continue ?') = mrCancel then exit; closeProj; newProj; end; procedure TCEMainForm.actProjCloseExecute(Sender: TObject); begin if fProject = nil then exit; if fProject.modified then if dlgOkCancel( 'The latest mdofifications are not saved, continue ?') = mrCancel then exit; closeProj; end; procedure TCEMainForm.addSource(const aFilename: string); begin if fProject.Sources.IndexOf(aFilename) >= 0 then exit; fProject.addSource(aFilename); 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.fileName <> '' then saveProj else actProjSaveAs.Execute; end; procedure TCEMainForm.actProjOpenExecute(Sender: TObject); begin if fProject <> nil then if fProject.modified then if dlgOkCancel( 'The latest mdofifications are not saved, continue ?') = 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; begin win := DockMaster.GetAnchorSite(fPrjCfWidg); if win = nil then exit; win.Show; win.BringToFront; end; procedure TCEMainForm.actProjSourceExecute(Sender: TObject); begin if fProject = nil then exit; if not fileExists(fProject.fileName) then exit; // openFile(fProject.fileName); fDoc.Highlighter := LfmSyn; end; procedure TCEMainForm.actProjOptViewExecute(Sender: TObject); var lst: TStringList; begin lst := TStringList.Create; try fProject.getOpts(lst); dlgOkInfo(lst.Text); finally lst.Free; end; end; {$ENDREGION} {$REGION options ---------------------------------------------------------------} constructor TCEOptions.create(aOwner: TComponent); begin inherited; fFileMru := TMruFileList.Create; fProjMru := TMruFileList.Create; // fLeft := 0; fTop := 0; fWidth := 800; fHeight := 600; end; destructor TCEOptions.destroy; begin fFileMru.Free; fProjMru.Free; inherited; end; procedure TCEOptions.readerPropNoFound(Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); begin Skip := true; Handled := true; end; procedure TCEOptions.readerError(Reader: TReader; const Message: string; var Handled: Boolean); begin Handled := true; fErrorFlg := false; end; procedure TCEOptions.setFileMru(aValue: TMruFileList); begin fFileMru.Assign(aValue); end; procedure TCEOptions.setProjMru(aValue: TMruFileList); begin fProjMru.Assign(aValue); end; procedure TCEOptions.saveLayout(str: TStream); var st: TXMLConfigStorage; cf: TPropStorageXMLConfig; begin cf := TPropStorageXMLConfig.Create(nil); st := TXMLConfigStorage.Create(cf); try DockMaster.SaveLayoutToConfig(st); cf.SaveToStream(str); str.Position := 0; finally st.Free; cf.Free; end; end; procedure TCEOptions.loadLayout(str: TStream); var st: TXMLConfigStorage; cf: TPropStorageXMLConfig; begin cf := TPropStorageXMLConfig.Create(nil); st := TXMLConfigStorage.Create(cf); try cf.LoadFromStream(str); DockMaster.LoadLayoutFromConfig(st,true); finally st.Free; cf.Free; end; end; procedure TCEOptions.defineProperties(Filer: TFiler); var i: NativeInt; begin inherited; // Filer is either a TReader or a TWriter for i := 0 to CEMainForm.WidgetList.Count-1 do CEMainForm.WidgetList.widget[i].declareProperties(Filer); end; procedure TCEOptions.beforeSave; var i: NativeInt; begin fLeft := CEMainForm.Left; fTop := CEMainForm.Top; fWidth := CEMainForm.Width; fHeight := CEMainForm.Height; // fFileMru.Assign(CEMainForm.fFileMru); fProjMru.Assign(CEMainForm.fProjMru); // for i := 0 to CEMainForm.WidgetList.Count-1 do CEMainForm.WidgetList.widget[i].beforeSave(nil); end; procedure TCEOptions.saveToFile(const aFilename: string); begin fErrorFlg := true; beforeSave; ce_common.saveCompToTxtFile(self, aFilename); end; procedure TCEOptions.loadFromFile(const aFilename: string); begin fErrorFlg := true; loadCompFromTxtFile(self, aFilename, @readerPropNoFound, @readerError); afterLoad; end; procedure TCEOptions.afterLoad; var i: NativeInt; begin CEMainForm.Left := fLeft; CEMainForm.Top := fTop; CEMainForm.Width := fWidth; CEMainForm.Height := fHeight; if fLeft < 0 then fLeft := 0; if fTop < 0 then fTop := 0; if fWidth < 800 then fWidth := 800; if fHeight < 600 then fWidth := 600; // CEMainForm.fFileMru.Assign(fFileMru); CEMainForm.fProjMru.Assign(fProjMru); // for i := 0 to CEMainForm.WidgetList.Count-1 do CEMainForm.WidgetList.widget[i].afterLoad(nil); end; {$ENDREGION} function TCEMainForm.expandSymbolicString(const symString: string): string; var elems: TStringList; elem: string; begs, ends: boolean; i: integer; begin if symString = '' then exit(symString); result := ''; elems := TStringList.Create; try i := 0; elem := ''; repeat inc(i); if not (symString[i] in ['<', '>']) then elem += symString[i] else begin if symString[i] = '<' then begs := true; ends := symString[i] = '>'; elems.Add(elem); elem := ''; if begs and ends then begin begs := false; ends := false; elems.Objects[elems.Count-1] := Self; end; end; until i = length(symString); elems.Add(elem); elem := ''; for i:= 0 to elems.Count-1 do begin if elems.Objects[i] = nil then result += elems.Strings[i] else case elems.Strings[i] of '<','>' : continue; 'CPF', 'CurrentProjectFile': begin result += '`'; if fProject <> nil then if fileExists(fProject.fileName) then result += fProject.fileName; result += '`'; end; 'CPP', 'CurrentProjectPath': begin result += '`'; if fProject <> nil then if fileExists(fProject.fileName) then result += extractFilePath(fProject.fileName); result += '`'; end; 'CPR', 'CurrentProjectRoot': begin result += '`'; if fProject <> nil then if directoryExists(fProject.getAbsoluteFilename(fProject.RootFolder)) then result += fProject.getAbsoluteFilename(fProject.RootFolder) else if directoryExists(fProject.RootFolder) then result += fProject.RootFolder; result += '`'; end; 'CFF', 'CurrentFileFile': begin result += '`'; if fDoc <> nil then if fileExists(fDoc.fileName) then result += fDoc.fileName; result += '`'; end; 'CFP', 'CurrentFilePath': begin result += '`'; if fDoc <> nil then if fileExists(fDoc.fileName) then result += extractFilePath(fDoc.fileName); result += '`'; end; 'CI', 'CurrentIdentifier': begin result += '`'; if fDoc <> nil then result += fDoc.Identifier; result += '`'; end; 'CAF', 'CoeditApplicationFile': result += '`' + application.ExeName + '`'; 'CAP', 'CoeditApplicationPath': result += '`' + extractFilePath(Application.ExeName) + '`'; end; end; finally elems.Free; end; end; procedure PlugDispatchToHost(aPlugin: TCEPlugin; opCode: LongWord; data0: Integer; data1, data2: Pointer); cdecl; var ctxt: NativeUint; oper: NativeUint; begin if opCode = HELLO_PLUGIN then begin dlgOkInfo('Hello plugin'); exit; end; ctxt := opCode and $0F000000; oper := opCode and $000FFFFF; case ctxt of CTXT_MSGS: case oper of DT_ERR: CEMainForm.MessageWidget.addCeErr(PChar(data1)); DT_INF: CEMainForm.MessageWidget.addCeInf(PChar(data1)); DT_WARN: CEMainForm.MessageWidget.addCeWarn(PChar(data1)); else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode'); end; CTXT_DLGS: case oper of DT_ERR: dlgOkError(PChar(data1)); DT_INF: dlgOkInfo(PChar(data1)); DT_WARN: dlgOkInfo(PChar(data1)); else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode'); end; else CEMainForm.MessageWidget.addCeWarn('unsupported dispatcher opCode'); end; end; initialization RegisterClasses([TCEOptions]); end.