diff --git a/README.md b/README.md
index 921b346b..867bc2cb 100644
--- a/README.md
+++ b/README.md
@@ -3,34 +3,42 @@ Coedit
Coedit is a simple IDE for the [D2](http://dlang.org) lang. (**Co** mpile & **Edit**).
-Initial features (planed)
--------------------------
-- targets Win/Macos/Linux
+Current features
+----------------
+- multi platform (Win/Linux/Macos).
- projects.
- multiple project configurations (set of switches and options).
-- project configurations templates (release, debug, etc.).
-- D syntax highlighter, folding.
-- compile, run directly from UI.
+- compile, run directly from the UI.
- instant run (without saving, script-like).
-- basic auto completion (brackets, key-words, ...)
- synchronized edition in a block.
+- D syntax highlighter, folding, identifier markup.
+
+Planed in version 1
+-------------------
+- project configurations templates (release, debug, etc.).
+- basic auto completion (brackets, key-words, ...).
+- console input handling.
+- static library explorer (using JSON infos).
Project information
-------------------
-- draft
-- programmed in Object pascal.
-- [Lazarus](http://www.lazarus.freepascal.org) is used as IDE.
-- based on dmd (gdc or lmd characteristics are not hanlded).
-- no other third party dependencies (so far...)
+- state: alpha 1.
+- programmed in Object pascal with [Lazarus](http://www.lazarus.freepascal.org).
+- based on *dmd* (*gdc* or *lmd* characteristics are not handled).
+- no other third party dependencies (so far...but using *dscanner* and/or *dcd* is envisaged.)
-Setup
------
-- clone this repo.
+Setup & test
+------------
+Coedit must be build from the sources:
+- clone this repository (even if not mandatory, preferably from the latest tag, as tagged versions are more tested then the others.)
- both [dmd](http://dlang.org/download.html) and [Lazarus](http://www.lazarus.freepascal.org) must be setup.
-- open "coedit.lpr" in Lazarus.
-- press the Run button.
+- open "coedit.lpr" in *Lazarus*, set the build mode to *Release*
+- press the Run button (or build)
+- in coedit open *"lazproj\test\coeditproj\test.coedit"* from the project menu.
Preview
-------
-
-
\ No newline at end of file
+Windows version:
+
+Linux version:
+
\ No newline at end of file
diff --git a/lazproj/Gui.tease.kde.png b/lazproj/Gui.tease.kde.png
new file mode 100644
index 00000000..bc377f5a
Binary files /dev/null and b/lazproj/Gui.tease.kde.png differ
diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 091f9e2a..ab0f55db 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -126,7 +126,7 @@
-
+
@@ -205,6 +205,16 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr
index eb187889..e791f700 100644
--- a/lazproj/coedit.lpr
+++ b/lazproj/coedit.lpr
@@ -8,7 +8,8 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, Forms, lazcontrols, runtimetypeinfocontrols, ce_widget,
ce_dmdwrap, ce_common, ce_synmemo, ce_main, ce_messages, ce_editor,
- ce_projinspect, ce_projconf, ce_jsoninfos, jsonparser;
+ ce_projinspect, ce_projconf, ce_jsoninfos, jsonparser, ce_project,
+ce_widgettypes;
{$R *.res}
diff --git a/lazproj/test/coeditproj/test.coedit b/lazproj/test/coeditproj/test.coedit
index 18dbe6fe..0108656e 100644
--- a/lazproj/test/coeditproj/test.coedit
+++ b/lazproj/test/coeditproj/test.coedit
@@ -1,4 +1,4 @@
-object TCEProject
+object _1: TCEProject
OptionsCollection = <
item
name = 'default'
@@ -54,7 +54,7 @@ object TCEProject
outputOptions.release = False
outputOptions.unittest = True
outputOptions.versionIdentifier = 'revision_1'
- pathsOptions.outputFilename = '..\output\main.exe'
+ pathsOptions.outputFilename = '..\output\main.exe'
end>
Sources.Strings = (
'..\src\main.d'
diff --git a/src/ce_common.pas b/src/ce_common.pas
index 63aa6290..2bbf61d9 100644
--- a/src/ce_common.pas
+++ b/src/ce_common.pas
@@ -5,92 +5,39 @@ unit ce_common;
interface
uses
- Classes, SysUtils, ce_dmdwrap, ActnList;
-
-type
-
- TCEProject = class;
+ Classes, SysUtils, ActnList;
(**
- * An implementer is informed when a new document is added, focused or closed.
+ * Save a component with a readable aspect.
*)
- ICEMultiDocMonitor = interface
- procedure docChange(const aNewIndex: integer);
- procedure docClose(const aNewIndex: integer);
- end;
-
- (**
- * An implementer adds some menu actions when its context is valid.
- *)
- ICEContextualActions = interface
- function contextName: string;
- function contextActionCount: integer;
- function contextAction(index: integer): TAction;
- end;
-
- (**
- * An implementer is informed when a project changes.
- *)
- ICEProjectMonitor = interface
- procedure projNew(const aProject: TCEProject);
- procedure projChange(const aProject: TCEProject);
- procedure projClose(const aProject: TCEProject);
- end;
-
- (*****************************************************************************
- * Writable project.
- *)
- TCEProject = class(TComponent)
- private
- fOnChange: TNotifyEvent;
- fModified: boolean;
- fFilename: string;
- fBasePath: string;
- fOptsColl: TCollection;
- fSrcs, fSrcsCop: TStringList;
- fConfIx: Integer;
- fChangedCount: NativeInt;
- procedure doChanged;
- procedure subMemberChanged(sender : TObject);
- procedure setOptsColl(const aValue: TCollection);
- procedure setFname(const aValue: string);
- procedure setSrcs(const aValue: TStringList);
- procedure setConfIx(aValue: Integer);
- function getConfig(const ix: integer): TCompilerConfiguration;
- function getSrcs: TStringList;
- function getCurrConf: TCompilerConfiguration;
- published
- property OptionsCollection: TCollection read fOptsColl write setOptsColl;
- property Sources: TStringList read fSrcs write setSrcs; // 'read' should return a copy to avoid abs/rel errors
- property ConfigurationIndex: Integer read fConfIx write setConfIx;
- public
- constructor create(aOwner: TComponent); override;
- destructor destroy; override;
- procedure beforeChanged;
- procedure afterChanged;
- procedure reset;
- function getAbsoluteSourceName(const aIndex: integer): string;
- function getAbsoluteFilename(const aFilename: string): string;
- procedure addSource(const aFilename: string);
- function addConfiguration: TCompilerConfiguration;
- procedure getOpts(const aList: TStrings);
- //
- property configuration[ix: integer]: TCompilerConfiguration read getConfig;
- property currentConfiguration: TCompilerConfiguration read getCurrConf;
- property fileName: string read fFilename write setFname;
- property onChange: TNotifyEvent read fOnChange write fOnChange;
- end;
-
procedure saveCompToTxtFile(const aComp: TComponent; const aFilename: string);
+
+ (**
+ * Load a component.
+ *)
procedure loadCompFromTxtFile(const aComp: TComponent; const aFilename: string);
+
+ (**
+ * Converts a relative path to an absolute path.
+ *)
function expandFilenameEx(const aBasePath, aFilename: string): string;
+
+ (**
+ * Extracts the module name of a D source file.
+ *)
function getModuleName(const aSource: TStrings): string;
+ (**
+ * Patches the directory separators from a string.
+ * This is used to ensure a that project saved on a plateform can be loaded
+ * on another one.
+ *)
+ function patchPlateformPath(const aPath: string): string;
+ procedure patchPlateformPaths(const sPaths: TStrings);
+
+
implementation
-(*****************************************************************************
- * Routines
- *)
procedure saveCompToTxtFile(const aComp: TComponent; const aFilename: string);
var
str1, str2: TMemoryStream;
@@ -144,6 +91,87 @@ begin
end;
end;
+function patchPlateformPath(const aPath: string): string;
+var
+ i: Integer;
+begin
+ result := aPath;
+ {$IFDEF MSWINDOWS}
+ i := pos('/',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos('/',result);
+ until
+ i = 0;
+ end;
+ i := pos(':',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos(':',result);
+ until
+ i = 0;
+ end;
+ {$ENDIF}
+
+ {$IFDEF LINUX}
+ i := pos('\',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos('\',result);
+ until
+ i = 0;
+ end;
+ i := pos(':',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos(':',result);
+ until
+ i = 0;
+ end;
+ {$ENDIF}
+
+ {$IFDEF MACOS}
+ i := pos('\',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos('\',result);
+ until
+ i = 0;
+ end;
+ i := pos('/',result);
+ if i <> 0 then
+ begin
+ repeat
+ result[i] := directorySeparator;
+ i := pos('/',result);
+ until
+ i = 0;
+ end;
+ {$ENDIF}
+end;
+
+procedure patchPlateformPaths(const sPaths: TStrings);
+var
+ i: Integer;
+ str: string;
+begin
+ for i:= 0 to sPaths.Count-1 do
+ begin
+ str := sPaths.Strings[i];
+ sPaths.Strings[i] := patchPlateformPath(str);
+ end;
+end;
+
// TODO: block comments handling
function getModuleName(const aSource: TStrings): string;
var
@@ -197,211 +225,4 @@ begin
end;
end;
-(*****************************************************************************
- * TProject
- *)
-constructor TCEProject.create(aOwner: TComponent);
-begin
- inherited create(aOwner);
- fSrcs := TStringList.Create;
- fSrcs.OnChange := @subMemberChanged;
- fSrcsCop := TStringList.Create;
- fOptsColl := TCollection.create(TCompilerConfiguration);
- reset;
-end;
-
-destructor TCEProject.destroy;
-begin
- fOnChange := nil;
- fSrcs.free;
- fSrcsCop.Free;
- fOptsColl.free;
- inherited;
-end;
-
-function TCEProject.addConfiguration: TCompilerConfiguration;
-begin
- result := TCompilerConfiguration(fOptsColl.Add);
- result.onChanged := @subMemberChanged;
-end;
-
-procedure TCEProject.setOptsColl(const aValue: TCollection);
-var
- i: nativeInt;
-begin
- fOptsColl.Assign(aValue);
- for i:= 0 to self.fOptsColl.Count-1 do
- Configuration[i].onChanged := @subMemberChanged;
-end;
-
-procedure TCEProject.addSource(const aFilename: string);
-var
- relSrc, absSrc: string;
-begin
- for relSrc in fSrcs do
- begin
- absSrc := expandFilenameEx(fBasePath,relsrc);
- if aFilename = absSrc then exit;
- end;
- fSrcs.Add(ExtractRelativepath(fBasePath,aFilename));
-end;
-
-procedure TCEProject.setFname(const aValue: string);
-var
- oldAbs, newRel, oldBase: string;
- i: NativeInt;
-begin
- if fFilename = aValue then exit;
- //
- beforeChanged;
-
- fFilename := aValue;
- oldBase := fBasePath;
- fBasePath := extractFilePath(fFilename);
- //
- for i:= 0 to fSrcs.Count-1 do
- begin
- oldAbs := expandFilenameEx(oldBase,fSrcs[i]);
- newRel := ExtractRelativepath(fBasePath, oldAbs);
- fSrcs[i] := newRel;
- end;
- //
- afterChanged;
-end;
-
-procedure TCEProject.setSrcs(const aValue: TStringList);
-begin
- beforeChanged;
- fSrcs.Assign(aValue);
- afterChanged;
-end;
-
-procedure TCEProject.setConfIx(aValue: Integer);
-begin
- if fConfIx = aValue then exit;
- beforeChanged;
- if aValue < 0 then aValue := 0;
- if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1;
- fConfIx := aValue;
- afterChanged;
-end;
-
-procedure TCEProject.subMemberChanged(sender : TObject);
-begin
- beforeChanged;
- fModified := true;
- afterChanged;
-end;
-
-procedure TCEProject.beforeChanged;
-begin
- Inc(fChangedCount);
-end;
-
-procedure TCEProject.afterChanged;
-begin
- Dec(fChangedCount);
- if fChangedCount > 0 then
- begin
- {$IFDEF DEBUG}
- writeln('project update count > 0');
- {$ENDIF}
- exit;
- end;
- fChangedCount := 0;
- doChanged;
-end;
-
-procedure TCEProject.doChanged;
-{$IFDEF DEBUG}
-var
- lst: TStringList;
-{$ENDIF}
-begin
- fModified := true;
- if assigned(fOnChange) then fOnChange(Self);
- {$IFDEF DEBUG}
- lst := TStringList.Create;
- try
- lst.Add('---------begin----------');
- getOpts(lst);
- lst.Add('---------end----------');
- writeln(lst.Text);
- finally
- lst.Free;
- end;
- {$ENDIF}
-end;
-
-function TCEProject.getConfig(const ix: integer): TCompilerConfiguration;
-begin
- result := TCompilerConfiguration(fOptsColl.Items[ix]);
- result.onChanged := @subMemberChanged;
-end;
-
-function TCEProject.getCurrConf: TCompilerConfiguration;
-begin
- result := TCompilerConfiguration(fOptsColl.Items[fConfIx]);
-end;
-
-function TCEProject.getSrcs: TStringList;
-var
- str: TMemoryStream;
-begin
- if not (csReading in componentState) or (csWriting in componentState) then
- begin
- str := TMemoryStream.Create;
- try
- fSrcs.SaveToStream(str);
- str.Position:=0;
- fSrcsCop.Clear;
- fSrcsCop.LoadFromStream(str);
- finally
- str.Free;
- end;
- result := fSrcsCop;
- end
- else result := fSrcs;
-end;
-
-procedure TCEProject.reset;
-var
- defConf: TCompilerConfiguration;
-begin
- beforeChanged;
- fConfIx := 0;
- fOptsColl.Clear;
- defConf := addConfiguration;
- defConf.name := 'default';
- fSrcs.Clear;
- fFilename := '';
- afterChanged;
-end;
-
-procedure TCEProject.getOpts(const aList: TStrings);
-var
- rel, abs: string;
-begin
- if fConfIx = -1 then exit;
- for rel in fSrcs do if rel <> '' then
- begin
- abs := expandFilenameEx(fBasePath,rel);
- aList.Add(abs); // process.inc ln 249. double quotes are added anyway if there's a space...
- end;
- TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList);
-end;
-
-function TCEProject.getAbsoluteSourceName(const aIndex: integer): string;
-begin
- if aIndex < 0 then exit('');
- if aIndex > fSrcs.Count-1 then exit('');
- result := expandFileNameEx(fBasePath, fSrcs.Strings[aIndex]);
-end;
-
-function TCEProject.getAbsoluteFilename(const aFilename: string): string;
-begin
- result := expandFileNameEx(fBasePath, aFilename);
-end;
-
end.
-
diff --git a/src/ce_d2syn.pas b/src/ce_d2syn.pas
index 8c38727a..1c8e3aa9 100644
--- a/src/ce_d2syn.pas
+++ b/src/ce_d2syn.pas
@@ -47,7 +47,7 @@ type
TD2Dictionary = object
private
fLongest: NativeInt;
- fEntries: array[0..1024] of TD2DictionaryEntry;
+ fEntries: array[0..1023] of TD2DictionaryEntry;
function toHash(const aValue: string): word;
procedure addEntry(const aValue: string);
public
@@ -80,6 +80,7 @@ type
fRange: TRangeKind;
fFoldKinds: TFoldKinds;
fAttribLut: array[TTokenKind] of TSynHighlighterAttributes;
+ // readNext is mostly used to advanced the reader head.
function readNext: Char;
function readCurr: Char;
function readPrev: Char;
@@ -96,6 +97,7 @@ type
procedure setCurrIdent(const aValue: string);
procedure doChanged;
published
+ // Defines which kind of ranges can be folded, among curly brackets, block comments and nested comments
property FoldKinds: TFoldKinds read fFoldKinds write setFoldKinds;
property WhiteAttrib: TSynHighlighterAttributes read fWhiteAttrib write setWhiteAttrib;
property NumbrAttrib: TSynHighlighterAttributes read fNumbrAttrib write setNumbrAttrib;
@@ -122,7 +124,7 @@ type
function GetRange: Pointer; override;
property CurrentIdentifier: string read fCurrIdent write setCurrIdent;
end;
-
+
implementation
function isWhite(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
@@ -437,6 +439,7 @@ begin
result := fLineBuf[fTokStop];
end;
+// unlike readNext, readPrev doesn't change the reader head position.
function TSynD2Syn.readPrev: Char; {$IFNDEF DEBUG}inline;{$ENDIF}
begin
result := fLineBuf[fTokStop-1];
@@ -444,14 +447,15 @@ end;
{
TODO:
-- binary literals.
- alternative attributes for ddoc comments.
-- asm range.
-- stricter number literals.
-- string literals: custom token, escape "\" not handled.
-- correct nested comments handling.
+- range: asm range.
+- number literals: stricter.
+- number literals: binary.
+- string literals: delimited strings.
+- string literals: token strings.
+- string literals: escape bug: std.path/std.regex: "\\"
+- comments: correct nested comments handling.
}
-
procedure TSynD2Syn.next;
begin
@@ -581,7 +585,7 @@ begin
// string 1
if fRange = rkString1 then
begin
- if (readCurr <> '"') then while ((readNext <> '"') and (not (readCurr = #10))) do (*!*);
+ if (readCurr <> '"') then while (((readNext <> '"') or (readPrev = '\')) and (not (readCurr = #10))) do (*!*);
if (readCurr = #10) then
begin
fRange := rkString1;
@@ -593,16 +597,35 @@ begin
fTokKind := tkStrng;
fRange := rkNone;
readNext;
+ // check postfix
+ if readCurr in ['c','w','d'] then
+ readNext;
exit;
end;
end;
- if fRange <> rkString2 then if (readCurr = '"') then
+ if fRange <> rkString2 then if (readCurr in ['r','x','"']) then
begin
if fRange = rkNone then
begin
- while ((readNext <> '"') and (not (readCurr = #10))) do (*!*);
+ // check hex/WYSIWYG prefix
+ if readCurr in ['r','x'] then
+ begin
+ if not (readNext = '"') then
+ begin
+ fTokKind := tkIdent;
+ exit; // warning: a goto is avoided but any other r/x is not detectable since it's truncated as tkIdent
+ end;
+ end;
+ // go to end of string/eol
+ while (((readNext <> '"') or (readPrev = '\')) and (not (readCurr = #10))) do (*!*);
if (readCurr = #10) then fRange := rkString1
- else readNext;
+ else
+ begin
+ readNext;
+ // check postfix
+ if readCurr in ['c','w','d'] then
+ readNext;
+ end;
fTokKind := tkStrng;
exit;
end;
@@ -623,6 +646,9 @@ begin
fTokKind := tkStrng;
fRange := rkNone;
readNext;
+ // check postfix
+ if readCurr in ['c','w','d'] then
+ readNext;
exit;
end;
end;
@@ -630,9 +656,16 @@ begin
begin
if fRange = rkNone then
begin
+ // go to end of string/eol
while ((readNext <> '`') and (not (readCurr = #10))) do (*!*);
if (readCurr = #10) then fRange := rkString2
- else readNext;
+ else
+ begin
+ readNext;
+ // check postfix
+ if readCurr in ['c','w','d'] then
+ readNext;
+ end;
fTokKind := tkStrng;
exit;
end;
@@ -641,7 +674,7 @@ begin
// char literals
if fRange = rkNone then if (readCurr = #39) then
begin
- while ((readNext <> #39) and (not (readCurr = #10))) do (*!*);
+ while (((readNext <> #39) or (readPrev = '\')) and (not (readCurr = #10))) do (*!*);
if (readCurr = #39) then
begin
fTokKind := tkStrng;
diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas
index dc63e1b3..34b54ad0 100644
--- a/src/ce_dmdwrap.pas
+++ b/src/ce_dmdwrap.pas
@@ -22,7 +22,6 @@ type
protected
property onChange: TNotifyEvent read fOnChange write fOnChange;
public
- //function getOpts: string; virtual; abstract;
procedure getOpts(const aList: TStrings); virtual; abstract;
end;
@@ -60,7 +59,7 @@ type
*)
TMsgOpts = class(TOptsGroup)
private
- fDepHandling : TDepHandling; // could be also related to analysis
+ fDepHandling : TDepHandling;
fVerb: boolean;
fWarn: boolean;
fWarnEx: boolean;
@@ -136,7 +135,7 @@ type
procedure getOpts(const aList: TStrings); override;
end;
- (**
+ (*****************************************************************************
* Encapsulates the options/args related to the debuging
*)
TDebugOpts = class(TOptsGroup)
@@ -248,6 +247,9 @@ type
implementation
+uses
+ ce_common;
+
(*******************************************************************************
* TOptsGroup
*)
@@ -276,8 +278,8 @@ begin
src := TDocOpts(aValue);
fGenDoc := src.fGenDoc;
fGenJson := src.fGenJson;
- fDocDir := src.fDocDir;
- fJsonFname:= src.fJsonFname;
+ fDocDir := patchPlateformPath(src.fDocDir);
+ fJsonFname:= patchPlateformPath(src.fJsonFname);
end
else inherited;
end;
@@ -299,14 +301,14 @@ end;
procedure TDocOpts.setDocDir(const aValue: string);
begin
if fDocDir = aValue then exit;
- fDocDir := aValue;
+ fDocDir := patchPlateformPath(aValue);
doChanged;
end;
procedure TDocOpts.setJSONFile(const aValue: string);
begin
if fJsonFname = aValue then exit;
- fJsonFname := aValue;
+ fJsonFname := patchPlateformPath(aValue);
doChanged;
end;
@@ -573,6 +575,13 @@ end;
(*******************************************************************************
* TPathsOpts
*)
+constructor TPathsOpts.create;
+begin
+ fSrcs := TStringList.Create;
+ fIncl := TStringList.Create;
+ fImpt := TStringList.Create;
+end;
+
procedure TPathsOpts.getOpts(const aList: TStrings);
var
str: string;
@@ -587,13 +596,6 @@ begin
if fObjDir <> '' then aList.Add('-od' + fObjDir);
end;
-constructor TPathsOpts.create;
-begin
- fSrcs := TStringList.Create;
- fIncl := TStringList.Create;
- fImpt := TStringList.Create;
-end;
-
procedure TPathsOpts.assign(aValue: TPersistent);
var
src: TPathsOpts;
@@ -604,8 +606,8 @@ begin
fSrcs.Assign(src.fSrcs);
fIncl.Assign(src.fIncl);
fImpt.Assign(src.fImpt);
- fFName := src.fFname;
- fObjDir := src.fObjDir;
+ fFName := patchPlateformPath(src.fFname);
+ fObjDir := patchPlateformPath(src.fObjDir);
end
else inherited;
end;
@@ -621,32 +623,35 @@ end;
procedure TPathsOpts.setFname(const aValue: string);
begin
if fFname = aValue then exit;
- fFname := aValue;
+ fFname := patchPlateformPath(aValue);
doChanged;
end;
procedure TPathsOpts.setObjDir(const aValue: string);
begin
if fObjDir = aValue then exit;
- fObjDir := aValue;
+ fObjDir := patchPlateformPath(aValue);
doChanged;
end;
procedure TPathsOpts.setSrcs(const aValue: TStringList);
begin
fSrcs.Assign(aValue);
+ patchPlateformPaths(fSrcs);
doChanged;
end;
procedure TPathsOpts.setIncl(const aValue: TStringList);
begin
fIncl.Assign(aValue);
+ patchPlateformPaths(fIncl);
doChanged;
end;
procedure TPathsOpts.setImpt(const aValue: TStringList);
begin
fImpt.Assign(aValue);
+ patchPlateformPaths(fImpt);
doChanged;
end;
@@ -808,4 +813,7 @@ begin
fOthers.Assign(aValue);
end;
+initialization
+ RegisterClasses([TCompilerConfiguration, TOtherOpts, TPathsOpts,
+ TDebugOpts, TOutputOpts, TMsgOpts, TDocOpts]);
end.
diff --git a/src/ce_editor.pas b/src/ce_editor.pas
index 1ac429ff..2f394292 100644
--- a/src/ce_editor.pas
+++ b/src/ce_editor.pas
@@ -180,7 +180,7 @@ end;
procedure TCEEditorWidget.autoWidgetUpdate;
const
- modstr: array[boolean] of string = ('...','MODIFIED');
+ modstr: array[boolean] of string = ('...', 'MODIFIED');
var
ed: TCESynMemo;
begin
diff --git a/src/ce_main.pas b/src/ce_main.pas
index 2b8638b9..8a772c85 100644
--- a/src/ce_main.pas
+++ b/src/ce_main.pas
@@ -6,10 +6,10 @@ interface
uses
Classes, SysUtils, FileUtil, SynEditKeyCmds, SynHighlighterLFM, Forms,
- AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg,
- Controls, Graphics, Dialogs, Menus, ActnList, ExtCtrls, process, ce_jsoninfos, ce_common,
- ce_dmdwrap, ce_synmemo, ce_widget, ce_messages, ce_editor, ce_projinspect,
- ce_projconf, ce_staticexplorer;
+ AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls, Graphics,
+ Dialogs, Menus, ActnList, ExtCtrls, process,
+ ce_jsoninfos, ce_common, ce_dmdwrap, ce_project, ce_synmemo,
+ ce_widget, ce_messages, ce_editor, ce_projinspect, ce_projconf, ce_staticexplorer;
type
@@ -659,7 +659,7 @@ begin
temppath := GetTempDir(false);
chDir(temppath);
{$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF}
- fname := temppath + format('temp_%.8x', [NativeInt(@dmdproc)]);
+ fname := temppath + format('temp_%.8x', [NativeUInt(@dmdproc)]);
{$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF}
fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d');
@@ -931,6 +931,7 @@ begin
fProject.beforeChanged;
fProject.fileName := aFilename;
loadCompFromTxtFile(fProject, aFilename);
+ fProject.afterLoad;
fProject.afterChanged;
end;
diff --git a/src/ce_messages.pas b/src/ce_messages.pas
index 97739205..2881ff9e 100644
--- a/src/ce_messages.pas
+++ b/src/ce_messages.pas
@@ -89,7 +89,7 @@ end;
procedure TCEMessagesWidget.scrollToBack;
begin
if not Visible then exit;
- List.ViewOrigin := Point(0,List.Items.Count * 25);
+ List.ViewOrigin := Point(0, List.Items.Count * 25);
end;
procedure TCEMessagesWidget.addCeInf(const aMsg: string);
diff --git a/src/ce_projconf.lfm b/src/ce_projconf.lfm
index 86d2fba0..9d426827 100644
--- a/src/ce_projconf.lfm
+++ b/src/ce_projconf.lfm
@@ -233,7 +233,6 @@ inherited CEProjectConfigurationWidget: TCEProjectConfigurationWidget
Indent = 16
NameFont.Color = clWindowText
OnEditorFilter = GridEditorFilter
- OnModified = GridModified
PreferredSplitterX = 145
SplitterX = 145
ValueFont.Color = clMaroon
diff --git a/src/ce_projconf.pas b/src/ce_projconf.pas
index 508ad511..2dd1b0d5 100644
--- a/src/ce_projconf.pas
+++ b/src/ce_projconf.pas
@@ -6,8 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, RTTIGrids, Forms, Controls, Graphics, Dialogs,
- ExtCtrls, ComCtrls, StdCtrls, Menus, Buttons, ce_widget, ce_common,
- ce_dmdwrap, PropEdits, ObjectInspector;
+ ExtCtrls, ComCtrls, StdCtrls, Menus, Buttons, PropEdits, ObjectInspector,
+ ce_dmdwrap, ce_project, ce_widget;
type
@@ -26,7 +26,6 @@ type
procedure btnDelConfClick(Sender: TObject);
procedure btnCloneCurrClick(Sender: TObject);
procedure GridEditorFilter(Sender: TObject; aEditor: TPropertyEditor;var aShow: boolean);
- procedure GridModified(Sender: TObject);
procedure selConfChange(Sender: TObject);
procedure TreeChange(Sender: TObject; Node: TTreeNode);
private
@@ -95,11 +94,6 @@ begin
if aEditor.ClassType = TCollectionPropertyEditor then aShow := false;
end;
-procedure TCEProjectConfigurationWidget.GridModified(Sender: TObject);
-begin
- setFocus;
-end;
-
procedure TCEProjectConfigurationWidget.btnAddConfClick(Sender: TObject);
var
nme: string;
diff --git a/src/ce_project.pas b/src/ce_project.pas
new file mode 100644
index 00000000..0be60792
--- /dev/null
+++ b/src/ce_project.pas
@@ -0,0 +1,257 @@
+unit ce_project;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, ce_dmdwrap;
+
+type
+
+(*****************************************************************************
+ * Represents a D project.
+ *
+ * It includes all the options defined in ce_dmdwrap, organized in
+ * a collection to allow multiples configurations.
+ *
+ * Basically it' s designed to provide the options for the dmd process.
+ *)
+ TCEProject = class(TComponent)
+ private
+ fOnChange: TNotifyEvent;
+ fModified: boolean;
+ fFilename: string;
+ fBasePath: string;
+ fOptsColl: TCollection;
+ fSrcs, fSrcsCop: TStringList;
+ fConfIx: Integer;
+ fChangedCount: NativeInt;
+ procedure doChanged;
+ procedure subMemberChanged(sender : TObject);
+ procedure setOptsColl(const aValue: TCollection);
+ procedure setFname(const aValue: string);
+ procedure setSrcs(const aValue: TStringList);
+ procedure setConfIx(aValue: Integer);
+ function getConfig(const ix: integer): TCompilerConfiguration;
+ function getCurrConf: TCompilerConfiguration;
+ published
+ property OptionsCollection: TCollection read fOptsColl write setOptsColl;
+ property Sources: TStringList read fSrcs write setSrcs; // 'read' should return a copy to avoid abs/rel errors
+ property ConfigurationIndex: Integer read fConfIx write setConfIx;
+ public
+ constructor create(aOwner: TComponent); override;
+ destructor destroy; override;
+ procedure beforeChanged;
+ procedure afterChanged;
+ procedure reset;
+ function getAbsoluteSourceName(const aIndex: integer): string;
+ function getAbsoluteFilename(const aFilename: string): string;
+ procedure addSource(const aFilename: string);
+ function addConfiguration: TCompilerConfiguration;
+ procedure getOpts(const aList: TStrings);
+ procedure afterLoad;
+ //
+ property configuration[ix: integer]: TCompilerConfiguration read getConfig;
+ property currentConfiguration: TCompilerConfiguration read getCurrConf;
+ property fileName: string read fFilename write setFname;
+ property onChange: TNotifyEvent read fOnChange write fOnChange;
+ end;
+
+implementation
+
+uses
+ ce_common;
+
+constructor TCEProject.create(aOwner: TComponent);
+begin
+ inherited create(aOwner);
+ fSrcs := TStringList.Create;
+ fSrcs.OnChange := @subMemberChanged;
+ fSrcsCop := TStringList.Create;
+ fOptsColl := TCollection.create(TCompilerConfiguration);
+ reset;
+end;
+
+destructor TCEProject.destroy;
+begin
+ fOnChange := nil;
+ fSrcs.free;
+ fSrcsCop.Free;
+ fOptsColl.free;
+ inherited;
+end;
+
+function TCEProject.addConfiguration: TCompilerConfiguration;
+begin
+ result := TCompilerConfiguration(fOptsColl.Add);
+ result.onChanged := @subMemberChanged;
+end;
+
+procedure TCEProject.setOptsColl(const aValue: TCollection);
+var
+ i: nativeInt;
+begin
+ fOptsColl.Assign(aValue);
+ for i:= 0 to self.fOptsColl.Count-1 do
+ Configuration[i].onChanged := @subMemberChanged;
+end;
+
+procedure TCEProject.addSource(const aFilename: string);
+var
+ relSrc, absSrc: string;
+begin
+ for relSrc in fSrcs do
+ begin
+ absSrc := expandFilenameEx(fBasePath,relsrc);
+ if aFilename = absSrc then exit;
+ end;
+ fSrcs.Add(ExtractRelativepath(fBasePath,aFilename));
+end;
+
+procedure TCEProject.setFname(const aValue: string);
+var
+ oldAbs, newRel, oldBase: string;
+ i: NativeInt;
+begin
+ if fFilename = aValue then exit;
+ //
+ beforeChanged;
+
+ fFilename := aValue;
+ oldBase := fBasePath;
+ fBasePath := extractFilePath(fFilename);
+ //
+ for i:= 0 to fSrcs.Count-1 do
+ begin
+ oldAbs := expandFilenameEx(oldBase,fSrcs[i]);
+ newRel := ExtractRelativepath(fBasePath, oldAbs);
+ fSrcs[i] := newRel;
+ end;
+ //
+ afterChanged;
+end;
+
+procedure TCEProject.setSrcs(const aValue: TStringList);
+begin
+ beforeChanged;
+ fSrcs.Assign(aValue);
+ patchPlateformPaths(fSrcs);
+ afterChanged;
+end;
+
+procedure TCEProject.afterLoad;
+begin
+ patchPlateformPaths(fSrcs);
+end;
+
+procedure TCEProject.setConfIx(aValue: Integer);
+begin
+ if fConfIx = aValue then exit;
+ beforeChanged;
+ if aValue < 0 then aValue := 0;
+ if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1;
+ fConfIx := aValue;
+ afterChanged;
+end;
+
+procedure TCEProject.subMemberChanged(sender : TObject);
+begin
+ beforeChanged;
+ fModified := true;
+ afterChanged;
+end;
+
+procedure TCEProject.beforeChanged;
+begin
+ Inc(fChangedCount);
+end;
+
+procedure TCEProject.afterChanged;
+begin
+ Dec(fChangedCount);
+ if fChangedCount > 0 then
+ begin
+ {$IFDEF DEBUG}
+ writeln('project update count > 0');
+ {$ENDIF}
+ exit;
+ end;
+ fChangedCount := 0;
+ doChanged;
+end;
+
+procedure TCEProject.doChanged;
+{$IFDEF DEBUG}
+var
+ lst: TStringList;
+{$ENDIF}
+begin
+ fModified := true;
+ if assigned(fOnChange) then fOnChange(Self);
+ {$IFDEF DEBUG}
+ lst := TStringList.Create;
+ try
+ lst.Add('---------begin----------');
+ getOpts(lst);
+ lst.Add('---------end-----------');
+ writeln(lst.Text);
+ finally
+ lst.Free;
+ end;
+ {$ENDIF}
+end;
+
+function TCEProject.getConfig(const ix: integer): TCompilerConfiguration;
+begin
+ result := TCompilerConfiguration(fOptsColl.Items[ix]);
+ result.onChanged := @subMemberChanged;
+end;
+
+function TCEProject.getCurrConf: TCompilerConfiguration;
+begin
+ result := TCompilerConfiguration(fOptsColl.Items[fConfIx]);
+end;
+
+procedure TCEProject.reset;
+var
+ defConf: TCompilerConfiguration;
+begin
+ beforeChanged;
+ fConfIx := 0;
+ fOptsColl.Clear;
+ defConf := addConfiguration;
+ defConf.name := 'default';
+ fSrcs.Clear;
+ fFilename := '';
+ afterChanged;
+end;
+
+procedure TCEProject.getOpts(const aList: TStrings);
+var
+ rel, abs: string;
+begin
+ if fConfIx = -1 then exit;
+ for rel in fSrcs do if rel <> '' then
+ begin
+ abs := expandFilenameEx(fBasePath,rel);
+ aList.Add(abs); // process.inc ln 249. double quotes are added anyway if there's a space...
+ end;
+ TCompilerConfiguration(fOptsColl.Items[fConfIx]).getOpts(aList);
+end;
+
+function TCEProject.getAbsoluteSourceName(const aIndex: integer): string;
+begin
+ if aIndex < 0 then exit('');
+ if aIndex > fSrcs.Count-1 then exit('');
+ result := expandFileNameEx(fBasePath, fSrcs.Strings[aIndex]);
+end;
+
+function TCEProject.getAbsoluteFilename(const aFilename: string): string;
+begin
+ result := expandFileNameEx(fBasePath, aFilename);
+end;
+
+initialization
+ RegisterClasses([TCEProject]);
+end.
diff --git a/src/ce_projinspect.pas b/src/ce_projinspect.pas
index e35cc6df..38c1ec5f 100644
--- a/src/ce_projinspect.pas
+++ b/src/ce_projinspect.pas
@@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, TreeFilterEdit, Forms, Controls, Graphics,
- Dialogs, ExtCtrls, ComCtrls, Menus, Buttons, ce_common, ce_widget;
+ Dialogs, ExtCtrls, ComCtrls, Menus, Buttons, ce_project, ce_widget;
type
{ TCEProjectInspectWidget }
diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas
index 7defcb26..12e56eca 100644
--- a/src/ce_synmemo.pas
+++ b/src/ce_synmemo.pas
@@ -5,8 +5,8 @@ unit ce_synmemo;
interface
uses
- Classes, SysUtils, SynEdit, SynMemo, ce_common, ce_d2syn,
- SynPluginSyncroEdit, SynEditKeyCmds;
+ Classes, SysUtils, SynEdit, SynMemo, ce_d2syn,
+ SynPluginSyncroEdit, SynEditKeyCmds, ce_project;
type
@@ -43,8 +43,8 @@ begin
//
Gutter.LineNumberPart.ShowOnlyLineNumbersMultiplesOf := 5;
Gutter.LineNumberPart.MarkupInfo.Foreground := clGray;
- Gutter.SeparatorPart.LineOffset:=1;
- Gutter.SeparatorPart.LineWidth:=1;
+ Gutter.SeparatorPart.LineOffset := 1;
+ Gutter.SeparatorPart.LineWidth := 1;
Gutter.SeparatorPart.MarkupInfo.Foreground := clGray;
Gutter.CodeFoldPart.MarkupInfo.Foreground := clGray;
//
diff --git a/src/ce_widget.pas b/src/ce_widget.pas
index 987ae8e5..967b7f46 100644
--- a/src/ce_widget.pas
+++ b/src/ce_widget.pas
@@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls,
- AnchorDocking, AnchorDockStorage, ActnList, Menus, ce_common;
+ AnchorDocking, AnchorDockStorage, ActnList, Menus,
+ ce_widgettypes, ce_project;
type
diff --git a/src/ce_widgettypes.pas b/src/ce_widgettypes.pas
new file mode 100644
index 00000000..8f7163dd
--- /dev/null
+++ b/src/ce_widgettypes.pas
@@ -0,0 +1,40 @@
+unit ce_widgettypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, actnList, ce_project;
+
+type
+
+ (**
+ * An implementer is informed when a new document is added, focused or closed.
+ *)
+ ICEMultiDocMonitor = interface
+ procedure docChange(const aNewIndex: integer);
+ procedure docClose(const aNewIndex: integer);
+ end;
+
+ (**
+ * An implementer adds some menu actions when its context is valid.
+ *)
+ ICEContextualActions = interface
+ function contextName: string;
+ function contextActionCount: integer;
+ function contextAction(index: integer): TAction;
+ end;
+
+ (**
+ * An implementer is informed when a project changes.
+ *)
+ ICEProjectMonitor = interface
+ procedure projNew(const aProject: TCEProject);
+ procedure projChange(const aProject: TCEProject);
+ procedure projClose(const aProject: TCEProject);
+ end;
+
+implementation
+end.
+