mirror of https://gitlab.com/basile.b/dexed.git
3936 lines
108 KiB
Plaintext
3936 lines
108 KiB
Plaintext
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,
|
|
{$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML, fphttpclient,
|
|
fpjson, jsonparser, jsonscanner,
|
|
ce_common, ce_ceproject, ce_synmemo, ce_writableComponent,
|
|
ce_widget, ce_messages, ce_interfaces, ce_editor, ce_projinspect, ce_ceprojeditor,
|
|
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,{$IFDEF UNIX} ce_gdb,{$ENDIF}
|
|
ce_dfmt, ce_lcldragdrop, ce_projgroup, ce_projutils, ce_stringrange, ce_dastworx,
|
|
ce_halstead, ce_profileviewer, ce_semver, ce_dsgncontrols;
|
|
|
|
type
|
|
|
|
TCEApplicationOptions = class;
|
|
|
|
TAsyncWait = (awNo, awYes, awCustom);
|
|
|
|
TRunnableToFolderCondition = (
|
|
ifInProject, // runnable src is part of the project
|
|
ifNotSaved, // runnable src is an unsaved module (tmp_XXXXX)
|
|
ifSaved // runnable src not in project but saved not in temp dir
|
|
);
|
|
|
|
TRunnablesToFolderConditions = set of TRunnableToFolderCondition;
|
|
|
|
TCERunnableOptions = class(TWritableLfmTextComponent)
|
|
private
|
|
fCompiler: DCompiler;
|
|
fDetectMain: boolean;
|
|
fDetectLibraries: boolean;
|
|
fOutputFolder: TCEPathname;
|
|
fAlwaysToFolder: boolean;
|
|
fStaticSwitches: TStringList;
|
|
fToFolderConditions: TRunnablesToFolderConditions;
|
|
procedure setOutputFolder(const value: TCEPathname);
|
|
procedure setStaticSwitches(value: TStringList);
|
|
procedure setCompiler(value: DCompiler);
|
|
protected
|
|
procedure afterLoad; override;
|
|
published
|
|
property alwaysToFolder: boolean read fAlwaysToFolder write fAlwaysToFolder stored false; deprecated;
|
|
property compiler: DCompiler read fCompiler write setCompiler;
|
|
property detectMain: boolean read fDetectMain write fDetectMain;
|
|
property detectLibraries: boolean read fDetectLibraries write fDetectLibraries;
|
|
property outputFolder: TCEPathname read fOutputFolder write setOutputFolder;
|
|
property outputFolderConditions: TRunnablesToFolderConditions read fToFolderConditions write fToFolderConditions;
|
|
property staticSwitches: TStringList read fStaticSwitches write setStaticSwitches;
|
|
public
|
|
constructor create(aOwner: TComponent); override;
|
|
destructor destroy; override;
|
|
procedure assign(source: TPersistent); override;
|
|
procedure setDefaultSwitches;
|
|
procedure sanitizeSwitches;
|
|
end;
|
|
|
|
TCEEditableRunnableOptions = class(TCERunnableOptions, ICEEditableOptions)
|
|
private
|
|
fBackup: TCERunnableOptions;
|
|
function optionedWantCategory(): string;
|
|
function optionedWantEditorKind: TOptionEditorKind;
|
|
function optionedWantContainer: TPersistent;
|
|
procedure optionedEvent(event: TOptionEditorEvent);
|
|
function optionedOptionsModified: boolean;
|
|
public
|
|
constructor create(aOwner: TComponent); override;
|
|
destructor destroy; override;
|
|
end;
|
|
|
|
{ TCEMainForm }
|
|
TCEMainForm = class(TForm, ICEDocumentObserver, ICEEditableShortCut, ICEProjectObserver, ICEMainMenu)
|
|
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;
|
|
actFileMetricsHalstead: TAction;
|
|
actFileCloseAllOthers: TAction;
|
|
actFileCloseAll: TAction;
|
|
actFileNewClip: TAction;
|
|
actLayoutReset: TAction;
|
|
actProjDscan: TAction;
|
|
actProjGroupCompileCustomSync: TAction;
|
|
actProjGroupClose: TAction;
|
|
actProjGroupCompileSync: 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;
|
|
actProjEditor: 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;
|
|
mainMenu: TMainMenu;
|
|
MenuItem1: TMenuItem;
|
|
MenuItem10: TMenuItem;
|
|
MenuItem100: TMenuItem;
|
|
MenuItem101: TMenuItem;
|
|
MenuItem102: TMenuItem;
|
|
MenuItem103: TMenuItem;
|
|
MenuItem104: TMenuItem;
|
|
MenuItem105: TMenuItem;
|
|
MenuItem106: TMenuItem;
|
|
MenuItem107: TMenuItem;
|
|
MenuItem108: TMenuItem;
|
|
MenuItem109: TMenuItem;
|
|
MenuItem77: TMenuItem;
|
|
mnuOpts: TMenuItem;
|
|
mnuItemMruGroup: 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;
|
|
mnuProjNew: 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;
|
|
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;
|
|
MenuItem98: TMenuItem;
|
|
MenuItem99: TMenuItem;
|
|
mnuLayout: TMenuItem;
|
|
mnuItemMruFile: TMenuItem;
|
|
mnuItemMruProj: TMenuItem;
|
|
mnuItemWin: TMenuItem;
|
|
MenuItem4: TMenuItem;
|
|
MenuItem5: TMenuItem;
|
|
MenuItem6: TMenuItem;
|
|
MenuItem7: TMenuItem;
|
|
MenuItem8: TMenuItem;
|
|
MenuItem9: TMenuItem;
|
|
procedure actFileCloseAllExecute(Sender: TObject);
|
|
procedure actFileCloseAllOthersExecute(Sender: TObject);
|
|
procedure actFileCompileExecute(Sender: TObject);
|
|
procedure actFileDscannerExecute(Sender: TObject);
|
|
procedure actFileMetricsHalsteadExecute(Sender: TObject);
|
|
procedure actFileNewClipExecute(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 actLayoutResetExecute(Sender: TObject);
|
|
procedure actNewGroupExecute(Sender: TObject);
|
|
procedure actProjAddToGroupExecute(Sender: TObject);
|
|
procedure actProjDscanExecute(Sender: TObject);
|
|
procedure actProjGroupCompileCustomSyncExecute(Sender: TObject);
|
|
procedure actProjGroupCompileExecute(Sender: TObject);
|
|
procedure actProjGroupCompileSyncExecute(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 ApplicationProperties1Activate(Sender: TObject);
|
|
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
|
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 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 actProjEditorExecute(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 fnames: array of string);
|
|
|
|
protected
|
|
|
|
procedure DoFirstShow; override;
|
|
|
|
private
|
|
|
|
fImages: TImageList;
|
|
fOptionCategories: TCEEditableOptionsSubject;
|
|
fRunnablesOptions: TCEEditableRunnableOptions;
|
|
fSymStringExpander: ICESymStringExpander;
|
|
fProjectGroup: ICEProjectGroup;
|
|
fCovModUt: boolean;
|
|
fDscanUnittests: boolean;
|
|
fDoc: TCESynMemo;
|
|
fFirstTimeCoedit: boolean;
|
|
fMultidoc: ICEMultiDocHandler;
|
|
fScCollectCount: Integer;
|
|
fUpdateCount: NativeInt;
|
|
fProject: ICECommonProject;
|
|
fFreeProj: ICECommonProject;
|
|
fProjBeforeGroup: ICECommonProject;
|
|
fDubProject: TCEDubProject;
|
|
fNativeProject: TCENativeProject;
|
|
fProjMru: TCEMRUProjectList;
|
|
fFileMru: TCEMRUDocumentList;
|
|
fPrjGrpMru: TCEMRUProjectsGroupList;
|
|
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;
|
|
{$IFDEF UNIX}
|
|
fGdbWidg: TCEGdbWidget;
|
|
{$ENDIF}
|
|
fDfmtWidg: TCEDfmtWidget;
|
|
fProfWidg: TCEProfileViewerWidget;
|
|
fCompStart: TDateTime;
|
|
|
|
fRunProjAfterCompArg: boolean;
|
|
fRunProjAfterCompile: boolean;
|
|
fIsCompilingGroup: boolean;
|
|
fGroupCompilationCnt: integer;
|
|
fProjFromCommandLine: boolean;
|
|
fInitialized: boolean;
|
|
fRunProc: TCEProcess;
|
|
fMsgs: ICEMessagesDisplay;
|
|
fAppliOpts: TCEApplicationOptions;
|
|
fProjActionsLock: boolean;
|
|
fCompilerSelector: ICECompilerSelector;
|
|
procedure updateFloatingWidgetOnTop(onTop: boolean);
|
|
procedure widgetDockingChanged(sender: TCEWidget; newState: TWidgetDockingState);
|
|
procedure mnuOptsItemClick(sender: TObject);
|
|
|
|
|
|
// ICEMainMenu
|
|
function singleServiceName: string;
|
|
function mnuAdd: TMenuItem;
|
|
procedure mnuDelete(value: TMenuItem);
|
|
|
|
// ICEDocumentObserver
|
|
procedure docNew(document: TCESynMemo);
|
|
procedure docClosing(document: TCESynMemo);
|
|
procedure docFocused(document: TCESynMemo);
|
|
procedure docChanged(document: TCESynMemo);
|
|
|
|
// ICEProjectObserver
|
|
procedure projNew(project: ICECommonProject);
|
|
procedure projChanged(project: ICECommonProject);
|
|
procedure projClosing(project: ICECommonProject);
|
|
procedure projFocused(project: ICECommonProject);
|
|
procedure projCompiling(project: ICECommonProject);
|
|
procedure projCompiled(project: 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 InitImages;
|
|
procedure getCMdParams;
|
|
procedure InitMRUs;
|
|
procedure InitWidgets;
|
|
procedure InitDocking(reset: boolean = false);
|
|
procedure DefaultDocking;
|
|
procedure InitOptionsMenu;
|
|
procedure LoadSettings;
|
|
procedure SaveSettings;
|
|
function LoadDocking: boolean;
|
|
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(document: TCESynMemo);
|
|
procedure openFile(const fname: string);
|
|
|
|
// project sub routines
|
|
procedure saveProjSource(const document: TCESynMemo);
|
|
procedure newNativeProj;
|
|
procedure newDubProj;
|
|
procedure saveProj;
|
|
procedure saveProjAs(const fname: string);
|
|
procedure openProj(const fname: string);
|
|
function closeProj: boolean;
|
|
procedure showProjTitle;
|
|
function checkProjectLock(message: boolean = true): boolean;
|
|
procedure compileGroup(async: TAsyncWait);
|
|
|
|
// mru
|
|
procedure mruChange(Sender: TObject);
|
|
procedure mruFileItemClick(Sender: TObject);
|
|
procedure mruProjItemClick(Sender: TObject);
|
|
procedure mruProjGroupItemClick(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 fname: string);
|
|
procedure layoutSaveToFile(const fname: 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(value: TCollection);
|
|
published
|
|
property shortcut: TCollection read fCol write setCol;
|
|
public
|
|
constructor create(aOwner: TComponent); override;
|
|
destructor destroy; override;
|
|
//
|
|
procedure assign(source: TPersistent); override;
|
|
procedure assignTo(target: TPersistent); override;
|
|
end;
|
|
|
|
TCEPersistentMainMrus = class(TWritableLfmTextComponent)
|
|
private
|
|
fFileMruPt: TCEMRUFileList;
|
|
fProjMruPt: TCEMRUFileList;
|
|
fPrjGrpMruPt: TCEMRUFileList;
|
|
procedure setProjMru(value: TCEMRUFileList);
|
|
procedure setFileMru(value: TCEMRUFileList);
|
|
procedure setProjectsGroupMru(value: TCEMRUFileList);
|
|
published
|
|
property mostRecentFiles: TCEMRUFileList read fFileMruPt write setFileMru;
|
|
property mostRecentprojects: TCEMRUFileList read fProjMruPt write setProjMru;
|
|
property mostRecentProjectsGroups: TCEMRUFileList read fPrjGrpMruPt write setProjectsGroupMru;
|
|
public
|
|
procedure setTargets(projs: TCEMRUFileList; files: TCEMRUFileList; group: TCEMRUFileList);
|
|
end;
|
|
|
|
TCELastDocsAndProjs = class(TWritableLfmTextComponent)
|
|
private
|
|
fDocuments: TStringList;
|
|
fProject: string;
|
|
fDocIndex: integer;
|
|
fProjectGroup: string;
|
|
fProjectIndex: integer;
|
|
procedure setDocuments(value: 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(source: TPersistent); override;
|
|
procedure AssignTo(target: TPersistent); override;
|
|
end;
|
|
|
|
TCEApplicationOptionsBase = class(TWritableLfmTextComponent)
|
|
private
|
|
fFloatingWidgetOnTop: boolean;
|
|
fReloadLastDocuments: boolean;
|
|
fCovModUt: boolean;
|
|
fMaxRecentProjs: integer;
|
|
fMaxRecentDocs: integer;
|
|
fMaxRecentGroups: integer;
|
|
fDcdPort: word;
|
|
fDscanUnittests: boolean;
|
|
fAutoSaveProjectFiles: boolean;
|
|
fFlatLook: boolean;
|
|
fSplitterScrollSpeed: byte;
|
|
fAutoCheckUpdates: boolean;
|
|
fShowBuildDuration: boolean;
|
|
fToolBarScaling: TToolBarScaling;
|
|
function getConsoleProgram: string;
|
|
procedure setConsoleProgram(const value: string);
|
|
function getAdditionalPATH: string;
|
|
procedure setAdditionalPATH(const value: string);
|
|
function getNativeProjecCompiler: DCompiler;
|
|
procedure setNativeProjecCompiler(value: DCompiler);
|
|
procedure setSplitterScsrollSpeed(value: byte);
|
|
published
|
|
property additionalPATH: string read getAdditionalPATH write setAdditionalPath;
|
|
property autoCheckUpdates: boolean read fAutoCheckUpdates write fAutoCheckUpdates;
|
|
property consoleProgram: string read getConsoleProgram write setConsoleProgram;
|
|
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 maxRecentProjectsGroups: integer read fMaxRecentGroups write fMaxRecentGroups;
|
|
property nativeProjectCompiler: DCompiler read getNativeProjecCompiler write setNativeProjecCompiler;
|
|
property dscanUnittests: boolean read fDscanUnittests write fDscanUnittests default true;
|
|
property autoSaveProjectFiles: boolean read fAutoSaveProjectFiles write fAutoSaveProjectFiles default false;
|
|
property flatLook: boolean read fFlatLook write fFlatLook;
|
|
property splitterScrollSpeed: byte read fSplitterScrollSpeed write setSplitterScsrollSpeed;
|
|
property showBuildDuration: boolean read fShowBuildDuration write fShowBuildDuration default false;
|
|
property toolBarScaling: TToolBarScaling read fToolBarScaling write fToolBarScaling stored false;
|
|
// published for ICEEditableOptions but stored by DCD wrapper since it reloads before CEMainForm
|
|
property dcdPort: word read fDcdPort write fDcdPort stored false;
|
|
end;
|
|
|
|
TCEApplicationOptions = class(TCEApplicationOptionsBase, ICEEditableOptions)
|
|
private
|
|
fBackup:TCEApplicationOptionsBase;
|
|
//
|
|
function optionedWantCategory(): string;
|
|
function optionedWantEditorKind: TOptionEditorKind;
|
|
function optionedWantContainer: TPersistent;
|
|
procedure optionedEvent(event: TOptionEditorEvent);
|
|
function optionedOptionsModified: boolean;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure assign(source: TPersistent); override;
|
|
procedure assignTo(target: TPersistent); override;
|
|
end;
|
|
|
|
var
|
|
CEMainForm: TCEMainForm;
|
|
|
|
implementation
|
|
{$R *.lfm}
|
|
|
|
uses
|
|
SynMacroRecorder, ce_dcd, openssl;
|
|
|
|
{$REGION TCERunnableOptions ----------------------------------------------------}
|
|
constructor TCERunnableOptions.create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fStaticSwitches := TStringList.create;
|
|
fStaticSwitches.Duplicates := TDuplicates.dupIgnore;
|
|
fStaticSwitches.Sorted:=true;
|
|
end;
|
|
|
|
|
|
destructor TCERunnableOptions.destroy;
|
|
begin
|
|
fStaticSwitches.free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.assign(source: TPersistent);
|
|
var
|
|
src: TCERunnableOptions;
|
|
begin
|
|
if source is TCERunnableOptions then
|
|
begin
|
|
src := TCERunnableOptions(source);
|
|
fCompiler:= src.fCompiler;
|
|
fDetectMain:= src.fDetectMain;
|
|
fDetectLibraries:= src.fDetectLibraries;
|
|
fOutputFolder:= src.fOutputFolder;
|
|
fToFolderConditions:= src.fToFolderConditions;
|
|
fStaticSwitches.assign(src.fStaticSwitches);
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.setStaticSwitches(value: TStringList);
|
|
begin
|
|
fStaticSwitches.Assign(value);
|
|
sanitizeSwitches;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.afterLoad;
|
|
begin
|
|
inherited;
|
|
if fStaticSwitches.Count = 0 then
|
|
setDefaultSwitches
|
|
else
|
|
sanitizeSwitches;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.setDefaultSwitches;
|
|
begin
|
|
fStaticSwitches.Clear;
|
|
fStaticSwitches.AddStrings(['-vcolumns', '-w', '-wi']);
|
|
end;
|
|
|
|
procedure TCERunnableOptions.sanitizeSwitches;
|
|
var
|
|
i: integer;
|
|
sw: string;
|
|
lst: TStringList;
|
|
begin
|
|
lst := TStringList.Create;
|
|
try
|
|
for i:= 0 to fStaticSwitches.Count-1 do
|
|
begin
|
|
sw := fStaticSwitches[i];
|
|
RemovePadChars(sw, [#0..#32]);
|
|
// not a switch
|
|
if sw.length < 2 then
|
|
continue
|
|
else if sw[1] <> '-' then
|
|
continue
|
|
// set according to the context
|
|
else if sw = '-unittest' then
|
|
continue
|
|
else if sw = '-main' then
|
|
continue
|
|
// would break location detection
|
|
else if (sw.length > 2) and (sw[1..3] = '-of') then
|
|
continue
|
|
// useless
|
|
else if sw = '-run' then
|
|
continue
|
|
else
|
|
lst.Add(sw);
|
|
end;
|
|
fStaticSwitches.Assign(lst);
|
|
finally
|
|
lst.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.setOutputFolder(const value: TCEPathname);
|
|
begin
|
|
fOutputFolder := value;
|
|
if (length(fOutputFolder) > 0)
|
|
and (fOutputFolder[length(fOutputFolder)] <> DirectorySeparator) then
|
|
fOutputFolder += DirectorySeparator;
|
|
end;
|
|
|
|
procedure TCERunnableOptions.setCompiler(value: DCompiler);
|
|
begin
|
|
if fCompiler = value then
|
|
exit;
|
|
fCompiler := value;
|
|
if not getCompilerSelector.isCompilerValid(fCompiler) then
|
|
fCompiler := dmd;
|
|
fCompiler :=value;
|
|
end;
|
|
|
|
constructor TCEEditableRunnableOptions.create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fBackup := TCERunnableOptions.create(nil);
|
|
EntitiesConnector.addObserver(self);
|
|
end;
|
|
|
|
destructor TCEEditableRunnableOptions.destroy;
|
|
begin
|
|
fBackup.free;
|
|
EntitiesConnector.removeObserver(self);
|
|
inherited;
|
|
end;
|
|
|
|
function TCEEditableRunnableOptions.optionedWantCategory(): string;
|
|
begin
|
|
exit('Runnable modules');
|
|
end;
|
|
|
|
function TCEEditableRunnableOptions.optionedWantEditorKind: TOptionEditorKind;
|
|
begin
|
|
exit(oekGeneric);
|
|
end;
|
|
|
|
function TCEEditableRunnableOptions.optionedWantContainer: TPersistent;
|
|
begin
|
|
fBackup.assign(self);
|
|
exit(self);
|
|
end;
|
|
|
|
procedure TCEEditableRunnableOptions.optionedEvent(event: TOptionEditorEvent);
|
|
begin
|
|
case event of
|
|
oeeAccept:
|
|
begin
|
|
fBackup.assign(self);
|
|
sanitizeSwitches;
|
|
end;
|
|
oeeCancel: assign(fBackup);
|
|
oeeSelectCat: fBackup.assign(self);
|
|
end;
|
|
end;
|
|
|
|
function TCEEditableRunnableOptions.optionedOptionsModified: boolean;
|
|
begin
|
|
exit(false);
|
|
end;
|
|
{$ENDREGION --------------------------------------------------------------------}
|
|
|
|
{$REGION TCEApplicationOptions -------------------------------------------------}
|
|
constructor TCEApplicationOptions.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fBackup := TCEApplicationOptionsBase.Create(self);
|
|
EntitiesConnector.addObserver(self);
|
|
fDscanUnittests := true;
|
|
fSplitterScrollSpeed := 2;
|
|
fMaxRecentProjs := 10;
|
|
fMaxRecentDocs := 10;
|
|
fMaxRecentGroups:= 10;
|
|
fReloadLastDocuments:=true;
|
|
fFlatLook:=true;
|
|
end;
|
|
|
|
function TCEApplicationOptionsBase.getNativeProjecCompiler: DCompiler;
|
|
begin
|
|
exit(ce_ceproject.getCEProjectCompiler);
|
|
end;
|
|
|
|
procedure TCEApplicationOptionsBase.setNativeProjecCompiler(value: DCompiler);
|
|
begin
|
|
ce_ceproject.setCEProjectCompiler(value);
|
|
end;
|
|
|
|
procedure TCEApplicationOptionsBase.setSplitterScsrollSpeed(value: byte);
|
|
begin
|
|
if value < 1 then
|
|
value := 1
|
|
else if value > 10 then
|
|
value := 10;
|
|
fSplitterScrollSpeed:=value;
|
|
end;
|
|
|
|
function TCEApplicationOptionsBase.getAdditionalPATH: string;
|
|
begin
|
|
exit(ce_common.additionalPath);
|
|
end;
|
|
|
|
function TCEApplicationOptionsBase.getConsoleProgram: string;
|
|
begin
|
|
result := ce_common.consoleProgram;
|
|
end;
|
|
|
|
procedure TCEApplicationOptionsBase.setConsoleProgram(const value: string);
|
|
begin
|
|
if exeFullName(value).fileExists then
|
|
ce_common.consoleProgram:=value;
|
|
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(source: TPersistent);
|
|
begin
|
|
if source = CEMainForm then
|
|
begin
|
|
fMaxRecentProjs:= CEMainForm.fProjMru.maxCount;
|
|
fMaxRecentDocs:= CEMainForm.fFileMru.maxCount;
|
|
fMaxRecentGroups:= CEMainForm.fPrjGrpMru.maxCount;
|
|
fDcdPort := DcdWrapper.port;
|
|
fCovModUt:= CEMainForm.fCovModUt;
|
|
fDscanUnittests := CEMainForm.fDscanUnittests;
|
|
end else if source = fBackup then
|
|
begin
|
|
fCovModUt:=fBackup.fCovModUt;
|
|
fDcdPort:=fBackup.fDcdPort;
|
|
fMaxRecentDocs:= fBackup.fMaxRecentDocs;
|
|
fMaxRecentProjs:= fBackup.fMaxRecentProjs;
|
|
fMaxRecentGroups := fBackup.fMaxRecentGroups;
|
|
fReloadLastDocuments:=fBackup.fReloadLastDocuments;
|
|
fFloatingWidgetOnTop := fBackup.fFloatingWidgetOnTop;
|
|
fShowBuildDuration:= fBackup.fShowBuildDuration;
|
|
fAutoSaveProjectFiles:= fBackup.fAutoSaveProjectFiles;
|
|
fdscanUnittests:= fBackup.dscanUnittests;
|
|
fFlatLook:=fBackup.fFlatLook;
|
|
fAutoCheckUpdates:= fBackup.fAutoCheckUpdates;
|
|
CEMainForm.fDscanUnittests := fDscanUnittests;
|
|
nativeProjectCompiler:= fBackup.nativeProjectCompiler;
|
|
fToolBarScaling:= fBackup.fToolBarScaling;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TCEApplicationOptions.assignTo(target: TPersistent);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if target = CEMainForm then
|
|
begin
|
|
CEMainForm.fCovModUt:= fCovModUt;
|
|
CEMainForm.fProjMru.maxCount := fMaxRecentProjs;
|
|
CEMainForm.fFileMru.maxCount := fMaxRecentDocs;
|
|
CEMainForm.fPrjGrpMru.maxCount:= fMaxRecentGroups;
|
|
CEMainForm.updateFloatingWidgetOnTop(fFloatingWidgetOnTop);
|
|
CEMainForm.fDscanUnittests := fDscanUnittests;
|
|
DcdWrapper.port:=fDcdPort;
|
|
for i := 0 to CEMainForm.fWidgList.Count-1 do
|
|
begin
|
|
CEMainForm.fWidgList.widget[i].toolbarFlat:=fFlatLook;
|
|
CEMainForm.fWidgList.widget[i].toolbar.Scaling:= fToolBarScaling;
|
|
end;
|
|
end
|
|
else if target = fBackup then
|
|
begin
|
|
fBackup.fMaxRecentDocs:= fMaxRecentDocs;
|
|
fBackup.fMaxRecentProjs:= fMaxRecentProjs;
|
|
fBackup.fMaxRecentGroups:= fMaxRecentGroups;
|
|
fBackup.fReloadLastDocuments:=fReloadLastDocuments;
|
|
fBackup.fFloatingWidgetOnTop:=fFloatingWidgetOnTop;
|
|
fBackup.fDcdPort:=fDcdPort;
|
|
fBackup.fCovModUt:=fCovModUt;
|
|
fBackup.fAutoSaveProjectFiles:= fAutoSaveProjectFiles;
|
|
fBackup.fDscanUnittests:= fDscanUnittests;
|
|
fBackup.fFlatLook:= fFlatLook;
|
|
fBackup.fToolBarScaling:= fToolBarScaling;
|
|
fBackup.fAutoCheckUpdates:= fAutoCheckUpdates;
|
|
fBackup.fShowBuildDuration:= fShowBuildDuration;
|
|
fBackup.nativeProjectCompiler:= nativeProjectCompiler;
|
|
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(event: TOptionEditorEvent);
|
|
begin
|
|
case event 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(source: TPersistent);
|
|
var
|
|
grp: ICEProjectGroup;
|
|
prj: ICECommonProject = nil;
|
|
pix: integer;
|
|
begin
|
|
if source = CEMainForm then
|
|
begin
|
|
grp := getProjectGroup;
|
|
pix := grp.reloadedProjectIndex;
|
|
prj := CEMainForm.fFreeProj;
|
|
if assigned(prj) then
|
|
fProject := prj.filename;
|
|
fProjectGroup := getProjectGroup.groupFilename;
|
|
if prj = CEMainForm.fProject then
|
|
fProjectIndex :=- 1
|
|
else
|
|
fProjectIndex := pix;
|
|
end else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCELastDocsAndProjs.AssignTo(target: TPersistent);
|
|
var
|
|
dst: TCEMainForm;
|
|
hdl: ICEMultiDocHandler;
|
|
mem: TCESynMemo = nil;
|
|
grp: ICEProjectGroup;
|
|
begin
|
|
if target is TCEMainForm then
|
|
begin
|
|
dst := TCEMainForm(target);
|
|
if dst.fProjFromCommandLine 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 = pfCE then
|
|
mem.Highlighter := LfmSyn
|
|
else
|
|
mem.Highlighter := JsSyn;
|
|
end;
|
|
|
|
grp := getProjectGroup;
|
|
if fProjectGroup.isNotEmpty and fProjectGroup.fileExists then
|
|
grp.openGroup(fProjectGroup);
|
|
if (fProjectIndex = -1) and assigned(dst.fFreeProj) then
|
|
dst.fFreeProj.activate
|
|
else if (fProjectIndex >= 0) and (grp.projectCount > 0)
|
|
and (fProjectIndex < grp.projectCount) then
|
|
begin
|
|
grp.setProjectIndex(fProjectIndex);
|
|
grp.getProject(grp.getProjectIndex).activate;
|
|
end;
|
|
end
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TCELastDocsAndProjs.setDocuments(value: TStringList);
|
|
begin
|
|
fDocuments.Assign(value);
|
|
end;
|
|
|
|
procedure TCELastDocsAndProjs.beforeSave;
|
|
var
|
|
i: integer;
|
|
docHandler: ICEMultiDocHandler;
|
|
document: TCESynMemo;
|
|
str: string;
|
|
begin
|
|
docHandler := getMultiDocHandler;
|
|
if not assigned(docHandler) 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 not assigned(docHandler) 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(value: TCollection);
|
|
begin
|
|
fCol.Assign(value);
|
|
end;
|
|
|
|
procedure TCEPersistentMainShortcuts.assign(source: TPersistent);
|
|
var
|
|
itm: TCEPersistentShortcut;
|
|
i: Integer;
|
|
begin
|
|
fCol.Clear;
|
|
if source = 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(target: TPersistent);
|
|
var
|
|
itm: TCEPersistentShortcut;
|
|
i,j: Integer;
|
|
begin
|
|
if target = 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(value: TCEMRUFileList);
|
|
begin
|
|
fProjMruPt.assign(value);
|
|
end;
|
|
|
|
procedure TCEPersistentMainMrus.setFileMru(value: TCEMRUFileList);
|
|
begin
|
|
fFileMruPt.assign(value);
|
|
end;
|
|
|
|
procedure TCEPersistentMainMrus.setProjectsGroupMru(value: TCEMRUFileList);
|
|
begin
|
|
fPrjGrpMruPt.assign(value);
|
|
end;
|
|
|
|
procedure TCEPersistentMainMrus.setTargets(projs: TCEMRUFileList; files: TCEMRUFileList;
|
|
group: TCEMRUFileList);
|
|
begin
|
|
fFileMruPt := files;
|
|
fProjMruPt := projs;
|
|
fPrjGrpMruPt := group;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION Standard Comp/Obj------------------------------------------------------}
|
|
constructor TCEMainForm.create(aOwner: TComponent);
|
|
begin
|
|
inherited create(aOwner);
|
|
fOptionCategories := TCEEditableOptionsSubject.create;
|
|
|
|
EntitiesConnector.addObserver(self);
|
|
EntitiesConnector.addSingleService(self);
|
|
|
|
InitImages;
|
|
InitMRUs;
|
|
InitWidgets;
|
|
InitDocking;
|
|
LoadSettings;
|
|
layoutUpdateMenu;
|
|
fMultidoc := getMultiDocHandler;
|
|
OnDragDrop:= @ddHandler.DragDrop;
|
|
OnDragOver:= @ddHandler.DragOver;
|
|
|
|
EntitiesConnector.forceUpdate;
|
|
fSymStringExpander:= getSymStringExpander;
|
|
fProjectGroup := getProjectGroup;
|
|
fCompilerSelector := getCompilerSelector;
|
|
|
|
getCMdParams;
|
|
fAppliOpts.assignTo(self);
|
|
|
|
InitOptionsMenu;
|
|
|
|
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.InitOptionsMenu;
|
|
var
|
|
l: TStringList;
|
|
i: integer;
|
|
s: string;
|
|
t: TMenuItem;
|
|
e: ICEEditableOptions;
|
|
begin
|
|
l := TStringList.Create;
|
|
try
|
|
for i := 0 to fOptionCategories.observersCount-1 do
|
|
begin
|
|
e := fOptionCategories.observers[i] as ICEEditableOptions;
|
|
s := e.optionedWantCategory;
|
|
{$PUSH} {$WARNINGS OFF}
|
|
l.AddObject(s, TObject(e));
|
|
{$POP}
|
|
end;
|
|
l.Sort;
|
|
for i := 0 to l.Count-1 do
|
|
begin
|
|
t := TMenuItem.Create(self);
|
|
t.Caption := l[i];
|
|
t.Tag:= PtrInt(l.Objects[i]);
|
|
t.onClick := @mnuOptsItemClick;
|
|
mnuOpts.Add(t);
|
|
end;
|
|
finally
|
|
l.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.mnuOptsItemClick(sender: TObject);
|
|
var
|
|
c: ICEEditableOptions;
|
|
begin
|
|
c := ICEEditableOptions(TMenuItem(sender).Tag);
|
|
getOptionsEditor.showOptionEditor(c);
|
|
end;
|
|
|
|
procedure TCEMainForm.InitMRUs;
|
|
begin
|
|
fProjMru := TCEMRUProjectList.Create;
|
|
fFileMru := TCEMRUDocumentList.Create;
|
|
fPrjGrpMru:= TCEMRUProjectsGroupList.create;
|
|
fProjMru.objectTag := mnuItemMruProj;
|
|
fFileMru.objectTag := mnuItemMruFile;
|
|
fPrjGrpMru.objectTag := mnuItemMruGroup;
|
|
fProjMru.OnChange := @mruChange;
|
|
fFileMru.OnChange := @mruChange;
|
|
fPrjGrpMru.OnChange := @mruChange;
|
|
end;
|
|
|
|
procedure TCEMainForm.InitImages;
|
|
var
|
|
c: TIconScaledSize;
|
|
z: array[TIconScaledSize] of integer = (16, 24, 32);
|
|
i: integer;
|
|
|
|
function loadIcon(value: string): integer;
|
|
const
|
|
s: array[TIconScaledSize] of string = ('', '24', '32');
|
|
begin
|
|
result := fImages.AddResourceName(HINSTANCE, value + s[c]);
|
|
end;
|
|
|
|
begin
|
|
c := GetIconScaledSize;
|
|
|
|
fImages := TImageList.Create(self);
|
|
fImages.Width:= z[c];
|
|
fImages.Height:= z[c];
|
|
Actions.Images := fImages;
|
|
mainMenu.Images := fImages;
|
|
|
|
i := loadIcon('CROSS');
|
|
actFileClose.ImageIndex:= i;
|
|
actFileCloseAll.ImageIndex:= i;
|
|
actFileCloseAllOthers.ImageIndex:= i;
|
|
actProjClose.ImageIndex:= i;
|
|
actProjGroupClose.ImageIndex:=i;
|
|
|
|
i := loadIcon('ERROR_CHECKING');
|
|
actFileDscanner.ImageIndex := i;
|
|
actProjDscan.ImageIndex:= i;
|
|
actFileMetricsHalstead.ImageIndex:=i;
|
|
|
|
i := loadIcon('DISK');
|
|
actFileSave.ImageIndex:= i;
|
|
actProjSave.ImageIndex:= i;
|
|
actProjSaveGroup.ImageIndex:=i;
|
|
|
|
i := loadIcon('DISK_PEN');
|
|
actFileSaveAs.ImageIndex:= i;
|
|
actFileSaveCopyAs.ImageIndex:= i;
|
|
actProjSaveAs.ImageIndex:= i;
|
|
actProjSaveGroupAs.ImageIndex:= i;
|
|
|
|
i := loadIcon('DISK_MULTIPLE');
|
|
actFileSaveAll.ImageIndex := i;
|
|
|
|
i := loadIcon('FOLDER_VERTICAL_DOCUMENT');
|
|
actFileOpen.ImageIndex:= i;
|
|
actProjOpen.ImageIndex:= i;
|
|
actProjOpenGroup.ImageIndex:= i;
|
|
mnuItemMruFile.ImageIndex:= i;
|
|
mnuItemMruGroup.ImageIndex:= i;
|
|
mnuItemMruProj.ImageIndex:= i;
|
|
|
|
i := loadIcon('SCRIPT_GEAR');
|
|
actFileNewRun.ImageIndex:= i;
|
|
actFileCompAndRun.ImageIndex:= i;
|
|
actFileCompAndRunWithArgs.ImageIndex:= i;
|
|
actFileCompileAndRunOut.ImageIndex:= i;
|
|
actFileCompile.ImageIndex:= i;
|
|
actFileRun.ImageIndex:= i;
|
|
actFileRunOut.ImageIndex:= i;
|
|
actFileUnittest.ImageIndex:= i;
|
|
|
|
i := loadIcon('DOCUMENT');
|
|
actFileNew.ImageIndex:= i;
|
|
mnuProjNew.ImageIndex:= i;
|
|
actProjNewNative.ImageIndex:= i;
|
|
actProjNewDubJson.ImageIndex:= i;
|
|
actProjNewGroup.ImageIndex:= i;
|
|
|
|
i := loadIcon('DUB');
|
|
actFileNewDubScript.ImageIndex:= i;
|
|
actFileRunDub.ImageIndex:= i;
|
|
actFileRunDubOut.ImageIndex:= i;
|
|
|
|
i := loadIcon('FOLDERS_EXPLORER');
|
|
actFileOpenContFold.ImageIndex:= i;
|
|
actProjOpenContFold.ImageIndex:= i;
|
|
|
|
i := loadIcon('CUT');
|
|
actEdCut.ImageIndex:= i;
|
|
i := loadIcon('COPY');
|
|
actEdCopy.ImageIndex:= i;
|
|
i := loadIcon('PASTE');
|
|
actEdPaste.ImageIndex:= i;
|
|
actFileNewClip.ImageIndex:= i;
|
|
i := loadIcon('ARROW_UNDO');
|
|
actEdUndo.ImageIndex:= i;
|
|
i := loadIcon('ARROW_REDO');
|
|
actEdRedo.ImageIndex:= i;
|
|
i := loadIcon('FIND');
|
|
actEdFind.ImageIndex:= i;
|
|
actEdFindNext.ImageIndex:= i;
|
|
|
|
i := loadIcon('SYSTEM_RUN');
|
|
actProjCompile.ImageIndex:= i;
|
|
actProjCompileAndRun.ImageIndex:= i;
|
|
actProjCompAndRunWithArgs.ImageIndex:= i;
|
|
actProjGroupCompile.ImageIndex:= i;
|
|
actProjGroupCompileCustomSync.ImageIndex:= i;
|
|
actProjGroupCompileSync.ImageIndex:= i;
|
|
|
|
i := loadIcon('FLASH');
|
|
actProjRun.ImageIndex:= i;
|
|
actProjRunWithArgs.ImageIndex:= i;
|
|
|
|
i := loadIcon('LAYOUT');
|
|
mnuLayout.ImageIndex:= i;
|
|
|
|
i := LoadIcon('INDENT_MORE');
|
|
actEdIndent.ImageIndex:= i;
|
|
|
|
i := LoadIcon('INDENT_LESS');
|
|
actEdUnIndent.ImageIndex:= i;
|
|
|
|
i := LoadIcon('HTML_GO');
|
|
actFileHtmlExport.ImageIndex:=i;
|
|
|
|
i := LoadIcon('MOVE_TO_FOLDER');
|
|
actFileAddToProj.ImageIndex:=i;
|
|
end;
|
|
|
|
procedure TCEMainForm.InitWidgets;
|
|
var
|
|
widg: TCEWidget;
|
|
act: TAction;
|
|
itm: TMenuItem;
|
|
idx: integer;
|
|
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);
|
|
fProfWidg := TCEProfileViewerWidget.create(self);
|
|
{$IFDEF UNIX}
|
|
fGdbWidg := TCEGdbWidget.create(self);
|
|
{$ENDIF}
|
|
|
|
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(@fProfWidg);
|
|
{$IFDEF UNIX}
|
|
fWidgList.addWidget(@fGdbWidg);
|
|
{$ENDIF}
|
|
|
|
fWidgList.sort(@CompareWidgCaption);
|
|
|
|
case GetIconScaledSize of
|
|
iss16: idx := fImages.AddResourceName(HINSTANCE, 'APPLICATION');
|
|
iss24: idx := fImages.AddResourceName(HINSTANCE, 'APPLICATION24');
|
|
iss32: idx := fImages.AddResourceName(HINSTANCE, 'APPLICATION32');
|
|
end;
|
|
|
|
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 := idx;
|
|
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 := -240 * fAppliOpts.splitterScrollSpeed div WheelDelta;
|
|
splt := TAnchorDockSplitter(sender);
|
|
splt.MoveSplitter(offs);
|
|
if splt.ResizeAnchor in [akLeft, akRight] then
|
|
Mouse.CursorPos:= classes.Point(Mouse.CursorPos.X + offs, Mouse.CursorPos.Y)
|
|
else
|
|
Mouse.CursorPos:= classes.Point(Mouse.CursorPos.X, Mouse.CursorPos.Y + offs);
|
|
Handled := true;
|
|
end;
|
|
|
|
procedure TCEMainForm.setSplitterWheelEvent;
|
|
var
|
|
i: integer;
|
|
widg: TCEWidget;
|
|
site: TControl;
|
|
anchl: TAnchorKind;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
exit;
|
|
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
|
|
TAnchorDockHostSite(site).BoundSplitter.OnMouseWheel:= @DockSplitterMw;
|
|
end
|
|
else if site is TAnchorDockSplitter then
|
|
TAnchorDockSplitter(site).OnMouseWheel:= @DockSplitterMw;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.widgetDockingChanged(sender: TCEWidget; newState: TWidgetDockingState);
|
|
begin
|
|
setSplitterWheelEvent;
|
|
end;
|
|
|
|
procedure TCEMainForm.InitDocking(reset: boolean = false);
|
|
var
|
|
i: Integer;
|
|
widg: TCEWidget;
|
|
topsite : TControl;
|
|
topsplt : TAnchorDockSplitter;
|
|
begin
|
|
|
|
if not reset then
|
|
begin
|
|
DockMaster.MakeDockSite(Self, [akBottom], admrpChild);
|
|
DockMaster.OnShowOptions := @ShowAnchorDockOptions;
|
|
DockMaster.HeaderStyle := adhsPoints;
|
|
DockMaster.HideHeaderCaptionFloatingControl := true;
|
|
// 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;
|
|
widg.onDockingChanged:= @widgetDockingChanged;
|
|
end;
|
|
end;
|
|
|
|
// load existing or default docking
|
|
if not reset and FileExists(getCoeditDocPath + 'docking.xml') and LoadDocking() then
|
|
begin end
|
|
else
|
|
begin
|
|
|
|
if reset then
|
|
begin
|
|
for i := 0 to fWidgList.Count-1 do
|
|
begin
|
|
widg := fWidgList.widget[i];
|
|
if not widg.isDockable then
|
|
continue;
|
|
if not widg.Visible then
|
|
continue;
|
|
if widg = fEditWidg then
|
|
continue;
|
|
if DockMaster.GetAnchorSite(widg).isNotNil then
|
|
DockMaster.GetAnchorSite(widg).ManualFloat(widg.ClientRect, false);
|
|
end;
|
|
end;
|
|
|
|
if not reset then
|
|
begin
|
|
Height := 0;
|
|
end
|
|
else
|
|
begin
|
|
if WindowState = wsMaximized then
|
|
WindowState:= wsNormal;
|
|
Height := 600;
|
|
Width := 800;
|
|
end;
|
|
|
|
// center
|
|
if not reset then
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fEditWidg), DockMaster.GetSite(Self), alBottom);
|
|
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fMesgWidg), DockMaster.GetSite(fEditWidg), alBottom);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fLibMWidg), DockMaster.GetSite(fMesgWidg), alClient, fMesgWidg);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fTodolWidg), DockMaster.GetSite(fMesgWidg), alClient, fMesgWidg);
|
|
fMesgWidg.showWidget;
|
|
// left
|
|
DockMaster.GetAnchorSite(fSymlWidg).Width := 120;
|
|
DockMaster.GetAnchorSite(fFindWidg).Width := 120;
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fSymlWidg), DockMaster.GetSite(fEditWidg), alLeft);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fFindWidg), DockMaster.GetAnchorSite(fSymlWidg), alBottom, fSymlWidg);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fPrInpWidg), DockMaster.GetAnchorSite(fFindWidg), alTop, fFindWidg);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fExplWidg), DockMaster.GetSite(fSymlWidg), alClient, fSymlWidg);
|
|
if GetDockSplitter(DockMaster.GetSite(fPrInpWidg), akTop, topsplt) then
|
|
begin
|
|
topsplt.MoveSplitter(50);
|
|
topsplt := nil;
|
|
end;
|
|
fSymlWidg.showWidget;
|
|
// right
|
|
DockMaster.GetAnchorSite(fProjWidg).Width := 190;
|
|
DockMaster.GetAnchorSite(fDubProjWidg).Width := 190;
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fProjWidg), DockMaster.GetSite(fEditWidg), alRight);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fPrjGrpWidg), DockMaster.GetSite(fProjWidg), alBottom, fProjWidg);
|
|
DockMaster.ManualDock(DockMaster.GetAnchorSite(fDubProjWidg), DockMaster.GetAnchorSite(fProjWidg), alClient, fProjWidg);
|
|
fProjWidg.showWidget;
|
|
// 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;
|
|
WindowState:= wsMaximized;
|
|
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.DefaultDocking;
|
|
begin
|
|
|
|
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, fPrjGrpMru);
|
|
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;
|
|
// runnables opts
|
|
fRunnablesOptions := TCEEditableRunnableOptions.create(self);
|
|
fname := getCoeditDocPath + 'runnables.txt';
|
|
if fname.fileExists then
|
|
fRunnablesOptions.loadFromFile(fname);
|
|
// 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, fPrjGrpMru);
|
|
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');
|
|
// runnables opts
|
|
fRunnablesOptions.saveToFile(getCoeditDocPath + 'runnables.txt');
|
|
end;
|
|
|
|
procedure TCEMainForm.SaveDocking;
|
|
var
|
|
xcfg: TXMLConfigStorage;
|
|
i: integer;
|
|
begin
|
|
if not fInitialized or 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;
|
|
|
|
function TCEMainForm.LoadDocking: boolean;
|
|
var
|
|
xcfg: TXMLConfigStorage;
|
|
str: TMemoryStream;
|
|
begin
|
|
result := false;
|
|
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;
|
|
result := true;
|
|
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;
|
|
var
|
|
str: string;
|
|
begin
|
|
str := getCoeditDocPath + 'lastdocsandproj.txt';
|
|
if str.fileExists then
|
|
with TCELastDocsAndProjs.create(nil) do
|
|
try
|
|
loadFromFile(str);
|
|
assignTo(self);
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
function checkForUpdate: string;
|
|
const
|
|
updURL = 'https://api.github.com/repos/BBasile/Coedit/releases/latest';
|
|
var
|
|
prs: TJSONParser = nil;
|
|
dat: TJSONData = nil;
|
|
tgg: TJSONData = nil;
|
|
url: TJSONData = nil;
|
|
str: string = '';
|
|
cli: TFPHTTPClient = nil;
|
|
lst: TStringList = nil;
|
|
res: TResourceStream = nil;
|
|
svo: TSemVer;
|
|
sva: TSemVer;
|
|
begin
|
|
result := '';
|
|
|
|
if openssl.IsSSLloaded then
|
|
begin
|
|
try
|
|
cli := TFPHTTPClient.Create(nil);
|
|
try
|
|
cli.AllowRedirect:=true;
|
|
cli.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)');
|
|
str := cli.Get(updURL);
|
|
finally
|
|
cli.free;
|
|
end;
|
|
except
|
|
dlgOkError('The latest release cannot be determined (HTTP client)');
|
|
end;
|
|
end
|
|
|
|
else if not openssl.IsSSLloaded and exeFullName('curl').isNotEmpty then
|
|
begin
|
|
if not process.RunCommand('curl', [updURL], str) then
|
|
begin
|
|
dlgOkError('The latest release cannot be determined (CURL)');
|
|
exit;
|
|
end
|
|
end
|
|
else
|
|
begin
|
|
dlgOkInfo('No suitable tool can be used to determine the latest version.' +
|
|
'Install at least CURL as a command line tool, visible in the PATH.' +
|
|
'Newest OpenSSL versions (>= 1.1) are currently not supported');
|
|
exit;
|
|
end;
|
|
|
|
prs := TJSONParser.Create(str, [joUTF8, joIgnoreTrailingComma]);
|
|
try
|
|
dat := prs.Parse;
|
|
if dat.isNotNil then
|
|
begin
|
|
url := dat.FindPath('html_url');
|
|
tgg := dat.FindPath('tag_name');
|
|
if url.isNotNil and tgg.isNotNil and (tgg.AsString <> '3_update_5') then
|
|
begin
|
|
res:= TResourceStream.Create(HINSTANCE, 'VERSION', RT_RCDATA);
|
|
lst := TstringList.Create;
|
|
lst.LoadFromStream(res);
|
|
str := lst.Text;
|
|
sva.init(str, false);
|
|
str := tgg.AsString;
|
|
svo.init(str, false);
|
|
if svo.valid and sva.valid and (svo > sva) then
|
|
result := url.AsString;
|
|
end;
|
|
end;
|
|
finally
|
|
prs.Free;
|
|
dat.free;
|
|
lst.free;
|
|
res.free;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TCEMainForm.DoFirstShow;
|
|
var
|
|
url: string;
|
|
begin
|
|
inherited;
|
|
// 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 not assigned(fProject) then
|
|
newDubProj;
|
|
|
|
DockMaster.ResetSplitters;
|
|
setSplitterWheelEvent;
|
|
|
|
if fFirstTimeCoedit then
|
|
begin
|
|
actFileNewRun.Execute;
|
|
if fInfoWidg.hasMissingTools then
|
|
fInfoWidg.showWidget;
|
|
end;
|
|
|
|
if fAppliOpts.autoCheckUpdates then
|
|
begin
|
|
url := checkForUpdate;
|
|
if url <> '' then
|
|
begin
|
|
if dlgYesNo('An new release is available, do you wish to visit the release page ?' +
|
|
lineEnding + '(' + url +')') = mrYes then
|
|
openUrl(url);
|
|
end;
|
|
end;
|
|
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;
|
|
|
|
destructor TCEMainForm.destroy;
|
|
begin
|
|
SaveSettings;
|
|
//
|
|
fWidgList.Free;
|
|
fProjMru.Free;
|
|
fFileMru.Free;
|
|
fPrjGrpMru.Free;
|
|
FreeRunnableProc;
|
|
//
|
|
fOptionCategories.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;
|
|
f: string = '';
|
|
p: string = '';
|
|
g: string = #9'no';
|
|
c: boolean = false;
|
|
d: TCESynMemo = nil;
|
|
b: TTaskDialogBaseButtonItem = nil;
|
|
|
|
const
|
|
s: string = 'The following content is modified and changes will be lost'#10#10 +
|
|
'- Modified files:'#10' %s '#10 +
|
|
'- Modified projects:'#10' %s '#10 +
|
|
'- Project group modified:'#10' %s';
|
|
begin
|
|
canClose := false;
|
|
|
|
if checkProjectLock(false) and
|
|
(dlgOkCancel('A project is still being compiled, close anyway ?') <> mrOK) then
|
|
exit;
|
|
|
|
if assigned(fFreeProj) and fFreeProj.modified then
|
|
begin
|
|
p += #9 + fFreeProj.filename + LineEnding;
|
|
c := true;
|
|
end;
|
|
|
|
for i := 0 to fMultidoc.documentCount-1 do
|
|
begin
|
|
d := fMultidoc.getDocument(i);
|
|
d.disableFileDateCheck := true;
|
|
if d.modified or d.isTemporary then
|
|
begin
|
|
f += #9 + shortenPath(d.filename) + LineEnding;
|
|
c := true;
|
|
end;
|
|
end;
|
|
|
|
for i:= 0 to fProjectGroup.projectCount-1 do
|
|
begin
|
|
if not fProjectGroup.projectModified(i) then
|
|
continue;
|
|
p += #9 + shortenPath(fProjectGroup.getProject(i).filename) + LineEnding;
|
|
c := true;
|
|
end;
|
|
|
|
if fProjectGroup.groupModified then
|
|
begin
|
|
g := #9'yes';
|
|
c := true;
|
|
end;
|
|
|
|
if c then
|
|
begin
|
|
BringToFront;
|
|
if p.isEmpty then
|
|
p := '(no modified projects)'#10;
|
|
if f.isEmpty then
|
|
f := '(no modified files)'#10;
|
|
|
|
with TTaskDialog.Create(nil) do
|
|
try
|
|
MainIcon := TTaskDialogIcon.tdiWarning;
|
|
CommonButtons := [];
|
|
Text := format(s, [f, p, g]);
|
|
|
|
b := Buttons.Add;
|
|
b.Caption := 'Quit';
|
|
b.ModalResult := mrOK;
|
|
|
|
b := Buttons.Add;
|
|
b.Caption := 'Save and quit';
|
|
b.ModalResult := mrAll;
|
|
|
|
b := Buttons.Add;
|
|
b.Caption := 'Do no quit';
|
|
b.ModalResult := mrCancel;
|
|
|
|
if Execute then
|
|
begin
|
|
if ModalResult = mrCancel then
|
|
begin
|
|
for i := 0 to fMultidoc.documentCount-1 do
|
|
begin
|
|
d := fMultidoc.getDocument(i);
|
|
d.disableFileDateCheck := false;
|
|
end;
|
|
exit;
|
|
end
|
|
else if ModalResult = mrAll then
|
|
begin
|
|
for i := 0 to fMultidoc.documentCount-1 do
|
|
begin
|
|
d := fMultidoc.document[i];
|
|
if d.modified and not d.isTemporary then
|
|
d.save;
|
|
end;
|
|
if assigned(fProject) and fProject.modified then
|
|
fProject.saveToFile(fProject.filename);
|
|
for i := 0 to fProjectGroup.projectCount-1 do
|
|
if fProjectGroup.projectModified(i) then
|
|
fProjectGroup.getProject(i).saveToFile(fProjectGroup.getProject(i).filename);
|
|
if fProjectGroup.groupModified then
|
|
fProjectGroup.saveGroup(fProjectGroup.groupFilename);
|
|
end;
|
|
end;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
SaveLastDocsAndProj;
|
|
CanClose:= true;
|
|
fProjectGroup.closeGroup;
|
|
if assigned(fFreeProj) then
|
|
fFreeProj.getProject.Free;
|
|
for i:= fMultidoc.documentCount-1 downto 0 do
|
|
fMultidoc.closeDocument(i, false);
|
|
end;
|
|
|
|
procedure TCEMainForm.updateDocumentBasedAction(sender: TObject);
|
|
begin
|
|
TAction(sender).Enabled := fDoc.isNotNil;
|
|
end;
|
|
|
|
procedure TCEMainForm.updateProjectBasedAction(sender: TObject);
|
|
begin
|
|
TAction(sender).Enabled := assigned(fProject) {and not fProjActionsLock};
|
|
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.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
|
|
else if srcLst = fPrjGrpMru then
|
|
clickTrg:= @mruProjGroupItemClick;
|
|
|
|
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.isNotNil then
|
|
srcLst.Clear;
|
|
end;
|
|
|
|
{$ENDREGION}
|
|
|
|
{$REGION ICEMultiDocMonitor ----------------------------------------------------}
|
|
procedure TCEMainForm.docNew(document: TCESynMemo);
|
|
begin
|
|
fDoc := document;
|
|
end;
|
|
|
|
procedure TCEMainForm.docClosing(document: TCESynMemo);
|
|
begin
|
|
if document <> fDoc then
|
|
exit;
|
|
fDoc := nil;
|
|
end;
|
|
|
|
procedure TCEMainForm.docFocused(document: TCESynMemo);
|
|
begin
|
|
fDoc := document;
|
|
end;
|
|
|
|
procedure TCEMainForm.docChanged(document: TCESynMemo);
|
|
begin
|
|
fDoc := document;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION ICEProjectObserver ----------------------------------------------------}
|
|
procedure TCEMainForm.projNew(project: ICECommonProject);
|
|
begin
|
|
fProject := project;
|
|
case fProject.getFormat of
|
|
pfCE: fNativeProject := TCENativeProject(fProject.getProject);
|
|
pfDUB: fDubProject := TCEDubProject(fProject.getProject);
|
|
end;
|
|
if not fProject.inGroup then
|
|
fFreeProj := project;
|
|
end;
|
|
|
|
procedure TCEMainForm.projChanged(project: ICECommonProject);
|
|
begin
|
|
showProjTitle;
|
|
end;
|
|
|
|
procedure TCEMainForm.projClosing(project: ICECommonProject);
|
|
begin
|
|
if project = fFreeProj then
|
|
fFreeProj := nil;
|
|
if fProject <> project then
|
|
exit;
|
|
fProject := nil;
|
|
fDubProject := nil;
|
|
fNativeProject := nil;
|
|
showProjTitle;
|
|
end;
|
|
|
|
procedure TCEMainForm.projFocused(project: ICECommonProject);
|
|
begin
|
|
fProject := project;
|
|
case fProject.getFormat of
|
|
pfCE: fNativeProject := TCENativeProject(fProject.getProject);
|
|
pfDUB: fDubProject := TCEDubProject(fProject.getProject);
|
|
end;
|
|
if not fProject.inGroup then
|
|
fFreeProj := project
|
|
else if project = fFreeProj then
|
|
fFreeProj := nil;
|
|
|
|
showProjTitle;
|
|
end;
|
|
|
|
procedure TCEMainForm.projCompiling(project: ICECommonProject);
|
|
begin
|
|
fProjActionsLock := true;
|
|
end;
|
|
|
|
procedure TCEMainForm.projCompiled(project: ICECommonProject; success: boolean);
|
|
var
|
|
runArgs: string = '';
|
|
runprev: boolean = true;
|
|
groupok: boolean = true;
|
|
i: integer;
|
|
begin
|
|
fProjActionsLock := false;
|
|
if not fIsCompilingGroup then
|
|
begin
|
|
if fAppliOpts.showBuildDuration then
|
|
begin
|
|
fCompStart := Time - fCompStart;
|
|
fMsgs.message('Build duration: ' + TimeToStr(fCompStart), project, amcProj, amkInf);
|
|
end;
|
|
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
|
|
groupok := false;
|
|
break;
|
|
end;
|
|
if not groupok then
|
|
fMsgs.message('error, the project group is not fully compiled', nil, amcAll, amkErr)
|
|
else
|
|
fMsgs.message('the project group is successfully compiled', nil, amcAll, amkInf);
|
|
if fAppliOpts.showBuildDuration then
|
|
begin
|
|
fCompStart := Time - fCompStart;
|
|
fMsgs.message('Group build duration: ' + TimeToStr(fCompStart), nil, amcAll, amkInf);
|
|
end;
|
|
if assigned(fProjBeforeGroup) then
|
|
fProjBeforeGroup.activate;
|
|
fProjBeforeGroup := nil;
|
|
fIsCompilingGroup := false;
|
|
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) and (act.Caption = identifier) then
|
|
act.ShortCut := aShortcut;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.scedSendDone;
|
|
begin
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION ICEMAinMenu -----------------------------------------------------------}
|
|
function TCEMainForm.singleServiceName: string;
|
|
begin
|
|
exit('ICEMainMenu');
|
|
end;
|
|
|
|
function TCEMainForm.mnuAdd: TMenuItem;
|
|
begin
|
|
result := TMenuItem.Create(nil);
|
|
mainMenu.Items.Add(result);
|
|
exit(result);
|
|
end;
|
|
|
|
procedure TCEMainForm.mnuDelete(value: TMenuItem);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if value.isNil then
|
|
exit;
|
|
i := mainMenu.Items.IndexOf(value);
|
|
if i <> -1 then
|
|
mainMenu.Items.Delete(i);
|
|
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
|
|
filename := FileName.normalizePath;
|
|
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 fname: string);
|
|
begin
|
|
fMultidoc.openDocument(fname);
|
|
end;
|
|
|
|
procedure TCEMainForm.saveFile(document: TCESynMemo);
|
|
begin
|
|
if (document.Highlighter = LfmSyn) or (document.Highlighter = JsSyn) then
|
|
saveProjSource(document)
|
|
else if document.fileName.fileExists then
|
|
document.save;
|
|
end;
|
|
|
|
procedure TCEMainForm.mruFileItemClick(Sender: TObject);
|
|
begin
|
|
openFile(TMenuItem(Sender).Hint);
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileOpenExecute(Sender: TObject);
|
|
var
|
|
fname: string;
|
|
begin
|
|
with TOpenDialog.Create(nil) do
|
|
try
|
|
if fDoc.isNotNil and not fDoc.isTemporary and fDoc.fileName.fileExists then
|
|
initialDir := fDoc.fileName.extractFileDir;
|
|
options := options + [ofAllowMultiSelect];
|
|
filter := DdiagFilter;
|
|
if execute then
|
|
for fname in files do
|
|
openFile(fname.normalizePath);
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjOpenContFoldExecute(Sender: TObject);
|
|
begin
|
|
if not assigned(fProject) or 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 not fDoc.isTemporary and fDoc.fileName.fileExists then
|
|
InitialDir := fDoc.fileName.extractFileDir;
|
|
if execute then
|
|
fDoc.saveToFile(filename.normalizePath);
|
|
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 or not assigned(fProject) then
|
|
exit;
|
|
if fProject.filename = fDoc.fileName then
|
|
exit;
|
|
|
|
if fProject.getFormat = pfCE 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 fnames: array of string);
|
|
var
|
|
fname: string;
|
|
begin
|
|
for fname in fnames 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 fDoc.fileName.fileExists and not fDoc.isTemporary then
|
|
InitialDir := fDoc.fileName.extractFileDir;
|
|
if execute then
|
|
begin
|
|
str := TStringList.create;
|
|
try
|
|
str.assign(fDoc.Lines);
|
|
str.saveToFile(FileName.normalizePath);
|
|
finally
|
|
str.free;
|
|
end;
|
|
end;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actLayoutResetExecute(Sender: TObject);
|
|
begin
|
|
InitDocking(true);
|
|
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
|
|
if fDoc.isNil then
|
|
exit;
|
|
win := DockMaster.GetAnchorSite(fFindWidg);
|
|
if win.isNil then
|
|
exit;
|
|
win.Show;
|
|
win.BringToFront;
|
|
|
|
if fDoc.SelAvail then
|
|
str := fDoc.SelText
|
|
else
|
|
str := fDoc.Identifier;
|
|
ffindwidg.cbToFind.Text := str;
|
|
ffindwidg.cbToFindChange(nil);
|
|
ffindwidg.cbToFind.SetFocus;
|
|
end;
|
|
|
|
procedure TCEMainForm.actEdFindNextExecute(Sender: TObject);
|
|
begin
|
|
ffindwidg.actFindNextExecute(nil);
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
{$REGION run -------------------------------------------------------------------}
|
|
function TCEMainForm.runnableExename: string;
|
|
var
|
|
of_yes: string;
|
|
of_no: string;
|
|
begin
|
|
result := '';
|
|
if fDoc.isNil then
|
|
exit;
|
|
|
|
of_no := fDoc.fileName.stripFileExt + exeExt;
|
|
of_yes:= fRunnablesOptions.outputFolder;
|
|
|
|
if not FilenameIsAbsolute(of_yes) then
|
|
of_yes := fDoc.fileName.extractFilePath + of_yes +
|
|
fDoc.fileName.extractFileName.stripFileExt + exeExt
|
|
else
|
|
of_yes := fRunnablesOptions.outputFolder +
|
|
fDoc.fileName.extractFileName.stripFileExt + exeExt;
|
|
result := of_no;
|
|
|
|
if fRunnablesOptions.outputFolderConditions <> [] then
|
|
begin
|
|
if ifNotSaved in fRunnablesOptions.outputFolderConditions then
|
|
begin
|
|
if fDoc.isTemporary then
|
|
result := of_yes;
|
|
end
|
|
else if assigned(fProject) then
|
|
begin
|
|
if ifInProject in fRunnablesOptions.outputFolderConditions then
|
|
begin
|
|
if fProject.isSource(fDoc.fileName) then
|
|
result := of_yes;
|
|
end
|
|
else if ifSaved in fRunnablesOptions.outputFolderConditions then
|
|
begin
|
|
if not fProject.isSource(fDoc.fileName) and not fDoc.isTemporary then
|
|
result := of_yes;
|
|
end;
|
|
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);
|
|
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.isNotNil 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;
|
|
begin
|
|
if fRunnablesOptions.fStaticSwitches.Count = 0 then
|
|
fRunnablesOptions.setDefaultSwitches;
|
|
form := TForm.Create(nil);
|
|
form.BorderIcons:= [biSystemMenu];
|
|
memo := TMemo.Create(form);
|
|
memo.Align := alClient;
|
|
memo.BorderSpacing.Around:=4;
|
|
memo.Lines.Assign(fRunnablesOptions.staticSwitches);
|
|
memo.Parent := form;
|
|
form.ShowModal;
|
|
|
|
fRunnablesOptions.staticSwitches.Assign(memo.Lines);
|
|
fRunnablesOptions.sanitizeSwitches;
|
|
|
|
form.Free;
|
|
end;
|
|
|
|
procedure TCEMainForm.ApplicationProperties1Activate(Sender: TObject);
|
|
begin
|
|
if fDoc.isNotNil then
|
|
fDoc.checkFileDate;
|
|
end;
|
|
|
|
function TCEMainForm.compileRunnable(unittest: boolean = false): boolean;
|
|
var
|
|
i: integer;
|
|
fname: string;
|
|
dmdproc: TCEProcess;
|
|
lst: TStringList = nil;
|
|
firstLineFlags: string = '';
|
|
asObj: boolean = false;
|
|
hasMain: THasMain;
|
|
rng: TStringRange = (ptr:nil; pos:0; len: 0);
|
|
begin
|
|
|
|
result := false;
|
|
fMsgs.clearByData(fDoc);
|
|
FreeRunnableProc;
|
|
if fDoc.isNil or (fDoc.Lines.Count = 0) then
|
|
exit;
|
|
|
|
firstlineFlags := fDoc.Lines[0];
|
|
rng.init(firstLineFlags);
|
|
if rng.startsWith('#!') then
|
|
begin
|
|
rng.popFrontN(2)^
|
|
.popWhile([' ', #9])^
|
|
.popUntil([' ', #9, ':'])^
|
|
.popWhile([' ', #9, ':']);
|
|
firstlineFlags := rng.takeUntil(#0).yield;
|
|
firstlineFlags := fSymStringExpander.expand(firstlineFlags);
|
|
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
|
|
else if lst[i] = '-run' then
|
|
lst.Delete(i);
|
|
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 := runnableExename.stripFileExt;
|
|
|
|
if fRunnablesOptions.staticSwitches.Count = 0 then
|
|
fRunnablesOptions.setDefaultSwitches;
|
|
{$IFDEF RELEASE}
|
|
dmdProc.ShowWindow := swoHIDE;
|
|
{$ENDIF}
|
|
dmdproc.OnReadData := @asyncprocOutput;
|
|
dmdproc.OnTerminate:= @asyncprocTerminate;
|
|
dmdproc.Options := [poUsePipes, poStderrToOutPut];
|
|
case fRunnablesOptions.compiler of
|
|
dmd: dmdProc.Executable := fCompilerSelector.getCompilerPath(dmd);
|
|
gdc, gdmd: dmdProc.Executable := fCompilerSelector.getCompilerPath(gdmd);
|
|
ldc, ldmd: dmdProc.Executable := fCompilerSelector.getCompilerPath(ldmd);
|
|
user1: dmdProc.Executable := fCompilerSelector.getCompilerPath(user1);
|
|
user2: dmdProc.Executable := fCompilerSelector.getCompilerPath(user2);
|
|
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.AddStrings(fRunnablesOptions.staticSwitches);
|
|
if lst.isNotNil and (lst.Count <> 0) then
|
|
dmdproc.Parameters.AddStrings(lst);
|
|
if fRunnablesOptions.detectMain then
|
|
begin
|
|
hasMain := fDoc.implementMain;
|
|
case hasMain of
|
|
mainNo:
|
|
dmdproc.Parameters.Add('-main');
|
|
mainDefaultBehavior:
|
|
if unittest then
|
|
dmdproc.Parameters.Add('-main');
|
|
end;
|
|
end;
|
|
if unittest then
|
|
begin
|
|
if not fRunnablesOptions.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 fRunnablesOptions.detectLibraries then
|
|
LibMan.getLibsForSource(fDoc.Lines, dmdproc.Parameters, dmdproc.Parameters)
|
|
else
|
|
begin
|
|
LibMan.getLibFiles(nil, dmdproc.Parameters);
|
|
LibMan.getLibSourcePath(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}
|
|
fRunProc.XTermProgram:=consoleProgram;
|
|
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;
|
|
const
|
|
ic : array[boolean] of TCEAppMessageKind = (amkWarn, amkInf);
|
|
begin
|
|
asyncprocTerminate(sender);
|
|
if fCovModUt and assigned(fRunProc) and (fRunProc.ExitStatus = 0) then
|
|
begin
|
|
fname := fDoc.fileName.stripFileExt;
|
|
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');
|
|
fMsgs.message(lst[lst.Count-1], fDoc, amcEdit, ic[fullcov]);
|
|
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 compileRunnable(false) and InputQuery('Execution arguments', '', runargs) then
|
|
executeRunnable(false, true, runargs);
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileCompileExecute(Sender: TObject);
|
|
begin
|
|
compileRunnable(false);
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileCloseAllOthersExecute(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
d: TCESynMemo;
|
|
c: TCESynMemo;
|
|
begin
|
|
if fDoc.isNil then
|
|
exit;
|
|
c := fDoc;
|
|
for i := fMultidoc.documentCount-1 downto 0 do
|
|
begin
|
|
d := fMultidoc.document[i];
|
|
if not d.Equals(c) then
|
|
fMultidoc.closeDocument(d);
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileCloseAllExecute(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
begin
|
|
if fDoc.isNil then
|
|
exit;
|
|
for i := fMultidoc.documentCount-1 downto 0 do
|
|
fMultidoc.closeDocument(i);
|
|
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);
|
|
while prc.Running do;
|
|
for msg in lst do
|
|
fMsgs.message(msg, fDoc, amcEdit, amkWarn);
|
|
finally
|
|
prc.Free;
|
|
lst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileMetricsHalsteadExecute(Sender: TObject);
|
|
begin
|
|
if fDoc.isNil or not fDoc.isDSource then
|
|
exit;
|
|
metrics.measure(fDoc);
|
|
end;
|
|
|
|
procedure TCEMainForm.actFileNewClipExecute(Sender: TObject);
|
|
begin
|
|
newFile;
|
|
fDoc.setFocus;
|
|
fDoc.PasteFromClipboard;
|
|
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.isNil 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('--single');
|
|
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}
|
|
fRunProc.XTermProgram:=consoleProgram;
|
|
end;
|
|
if fRunnablesOptions.compiler <> dmd then
|
|
fRunProc.Parameters.add('--compiler=' +
|
|
fCompilerSelector.getCompilerPath(fRunnablesOptions.compiler));
|
|
fRunProc.Parameters.Add(fDoc.fileName);
|
|
fRunProc.execute;
|
|
end;
|
|
|
|
procedure TCEMainForm.runFile(outside: boolean);
|
|
var
|
|
fname: string;
|
|
older: boolean = false;
|
|
exist: boolean = false;
|
|
const
|
|
messg1: string = 'Either the runnable does not exist or it is older than its source.' +
|
|
LineEnding + 'Do you wish to recompile it ?';
|
|
messg2: string = 'The binary produced for a runnable that is not explicitly saved ' +
|
|
'must be recompiled after each execution.' + LineEnding + 'Do you wish to recompile it now ?';
|
|
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 fDoc.isTemporary and (dlgYesNo(messg2) = mrYes) then
|
|
compileRunnable
|
|
else if dlgYesNo(messg1) = 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 or 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);
|
|
if fAppliOpts.showBuildDuration then
|
|
fCompStart := Time;
|
|
fProject.compile;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjCompileAndRunExecute(Sender: TObject);
|
|
begin
|
|
fRunProjAfterCompile := true;
|
|
if fAppliOpts.autoSaveProjectFiles then
|
|
saveModifiedProjectFiles(fProject);
|
|
if fAppliOpts.showBuildDuration then
|
|
fCompStart := Time;
|
|
fProject.compile;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjCompAndRunWithArgsExecute(Sender: TObject);
|
|
begin
|
|
fRunProjAfterCompile := true;
|
|
fRunProjAfterCompArg := true;
|
|
if fAppliOpts.autoSaveProjectFiles then
|
|
saveModifiedProjectFiles(fProject);
|
|
if fAppliOpts.showBuildDuration then
|
|
fCompStart := Time;
|
|
fProject.compile;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjRunExecute(Sender: TObject);
|
|
begin
|
|
if fProject.binaryKind <> executable then
|
|
dlgOkInfo('Non executable projects cant be run')
|
|
else
|
|
begin
|
|
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);
|
|
if fAppliOpts.showBuildDuration then
|
|
fCompStart := Time;
|
|
fProject.compile;
|
|
end;
|
|
if fProject.outputFilename.fileExists or (fProject.getFormat = pfDUB) then
|
|
fProject.run;
|
|
end;
|
|
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.isNotNil then
|
|
widg.showWidget;
|
|
end;
|
|
|
|
procedure TCEMainForm.layoutLoadFromFile(const fname: string);
|
|
var
|
|
xcfg: TXMLConfigStorage;
|
|
begin
|
|
if not fname.fileExists then
|
|
exit;
|
|
xcfg := TXMLConfigStorage.Create(fname, true);
|
|
try
|
|
DockMaster.RestoreLayouts.Clear;
|
|
DockMaster.LoadLayoutFromConfig(xcfg, false);
|
|
finally
|
|
xcfg.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.layoutSaveToFile(const fname: string);
|
|
var
|
|
xcfg: TXMLConfigStorage;
|
|
i: integer;
|
|
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(fname.extractFilePath);
|
|
xcfg := TXMLConfigStorage.Create(fname + '.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(fname + '.tmp');
|
|
if Size < 10000 then
|
|
begin
|
|
SaveToFile(fname);
|
|
SysUtils.DeleteFile(fname + '.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: integer;
|
|
begin
|
|
itm := TMenuItem.Create(self);
|
|
itm.Action := actLayoutReset;
|
|
mnuLayout.Add(itm);
|
|
|
|
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 := itm.Caption.stripFileExt;
|
|
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 ---------------------------------------------------------------}
|
|
function TCEMainForm.checkProjectLock(message: boolean = true): boolean;
|
|
begin
|
|
result := false;
|
|
if fProjActionsLock then
|
|
begin
|
|
result := true;
|
|
if message then
|
|
dlgOkInfo('This action is disabled while a project compiles',
|
|
'Project lock warning');
|
|
end
|
|
end;
|
|
|
|
procedure TCEMainForm.showProjTitle;
|
|
begin
|
|
if assigned(fProject) and fProject.filename.fileExists then
|
|
caption := format('Coedit - %s', [shortenPath(fProject.filename, 30)])
|
|
else
|
|
caption := 'Coedit';
|
|
end;
|
|
|
|
procedure TCEMainForm.saveProjSource(const document: TCESynMemo);
|
|
var
|
|
fname: string;
|
|
begin
|
|
if not assigned(fProject) or checkProjectLock or
|
|
(fProject.filename <> document.fileName) then
|
|
exit;
|
|
|
|
fname := fProject.filename;
|
|
document.saveToFile(fname);
|
|
fProject.reload;
|
|
end;
|
|
|
|
function TCEMainForm.closeProj: boolean;
|
|
begin
|
|
if not assigned(fProject) then
|
|
exit(true);
|
|
|
|
result := false;
|
|
if fProject = fFreeProj then
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
fProject.getProject.Free;
|
|
fFreeProj := nil;
|
|
end;
|
|
fProject := nil;
|
|
fNativeProject := nil;
|
|
fDubProject := nil;
|
|
showProjTitle;
|
|
result := true;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjNewDubJsonExecute(Sender: TObject);
|
|
begin
|
|
if assigned(fProject) and not fProject.inGroup and fProject.modified and
|
|
(dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
|
|
exit;
|
|
if not closeProj then
|
|
exit;
|
|
newDubProj;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjNewNativeExecute(Sender: TObject);
|
|
begin
|
|
if assigned(fProject) and not fProject.inGroup and fProject.modified and
|
|
(dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
|
|
exit;
|
|
if not closeProj then
|
|
exit;
|
|
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);
|
|
fProject := fDubProject as ICECommonProject;
|
|
showProjTitle;
|
|
end;
|
|
|
|
procedure TCEMainForm.saveProj;
|
|
begin
|
|
fProject.saveToFile(fProject.filename);
|
|
end;
|
|
|
|
procedure TCEMainForm.saveProjAs(const fname: string);
|
|
begin
|
|
fProject.saveToFile(fname);
|
|
showProjTitle;
|
|
end;
|
|
|
|
procedure TCEMainForm.openProj(const fname: string);
|
|
var
|
|
ext: string;
|
|
begin
|
|
if not closeProj then
|
|
exit;
|
|
ext := fname.extractFileExt.upperCase;
|
|
if (ext = '.JSON') or (ext = '.SDL') then
|
|
newDubProj
|
|
else
|
|
newNativeProj;
|
|
|
|
fProject.loadFromFile(fname);
|
|
showProjTitle;
|
|
fProject.activate;
|
|
end;
|
|
|
|
procedure TCEMainForm.mruProjItemClick(Sender: TObject);
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
if assigned(fProject) and not fProject.inGroup and fProject.modified and
|
|
(dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
|
|
exit;
|
|
openProj(TMenuItem(Sender).Hint);
|
|
end;
|
|
|
|
procedure TCEMainForm.mruProjGroupItemClick(Sender: TObject);
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
if fProjectGroup.groupModified and (dlgFileChangeClose(
|
|
fProjectGroup.groupFilename, UnsavedPGrp) = mrCancel) then
|
|
exit;
|
|
fProjectGroup.closeGroup;
|
|
fProjectGroup.openGroup(TMenuItem(Sender).Hint);
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjCloseExecute(Sender: TObject);
|
|
begin
|
|
if assigned(fProject) and not fProject.inGroup and fProject.modified and
|
|
(dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
|
|
exit;
|
|
closeProj;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjSaveAsExecute(Sender: TObject);
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
if (fProject.getFormat = pfDUB) and TCEDubProject(fProject.getProject).isSDL then
|
|
begin
|
|
fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
|
|
exit;
|
|
end;
|
|
with TSaveDialog.Create(nil) do
|
|
try
|
|
if fProject.filename.fileExists then
|
|
InitialDir := fproject.filename.extractFileDir;
|
|
if execute then
|
|
saveProjAs(filename.normalizePath);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjSaveExecute(Sender: TObject);
|
|
begin
|
|
if not assigned(fProject) then
|
|
exit;
|
|
if (fProject.getFormat = pfDUB) and TCEDubProject(fProject.getProject).isSDL then
|
|
begin
|
|
fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
|
|
exit;
|
|
end;
|
|
if checkProjectLock then
|
|
exit;
|
|
if fProject.filename.isNotEmpty then
|
|
saveProj
|
|
else
|
|
actProjSaveAs.Execute;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjOpenExecute(Sender: TObject);
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
if assigned(fProject) and fProject.modified and
|
|
(dlgFileChangeClose(fProject.filename, UnsavedProj) = mrCancel) then
|
|
exit;
|
|
with TOpenDialog.Create(nil) do
|
|
try
|
|
if execute then
|
|
openProj(filename.normalizePath);
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjEditorExecute(Sender: TObject);
|
|
var
|
|
win: TControl = nil;
|
|
begin
|
|
if assigned(fProject) then case fProject.getFormat of
|
|
pfDUB: win := DockMaster.GetAnchorSite(fDubProjWidg);
|
|
pfCE: 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 not assigned(fProject) or not fProject.filename.fileExists then
|
|
exit;
|
|
|
|
if (fProject.getFormat = pfDUB) and TCEDubProject(fProject.getProject).isSDL then
|
|
begin
|
|
fMsgs.message(DubSdlWarning, fProject, amcProj, amkWarn);
|
|
exit;
|
|
end;
|
|
|
|
openFile(fProject.filename);
|
|
fDoc.isProjectDescription := true;
|
|
if fProject.getFormat = pfCE then
|
|
fDoc.Highlighter := LfmSyn
|
|
else
|
|
fDoc.Highlighter := JsSyn;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjOptViewExecute(Sender: TObject);
|
|
begin
|
|
if not assigned(fProject) then
|
|
exit;
|
|
dlgOkInfo(fProject.getCommandLine, 'Compilation command line');
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjDscanExecute(Sender: TObject);
|
|
var
|
|
lst: TStringList;
|
|
prc: TProcess;
|
|
pth: string;
|
|
msg: string;
|
|
i: integer;
|
|
begin
|
|
if fProject = nil then
|
|
exit;
|
|
|
|
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('-S');
|
|
if not fDscanUnittests then
|
|
prc.Parameters.Add('--skipTests');
|
|
for i := 0 to fProject.sourcesCount-1 do
|
|
prc.Parameters.Add(fProject.sourceAbsolute(i));
|
|
prc.Execute;
|
|
processOutputToStrings(prc, lst);
|
|
while prc.Running do;
|
|
for msg in lst do
|
|
fMsgs.message(msg, fProject, amcProj, amkWarn);
|
|
finally
|
|
prc.Free;
|
|
lst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjOpenGroupExecute(Sender: TObject);
|
|
begin
|
|
if fProjectGroup.groupModified then
|
|
begin
|
|
if dlgFileChangeClose(fProjectGroup.groupFilename, UnsavedPGrp) = mrCancel then
|
|
exit;
|
|
end;
|
|
with TOpenDialog.Create(nil) do
|
|
try
|
|
if execute then
|
|
begin
|
|
filename := filename.normalizePath;
|
|
fProjectGroup.closeGroup;
|
|
fProjectGroup.openGroup(filename);
|
|
fPrjGrpMru.Insert(0, filename);
|
|
end;
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjSaveGroupAsExecute(Sender: TObject);
|
|
begin
|
|
with TSaveDialog.Create(nil) do
|
|
try
|
|
if fProjectGroup.groupFilename.fileExists then
|
|
InitialDir := fProjectGroup.groupFilename.extractFileDir;
|
|
if execute then
|
|
fProjectGroup.saveGroup(filename.normalizePath);
|
|
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 assigned(fFreeProj) then
|
|
fFreeProj.activate;
|
|
end;
|
|
|
|
procedure TCEMainForm.actNewGroupExecute(Sender: TObject);
|
|
begin
|
|
if fProjectGroup.groupModified then
|
|
begin
|
|
if dlgFileChangeClose(fProjectGroup.groupFilename, UnsavedPGrp) = mrCancel then
|
|
exit;
|
|
end;
|
|
fProjectGroup.closeGroup;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjAddToGroupExecute(Sender: TObject);
|
|
begin
|
|
if not assigned(fFreeProj) or fFreeProj.inGroup or
|
|
not fFreeProj.filename.fileExists then
|
|
exit;
|
|
fProjectGroup.addProject(fFreeProj);
|
|
fFreeProj := nil;
|
|
end;
|
|
|
|
// TODO-cprojectsgroup: add a "out of mem" protection in async mode.
|
|
|
|
procedure TCEMainForm.compileGroup(async: TAsyncWait);
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
if checkProjectLock then
|
|
exit;
|
|
if fProjectGroup.projectCount = 0 then
|
|
exit;
|
|
fProjBeforeGroup := fProject;
|
|
fGroupCompilationCnt := 0;
|
|
fIsCompilingGroup := true;
|
|
fMsgs.message('start compiling a project group...', nil, amcAll, amkInf);
|
|
if fAppliOpts.showBuildDuration then
|
|
fCompStart := Time;
|
|
for i:= 0 to fProjectGroup.projectCount-1 do
|
|
begin
|
|
fProjectGroup.getProject(i).activate;
|
|
// customized async mode: wait
|
|
if not fProjectGroup.projectIsAsync(i) and (async = awCustom) then
|
|
begin
|
|
while fGroupCompilationCnt <> i do
|
|
Application.ProcessMessages;
|
|
for j:= 0 to i-1 do
|
|
if not fProjectGroup.getProject(j).compiled then
|
|
begin
|
|
fMsgs.message('group compilation has stopped because of a failure',
|
|
nil, amcAll, amkErr);
|
|
fIsCompilingGroup := false;
|
|
break;
|
|
end;
|
|
end;
|
|
fProject.compile;
|
|
// sequential
|
|
if (async = awNo) then
|
|
begin
|
|
while fProjActionsLock do
|
|
Application.ProcessMessages;
|
|
if not fProject.compiled then
|
|
begin
|
|
fMsgs.message('group compilation has stopped because of a failure',
|
|
nil, amcAll, amkErr);
|
|
fIsCompilingGroup := false;
|
|
break;
|
|
end;
|
|
end
|
|
end;
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjGroupCompileExecute(Sender: TObject);
|
|
begin
|
|
compileGroup(awYes);
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjGroupCompileSyncExecute(Sender: TObject);
|
|
begin
|
|
compileGroup(awNo);
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjGroupCompileCustomSyncExecute(Sender: TObject);
|
|
begin
|
|
compileGroup(awCustom);
|
|
end;
|
|
|
|
procedure TCEMainForm.actProjNewGroupExecute(Sender: TObject);
|
|
begin
|
|
if fProjectGroup.groupModified and
|
|
(dlgFileChangeClose(fProjectGroup.groupFilename, UnsavedPGrp) = mrCancel) then
|
|
exit;
|
|
fProjectGroup.closeGroup;
|
|
if assigned(fFreeProj) then
|
|
fFreeProj.activate;
|
|
end;
|
|
{$ENDREGION}
|
|
|
|
end.
|