commit 9866f22820390d273d8c3faeb72252382c12ea2d Author: Basile Burg Date: Tue Jun 10 12:23:58 2014 +0200 r1 diff --git a/lazproj/coedit.ico b/lazproj/coedit.ico new file mode 100644 index 00000000..0341321b Binary files /dev/null and b/lazproj/coedit.ico differ diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi new file mode 100644 index 00000000..a3f17711 --- /dev/null +++ b/lazproj/coedit.lpi @@ -0,0 +1,222 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="3"> + <Item1 Name="Default" Default="True"/> + <Item2 Name="Debug"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="coedit"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf2Set"/> + <UseHeaptrc Value="True"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CustomOptions Value="-dDEBUG"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + </Item2> + <Item3 Name="Release"> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="coedit"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + </Debugging> + <LinkSmart Value="True"/> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CustomOptions Value="-dRELEASE"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + </Item3> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="3"> + <Item1> + <PackageName Value="SynEdit"/> + </Item1> + <Item2> + <PackageName Value="LazControls"/> + </Item2> + <Item3> + <PackageName Value="LCL"/> + </Item3> + </RequiredPackages> + <Units Count="9"> + <Unit0> + <Filename Value="coedit.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="coedit"/> + </Unit0> + <Unit1> + <Filename Value="..\src\ce_main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CEMainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ce_main"/> + </Unit1> + <Unit2> + <Filename Value="..\src\ce_frame.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CEWidget"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ce_frame"/> + </Unit2> + <Unit3> + <Filename Value="..\src\ce_common.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ce_common"/> + </Unit3> + <Unit4> + <Filename Value="..\src\ce_messages.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CEMessagesWidget"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ce_messages"/> + </Unit4> + <Unit5> + <Filename Value="..\src\ce_editor.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CEEditorWidget"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ce_editor"/> + </Unit5> + <Unit6> + <Filename Value="..\src\ce_d2syn.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ce_d2syn"/> + </Unit6> + <Unit7> + <Filename Value="..\src\ce_project.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="CEProjectWidget"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ce_project"/> + </Unit7> + <Unit8> + <Filename Value="..\src\ce_synmemo.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ce_synmemo"/> + </Unit8> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="coedit"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\src"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <MsgFileName Value=""/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/lazproj/coedit.lpr b/lazproj/coedit.lpr new file mode 100644 index 00000000..88f75f68 --- /dev/null +++ b/lazproj/coedit.lpr @@ -0,0 +1,21 @@ +program coedit; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, + Forms, lazcontrols, ce_main, ce_frame, ce_common, + ce_messages, ce_editor, ce_project, ce_synmemo; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TCEMainForm, mainForm); + Application.Run; +end. + diff --git a/notes.txt b/notes.txt new file mode 100644 index 00000000..d318c05c --- /dev/null +++ b/notes.txt @@ -0,0 +1,23 @@ +---------------------------------------- +combined D compiler (Co) & editor (edit) +---------------------------------------- + +Multi-plateform D code editor and D compiler wrapper. + +Initial features: + +- projects. +- multi projects configurations (set of switches and options). +- project configurations templates (release, debug, etc.). +- D syntax highlighter. +- compile, run directly from UI. +- instant run (without saving, script-like). +- basic auto completion (brackets, KW, ...) + +Future: +- project groups. +- plug-in interface. +- completion proposal (dcd or using json doc). +- dynamic grammatical verification +- Git integration. +- debugger. \ No newline at end of file diff --git a/src/ce_common.pas b/src/ce_common.pas new file mode 100644 index 00000000..8ffdfa24 --- /dev/null +++ b/src/ce_common.pas @@ -0,0 +1,125 @@ +unit ce_common; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, ce_dmdwrap; + +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 informs when a new document is added, focused or closed. + *) + ICEMultiDocEmitter = interface + procedure docChange(const aNewIndex: integer); + procedure docClose(const aNewIndex: integer); + end; + + (***************************************************************************** + * Writable project. + *) + TCEProject = class(TComponent) + private + fModified: boolean; + fFilename: string; + fOptsColl: TCollection; + fSrcs: TStringList; // an editor can be associated to a file using the Object[] property + fConfIx: Integer; + 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; + published + property OptionsCollection: TCollection read fOptsColl write setOptsColl; + property Sources: TStringList read fSrcs write setSrcs; + property ConfigurationIndex: Integer read fConfIx write setConfIx; + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + function addConfiguration: TCompilerConfiguration; + property configuration[ix: integer]: TCompilerConfiguration read getConfig; + property fileName: string read fFilename write setFname; + end; + +implementation + +(***************************************************************************** + * TProject + *) +constructor TCEProject.create(aOwner: TComponent); +var + defConf: TCompilerConfiguration; +begin + inherited create(aOwner); + fSrcs := TStringList.Create; + fSrcs.OnChange := @subMemberChanged; + fOptsColl := TCollection.create(TCompilerConfiguration); + + defConf := addConfiguration; + defConf.name := 'default'; +end; + +destructor TCEProject.destroy; +begin + fSrcs.free; + fOptsColl.free; + inherited; +end; + +function TCEProject.addConfiguration: TCompilerConfiguration; +begin + result := TCompilerConfiguration(fOptsColl.Add); + result.onChanged := @subMemberChanged; +end; + +procedure TCEProject.setOptsColl(const aValue: TCollection); +begin + fOptsColl.Assign(aValue); +end; + +procedure TCEProject.setFname(const aValue: string); +begin + if fFilename = aValue then exit; + fFilename := aValue; + subMemberChanged(nil); +end; + +procedure TCEProject.setSrcs(const aValue: TStringList); +begin + fSrcs.Assign(aValue); + subMemberChanged(nil); +end; + +procedure TCEProject.setConfIx(aValue: Integer); +begin + if fConfIx = aValue then exit; + if aValue < 0 then aValue := 0; + if aValue > fOptsColl.Count-1 then aValue := fOptsColl.Count-1; + fConfIx := aValue; + subMemberChanged(nil); +end; + +procedure TCEProject.subMemberChanged(sender : TObject); +begin + fModified := true; +end; + +function TCEProject.getConfig(const ix: integer): TCompilerConfiguration; +begin + result := TCompilerConfiguration(fOptsColl.Items[ix]); +end; + +end. + diff --git a/src/ce_d2syn.pas b/src/ce_d2syn.pas new file mode 100644 index 00000000..3d18c032 --- /dev/null +++ b/src/ce_d2syn.pas @@ -0,0 +1,807 @@ +unit ce_d2syn; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + SynEditHighlighter, SynEditHighlighterFoldBase, SynEditTypes; + +const + + D2Kw: array[0..109] of string = + ( 'abstract', 'alias', 'align', 'asm', 'assert', 'auto', + 'body', 'bool', 'break', 'byte', + 'case', 'cast', 'catch', 'cdouble', 'cent', 'cfloat', 'char', 'class', + 'const', 'continue', 'creal', + 'dchar', 'debug', 'default', 'delegate', 'delete', 'deprecated', 'do', 'double', + 'else', 'enum', 'export', 'extern', + 'false', 'final', 'finally', 'float', 'for', 'foreach', + 'foreach_reverse', 'function', + 'goto', + 'idouble', 'if', 'ifloat', 'immutable', 'import', 'in', 'inout', 'int', + 'interface', 'invariant', 'ireal', 'is', + 'lazy', 'long', + 'macro', 'mixin', 'module', + 'new', 'nothrow', 'null', + 'out', 'override', + 'package', 'pragma', 'private', 'protected', 'ptrdiff_t', 'public', 'pure', + 'real', 'ref', 'return', + 'size_t', 'scope', 'shared', 'short', 'static', 'string', 'struct', + 'super', 'switch', 'synchronized', + 'template', 'this', 'throw', 'true', 'try', 'typedef', 'typeid', 'typeof', + 'ubyte', 'ucent', 'uint', 'ulong', 'union', 'unittest', 'ushort', + 'version', 'void', 'volatile', + 'wchar', 'while', 'with', + '__FILE__', '__MODULE__', '__LINE__', '__FUNCTION__', '__PRETTY_FUNCTION__' + ); + +type + + TD2DictionaryEntry = record + filled: Boolean; + values: array of string; + end; + + TD2Dictionary = object + private + fLongest: NativeInt; + fEntries: array[0..1024] of TD2DictionaryEntry; + function toHash(const aValue: string): word; + procedure addEntry(const aValue: string); + public + constructor create; + function find(const aValue: string): boolean; + end; + + TTokenKind = (tkCommt, tkIdent, tkKeywd, tkStrng, tkBlank, tkSymbl, tkNumbr, tkCurrI); + + TRangeKind = (rkNone, rkString1, rkString2, rkBlockCom1, rkBlockCom2, rkAsm); + + TFoldKind = (fkBrackets, fkComments1, fkComments2); + TFoldKinds = set of TFoldKind; + + TSynD2Syn = class (TSynCustomFoldHighlighter) + private + fWhiteAttrib: TSynHighlighterAttributes; + fNumbrAttrib: TSynHighlighterAttributes; + fSymblAttrib: TSynHighlighterAttributes; + fIdentAttrib: TSynHighlighterAttributes; + fCommtAttrib: TSynHighlighterAttributes; + fStrngAttrib: TSynHighlighterAttributes; + fKeywdAttrib: TSynHighlighterAttributes; + fCurrIAttrib: TSynHighlighterAttributes; + fKeyWords: TD2Dictionary; + fCurrIdent: string; + fLineBuf: string; + fTokStart, fTokStop: Integer; + fTokKind: TTokenKind; + fRange: TRangeKind; + fFoldKinds: TFoldKinds; + fAttribLut: array[TTokenKind] of TSynHighlighterAttributes; + function readNext: Char; + function readCurr: Char; + function readPrev: Char; + procedure setFoldKinds(aValue: TFoldKinds); + procedure setWhiteAttrib(aValue: TSynHighlighterAttributes); + procedure setNumbrAttrib(aValue: TSynHighlighterAttributes); + procedure setSymblAttrib(aValue: TSynHighlighterAttributes); + procedure setIdentAttrib(aValue: TSynHighlighterAttributes); + procedure setCommtAttrib(aValue: TSynHighlighterAttributes); + procedure setStrngAttrib(aValue: TSynHighlighterAttributes); + procedure setKeywdAttrib(aValue: TSynHighlighterAttributes); + procedure setCurrIAttrib(aValue: TSynHighlighterAttributes); + procedure doAttribChange(sender: TObject); + procedure setCurrIdent(const aValue: string); + procedure doChanged; + published + property FoldKinds: TFoldKinds read fFoldKinds write setFoldKinds; + property WhiteAttrib: TSynHighlighterAttributes read fWhiteAttrib write setWhiteAttrib; + property NumbrAttrib: TSynHighlighterAttributes read fNumbrAttrib write setNumbrAttrib; + property SymblAttrib: TSynHighlighterAttributes read fSymblAttrib write setSymblAttrib; + property IdentAttrib: TSynHighlighterAttributes read fIdentAttrib write setIdentAttrib; + property CommtAttrib: TSynHighlighterAttributes read fCommtAttrib write setCommtAttrib; + property StrngAttrib: TSynHighlighterAttributes read fStrngAttrib write setStrngAttrib; + property KeywdAttrib: TSynHighlighterAttributes read fKeywdAttrib write setKeywdAttrib; + property CurrIAttrib: TSynHighlighterAttributes read fCurrIAttrib write setCurrIAttrib; + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + procedure GetTokenEx(out TokenStart: PChar; out TokenLength: integer); override; + function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; override; + procedure setLine(const NewValue: String; LineNumber: Integer); override; + procedure next; override; + function GetTokenAttribute: TSynHighlighterAttributes; override; + function GetToken: string; override; + function GetTokenKind: integer; override; + function GetTokenPos: Integer; override; + function GetEol: Boolean; override; + procedure SetRange(Value: Pointer); override; + procedure ResetRange; override; + function GetRange: Pointer; override; + property CurrentIdentifier: string read fCurrIdent write setCurrIdent; + end; + +implementation + +function isWhite(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := c in [#0..#32]; +end; + +function isSpace(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := c in [#9,' ']; +end; + +function isAlpha(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := (c in ['a'..'z']) or (c in ['A'..'Z']); +end; + +function isNumber(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := (c in ['0'..'9']); +end; + +function isDigit(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := (c in ['0'..'1']); +end; + +function isAlNum(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := isAlpha(c) or isNumber(c); +end; + +function isHex(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := isNumber(c) or (c in ['A'..'F']) or (c in ['a'..'f']); +end; + +function isSymbol(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := c in [';', '{', '}', '(', ')', '[', ']', ',', '.', ':' , '"', #39, '?']; +end; + +function isOperator(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := c in ['/', '*', '-', '+', '%', '>', '<', '=', '!', + '&', '|', '^', '~', '$']; +end; + +function isDoubleOperator(const s: string): boolean; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := false; + case s[1] of + '.': result := (s[2] = '.'); + + '>': result := s[2] in ['>', '=']; + '<': result := s[2] in ['<', '=', '>']; + '=': result := s[2] in ['=', '>']; + '!': result := s[2] in ['=', '>', '<']; + + '+': result := s[2] in ['+', '=']; + '-': result := s[2] in ['-', '=']; + '/': result := s[2] in ['=']; + '*': result := s[2] in ['=']; + '%': result := s[2] in ['=']; + '~': result := s[2] in ['=']; + + '&': result := s[2] in ['&', '=']; + '|': result := s[2] in ['|', '=']; + '^': result := s[2] in ['^', '=']; + end; +end; + +function isTripleOperator(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF} +begin + result := false; + case s[1] of + '.': result := (s[2] = '.') and (s[3] = '.'); + '^': result := (s[2] = '^') and (s[3] = '='); + '>': result := (s[2] = '>') and (s[3] in ['>', '=']); + '<': result := ((s[2] = '<') and (s[3] in ['<', '='])) + or (s[2] = '>') and (s[3] = '='); + '!': result := ((s[2] = '<') and (s[3] in ['>', '='])) + or ((s[2] = '>')and (s[3] = '=')); + end; +end; + +function isQuadOperator(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF} +begin + result := (s = '>>>=') or (s = '!<>='); +end; + +constructor TD2Dictionary.create; +var + value: string; +begin + for value in D2Kw do + begin + addEntry(value); + end; +end; + +{$IFDEF DEBUG}{$R-}{$ENDIF} +function TD2Dictionary.toHash(const aValue: string): word; +var + i, len: Integer; + prev: word; +begin + result := 0; + prev := 0; + len := length(aValue); + for i := 1 to len do + begin + result += ((Byte(aValue[i]) + 64) shl i) xor prev; + prev := Byte(aValue[i]); + end; + result := result and 1023; +end; +{$IFDEF DEBUG}{$R+}{$ENDIF} + +procedure TD2Dictionary.addEntry(const aValue: string); +var + hash: word; +begin + if find(aValue) then + exit; + + hash := toHash(aValue); + assert(hash < 1024); + + fEntries[hash].filled := true; + setLength(fEntries[hash].values, length(fEntries[hash].values) + 1); + fEntries[hash].values[high(fEntries[hash].values)] := aValue; + if fLongest <= length(aValue) then + fLongest := length(aValue); +end; + +function TD2Dictionary.find(const aValue: string): boolean; +var + hash: word; + i: NativeInt; +begin + if length(aValue) > fLongest then + result := false + else + begin + hash := toHash(aValue); + if (not fEntries[hash].filled) then + result := false else + begin + for i:= 0 to high(fEntries[hash].values) do + begin + if fEntries[hash].values[i] = aValue then + begin + result := true; + exit; + end; + result := false; + end + end; + end; +end; + + +constructor TSynD2Syn.create(aOwner: TComponent); +begin + inherited create(aOwner); + + DefaultFilter:= '.d|.di'; + + fKeyWords.create; + + fFoldKinds := [fkBrackets]; + + fWhiteAttrib := TSynHighlighterAttributes.Create('White','White'); + fNumbrAttrib := TSynHighlighterAttributes.Create('Number','Number'); + fSymblAttrib := TSynHighlighterAttributes.Create('Symbol','Symbol'); + fIdentAttrib := TSynHighlighterAttributes.Create('Identifier','Identifier'); + fCommtAttrib := TSynHighlighterAttributes.Create('Comment','Comment'); + fStrngAttrib := TSynHighlighterAttributes.Create('String','String'); + fKeywdAttrib := TSynHighlighterAttributes.Create('Keyword','Keyword'); + fCurrIAttrib := TSynHighlighterAttributes.Create('CurrentIdentifier','CurrentIdentifier'); + + fNumbrAttrib.Foreground := $000079F2; + fSymblAttrib.Foreground := clMaroon; + fIdentAttrib.Foreground := clBlack; + fCommtAttrib.Foreground := clGreen; + fStrngAttrib.Foreground := clBlue; + fKeywdAttrib.Foreground := clNavy; + + fCurrIAttrib.Foreground := clBlack; + fCurrIAttrib.FrameEdges:= sfeAround; + fCurrIAttrib.FrameColor:= clRed; + + fCommtAttrib.Style := [fsItalic]; + fKeywdAttrib.Style := [fsBold]; + + AddAttribute(fWhiteAttrib); + AddAttribute(fNumbrAttrib); + AddAttribute(fSymblAttrib); + AddAttribute(fIdentAttrib); + AddAttribute(fCommtAttrib); + AddAttribute(fStrngAttrib); + AddAttribute(fKeywdAttrib); + AddAttribute(fCurrIAttrib); + + fAttribLut[TTokenKind.tkident] := fIdentAttrib; + fAttribLut[TTokenKind.tkBlank] := fWhiteAttrib; + fAttribLut[TTokenKind.tkCommt] := fCommtAttrib; + fAttribLut[TTokenKind.tkKeywd] := fKeywdAttrib; + fAttribLut[TTokenKind.tkNumbr] := fNumbrAttrib; + fAttribLut[TTokenKind.tkStrng] := fStrngAttrib; + fAttribLut[TTokenKind.tksymbl] := fSymblAttrib; + fAttribLut[TTokenKind.tkCurrI] := fCurrIAttrib; + + SetAttributesOnChange(@doAttribChange); + fTokStop := 1; + next; +end; + +destructor TSynD2Syn.destroy; +begin + inherited; +end; + +procedure TSynD2Syn.doChanged; +begin + BeginUpdate; + fUpdateChange := true; + EndUpdate; +end; + +{$HINTS OFF} +procedure TSynD2Syn.doAttribChange(sender: TObject); +begin + doChanged; +end; +{$HINTS ON} + +procedure TSynD2Syn.setFoldKinds(aValue: TFoldKinds); +begin + fFoldKinds := aValue; + DoFoldConfigChanged(Self); + doChanged; +end; + +procedure TSynD2Syn.setWhiteAttrib(aValue: TSynHighlighterAttributes); +begin + fWhiteAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setNumbrAttrib(aValue: TSynHighlighterAttributes); +begin + fNumbrAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setSymblAttrib(aValue: TSynHighlighterAttributes); +begin + fSymblAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setIdentAttrib(aValue: TSynHighlighterAttributes); +begin + fIdentAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setCommtAttrib(aValue: TSynHighlighterAttributes); +begin + fCommtAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setStrngAttrib(aValue: TSynHighlighterAttributes); +begin + fStrngAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setKeywdAttrib(aValue: TSynHighlighterAttributes); +begin + fKeywdAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setCurrIAttrib(aValue: TSynHighlighterAttributes); +begin + fCurrIAttrib.Assign(aValue); +end; + +procedure TSynD2Syn.setCurrIdent(const aValue: string); +begin + if aValue = '' then exit; + if fCurrIdent = aValue then Exit; + fCurrIdent := aValue; + doChanged; +end; + +procedure TSynD2Syn.setLine(const NewValue: String; LineNumber: Integer); +begin + inherited; + fLineBuf := NewValue + #10; + fTokStop := 1; + next; +end; + +{$IFDEF DEBUG}{$R-}{$ENDIF} +function TSynD2Syn.readNext: Char; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + Inc(fTokStop); + result := fLineBuf[fTokStop]; +end; +{$IFDEF DEBUG}{$R+}{$ENDIF} + +function TSynD2Syn.readCurr: Char; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := fLineBuf[fTokStop]; +end; + +function TSynD2Syn.readPrev: Char; {$IFNDEF DEBUG}inline;{$ENDIF} +begin + result := fLineBuf[fTokStop-1]; +end; + +{ +TODO: +- binary literals. +- alternative attributes for ddoc comments. +- asm range. +- stricter number litterals. +- string literals: custom token, escape "\" not handled. +- correct nested comments handling. +} + +procedure TSynD2Syn.next; +begin + + fTokStart := fTokStop; + fTokStop := fTokStart; + + // EOL + if fTokStop > length(fLineBuf) then exit; + + // spaces + if isWhite(readCurr) then + begin + fTokKind := tkBlank; + while (isWhite(readNext)) do (*!*); + exit; + end; + + // line comment + if fRange = rkNone then if (readCurr = '/') then + begin + if (readNext = '/') then + begin + while readNext <> #10 do (*!*); + fTokKind := tkCommt; + exit; + end + else + Dec(fTokStop); + end; + + // block comments 1 + if fRange = rkBlockCom1 then + begin + while(true) do + begin + if readCurr = #10 then break; + if readNext = #10 then break; + if (readPrev = '*') and (readCurr = '/') then break; + end; + if (readCurr = #10) then + begin + fRange := rkBlockCom1; + fTokKind := tkCommt; + exit; + end; + if (readCurr = '/') then + begin + fTokKind := tkCommt; + fRange := rkNone; + readNext; + if fkComments1 in fFoldKinds then + EndCodeFoldBlock; + exit; + end; + end; + if fRange <> rkBlockCom2 then if (readCurr <> #10) and (readCurr = '/') then if (readNext = '*') then + begin + if fRange = rkNone then + begin + while(true) do + begin + if readCurr = #10 then break; + if readNext = #10 then break; + if (readPrev = '*') and (readCurr = '/') then break; + end; + if (readCurr = #10) then + begin + fRange := rkBlockCom1; + if fkComments1 in fFoldKinds then + StartCodeFoldBlock(nil); + end + else readNext; + fTokKind := tkCommt; + exit; + end; + end + else Dec(fTokStop); + + // block comments 2 + if fRange = rkBlockCom2 then + begin + while(true) do + begin + if readCurr = #10 then break; + if readNext = #10 then break; + if (readPrev = '+') and (readCurr = '/') then break; + end; + if (readCurr = #10) then + begin + fRange := rkBlockCom2; + fTokKind := tkCommt; + exit; + end; + if (readCurr = '/') then + begin + fTokKind := tkCommt; + fRange := rkNone; + readNext; + if fkComments2 in fFoldKinds then + EndCodeFoldBlock; + exit; + end; + end; + if fRange <> rkBlockCom1 then if (readCurr <> #10) and (readCurr = '/') then if (readNext = '+') then + begin + if fRange = rkNone then + begin + while(true) do + begin + if readCurr = #10 then break; + if readNext = #10 then break; + if (readPrev = '+') and (readCurr = '/') then break; + end; + if (readCurr = #10) then + begin + fRange := rkBlockCom2; + if fkComments2 in fFoldKinds then + StartCodeFoldBlock(nil); + end + else readNext; + fTokKind := tkCommt; + exit; + end; + end + else Dec(fTokStop); + + // string 1 + if fRange = rkString1 then + begin + if (readCurr <> '"') then while ((readNext <> '"') and (not (readCurr = #10))) do (*!*); + if (readCurr = #10) then + begin + fRange := rkString1; + fTokKind := tkStrng; + exit; + end; + if (readCurr = '"') then + begin + fTokKind := tkStrng; + fRange := rkNone; + readNext; + exit; + end; + end; + if fRange <> rkString2 then if (readCurr = '"') then + begin + if fRange = rkNone then + begin + while ((readNext <> '"') and (not (readCurr = #10))) do (*!*); + if (readCurr = #10) then fRange := rkString1 + else readNext; + fTokKind := tkStrng; + exit; + end; + end; + + // string 2 + if fRange = rkString2 then + begin + if (readCurr <> '`') then while ((readNext <> '`') and (not (readCurr = #10))) do (*!*); + if (readCurr = #10) then + begin + fRange := rkString2; + fTokKind := tkStrng; + exit; + end; + if (readCurr = '`') then + begin + fTokKind := tkStrng; + fRange := rkNone; + readNext; + exit; + end; + end; + if fRange <> rkString1 then if (readCurr = '`') then + begin + if fRange = rkNone then + begin + while ((readNext <> '`') and (not (readCurr = #10))) do (*!*); + if (readCurr = #10) then fRange := rkString2 + else readNext; + fTokKind := tkStrng; + exit; + end; + end; + + // char literals + if fRange = rkNone then if (readCurr = #39) then + begin + while ((readNext <> #39) and (not (readCurr = #10))) do (*!*); + if (readCurr = #39) then + begin + fTokKind := tkStrng; + readNext; + exit; + end; + fTokStop := fTokStart; + end; + + // numbers 1 + if (isNumber(readCurr)) then + begin + while isAlNum(readNext) or (readCurr = '_') or (readCurr = '.') do (*!*); + fTokKind := tkNumbr; + exit; + end; + + // symbols 1: ponctuation + if isSymbol(readCurr) then + begin + fTokKind := tkSymbl; + if (fkBrackets in fFoldKinds) then case readCurr of + '{': StartCodeFoldBlock(nil); + '}': EndCodeFoldBlock; + end; + readNext; + exit; + end; + + // symbols 2: operators + if isOperator(readCurr) then + begin + fTokKind := tkSymbl; + while isOperator(readNext) do (*!*); + case fTokStop - fTokStart of + 1:begin + if not isOperator(readCurr) then exit + else Dec(fTokStop); + end; + 2:begin + if (not isOperator(readCurr)) and + isDoubleOperator(fLineBuf[fTokStart..fTokStop-1]) + then exit + else Dec(fTokStop, 2); + end; + 3:begin + if (not isOperator(readCurr)) and + isTripleOperator(fLineBuf[fTokStart..fTokStop-1]) + then exit + else Dec(fTokStop, 3); + end; + 4:begin + if (not isOperator(readCurr)) and + isQuadOperator(fLineBuf[fTokStart..fTokStop-1]) + then exit + else Dec(fTokStop, 4); + end; + end; + fTokKind := tkIdent; + end; + + // Keyword - Identifier + if not isWhite(readCurr) then + begin + fTokKind := tkIdent; + while(true) do + begin + if isWhite(readNext) then break; + if isSymbol(readCurr) then break; + if isOperator(readCurr) then break; + end; + if fKeyWords.find(fLineBuf[FTokStart..fTokStop-1]) then + fTokKind := tkKeywd + else + if fLineBuf[FTokStart..fTokStop-1] = fCurrIdent then + fTokKind := tkCurrI; + exit; + end; + + if fLineBuf[fTokStop] = #10 then exit; + + // Should not happend + assert(false); +end; + +function TSynD2Syn.GetEol: Boolean; +begin + result := fTokStop > length(fLineBuf); +end; + +function TSynD2Syn.GetTokenAttribute: TSynHighlighterAttributes; +begin + result := fAttribLut[fTokKind]; +end; + +{$WARNINGS OFF} {$HINTS OFF} +procedure TSynD2Syn.SetRange(Value: Pointer); +begin + inherited SetRange(Value); + fRange := TRangeKind(PtrInt(CodeFoldRange.RangeType)); +end; +{$HINTS ON} {$WARNINGS ON} + +{$HINTS OFF} +function TSynD2Syn.GetRange: Pointer; +begin + CodeFoldRange.RangeType := Pointer(PtrInt(fRange)); + Result := inherited GetRange; +end; +{$HINTS ON} + +procedure TSynD2Syn.ResetRange; +begin + fRange := rkNone; +end; + +function TSynD2Syn.GetTokenPos: Integer; +begin + result := fTokStart - 1; +end; + +function TSynD2Syn.GetToken: string; +begin + result := copy(fLineBuf, FTokStart, fTokStop - FTokStart); +end; + +procedure TSynD2Syn.GetTokenEx(out TokenStart: PChar; out TokenLength: integer); +begin + TokenStart := @fLineBuf[FTokStart]; + TokenLength := fTokStop - FTokStart; +end; + +function TSynD2Syn.GetDefaultAttribute(Index: integer): TSynHighlighterAttributes; +begin + case Index of + SYN_ATTR_COMMENT: Result := fCommtAttrib; + SYN_ATTR_IDENTIFIER: Result := fIdentAttrib; + SYN_ATTR_KEYWORD: Result := fKeywdAttrib; + SYN_ATTR_STRING: Result := fStrngAttrib; + SYN_ATTR_WHITESPACE: Result := fWhiteAttrib; + SYN_ATTR_SYMBOL: Result := fSymblAttrib; + else Result := fIdentAttrib; + end; +end; + +function TSynD2Syn.GetTokenKind: integer; +var + a: TSynHighlighterAttributes; +begin + Result := SYN_ATTR_IDENTIFIER; + a := GetTokenAttribute; + if a = fIdentAttrib then Result := SYN_ATTR_IDENTIFIER else + if a = fWhiteAttrib then Result := SYN_ATTR_WHITESPACE else + if a = fCommtAttrib then Result := SYN_ATTR_COMMENT else + if a = fKeywdAttrib then Result := SYN_ATTR_KEYWORD else + if a = fStrngAttrib then Result := SYN_ATTR_STRING else + if a = fSymblAttrib then Result := SYN_ATTR_SYMBOL else + if a = fNumbrAttrib then Result := Ord(TTokenKind.tkNumbr); +end; + +initialization + registerClasses([TSynD2Syn]); +end. diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas new file mode 100644 index 00000000..3e344fb1 --- /dev/null +++ b/src/ce_dmdwrap.pas @@ -0,0 +1,577 @@ +unit ce_dmdwrap; + +{$mode objfpc}{$H+} + +interface + +uses + classes, sysutils; + + +type + + (***************************************************************************** + * Base class for encapsulating some compiler options. + * A descendant must be able to generate the related options + * as a string representing the partial switches/arguments. + *) + TOptsGroup = class(TPersistent) + private + fOnChange: TNotifyEvent; + procedure doChanged; + protected + property onChange: TNotifyEvent read fOnChange write fOnChange; + public + function getOpts: string; virtual; abstract; + end; + + (***************************************************************************** + * Encapsulates the options/args related to the DDoc and JSON generation. + *) + TDocOpts = class(TOptsGroup) + private + fGenDoc: boolean; + fDocDir: string; + fGenJson: boolean; + fJsonFname: string; + procedure setGenDoc(const aValue: boolean); + procedure setGenJSON(const aValue: boolean); + procedure setDocDir(const aValue: string); + procedure setJSONFile(const aValue: string); + published + property generateDocumentation: boolean read fGenDoc write setGenDoc; + property generateJSON: boolean read fGenJson write setGenJSON; + property DocumentationDirectory: string read fDocDir write setDocDir; + property JSONFilename: string read fJsonFname write setJSONFile; + public + function getOpts: string; override; + end; + + + (***************************************************************************** + * Describes the different depreciation treatments. + *) + TDepHandling = (silent, warning, error); + + (***************************************************************************** + * Encapsulates the options/args related to the compiler output messages. + *) + TMsgOpts = class(TOptsGroup) + private + fDepHandling : TDepHandling; // could be also related to analysis + fVerb: boolean; + fWarn: boolean; + fWarnEx: boolean; + fVtls: boolean; + fQuiet: boolean; + fProp: boolean; + procedure setDepHandling(const aValue: TDepHandling); + procedure setVerb(const aValue: boolean); + procedure setWarn(const aValue: boolean); + procedure setWarnEx(const aValue: boolean); + procedure setVtls(const aValue: boolean); + procedure setQuiet(const aValue: boolean); + published + property depreciationHandling: TDepHandling read fDepHandling write setDepHandling; + property verbose: boolean read fVerb write setVerb; + property warnings: boolean read fWarn write setWarn; + property additionalWarnings: boolean read fWarnEx write setWarnEx; + property tlsInformations: boolean read fVtls write setVtls; + property quiet: boolean read fQuiet write setQuiet; + public + function getOpts: string; override; + end; + + (***************************************************************************** + * Encapsulates the options/args related to the analysis & the code gen. + *) + TOutputOpts= class(TOptsGroup) + private + fInline: boolean; + fNoBounds: boolean; + fOptims: boolean; + fGenStack: boolean; + fMain: boolean; + fRelease: boolean; + procedure setInline(const aValue: boolean); + procedure setNoBounds(const aValue: boolean); + procedure setOptims(const aValue: boolean); + procedure setGenStack(const aValue: boolean); + procedure setMain(const aValue: boolean); + procedure setRelease(const aValue: boolean); + published + property inlining: boolean read fInline write setInline; + property noBoundsCheck: boolean read fNoBounds write setNoBounds; + property optimisations: boolean read fOptims write setOptims; + property generateStackFrame: boolean read fGenStack write setGenStack; + property addMain: boolean read fMain write setMain; + property release: boolean read fRelease write setRelease; + public + function getOpts: string; override; + end; + + (***************************************************************************** + * Describes the target registry size + *) + TTargetSystem = (auto, os32bit, os64bit); + (** + * Describes the output kind + *) + TBinaryKind = (executable, staticlib, sharedlib); + + (** + * Encapsulates the options/args related to the debuging + *) + TDebugOpts = class(TOptsGroup) + private + fDbg: boolean; + fDbgIdent: string; + fDbgD: boolean; + fDbgC: boolean; + fMap: boolean; + published + public + //function getOpts: string; override; + end; + + (***************************************************************************** + * Encapsulates the options/args related to the output and include paths + *) + TPathsOpts = class(TOptsGroup) + private + fSrcs: TStringList; + fIncl: TStringList; + fImpt: TStringList; + fFname: string; + fObjDir: string; + procedure setFname(const aValue: string); + procedure setObjDir(const aValue: string); + procedure setSrcs(const aValue: TStringList); + procedure setIncl(const aValue: TStringList); + procedure setImpt(const aValue: TStringList); + published + property outputFilename: string read fFname write setFname; + property objectDirectory: string read fObjDir write setObjDir; + property Sources: TStringList read fSrcs write setSrcs; // not common srcs, made for static libs + property Includes: TStringList read fIncl write setIncl; + property Imports: TStringList read fImpt write setImpt; + public + constructor create; + destructor destroy; override; + function getOpts: string; override; + end; + + (***************************************************************************** + * Encapsulates the unclassified and custom options/args + *) + TOtherOpts = class(TOptsGroup) + private + fCustom: TStringList; + procedure setCustom(const aValue: TStringList); + published + property customOptions: TStringList read fCustom write setCustom; + public + constructor create; + destructor destroy; override; + function getOpts: string; override; + end; + + (***************************************************************************** + * Encapsulates all the contextual options/args + *) + TCompilerConfiguration = class(TCollectionItem) + private + fName: string; + fOnChanged: TNotifyEvent; + fDocOpts: TDocOpts; + fDebugOpts: TDebugOpts; + fMsgOpts: TMsgOpts; + fOutputOpts: TOutputOpts; + fPathsOpts: TPathsOpts; + fOthers: TOtherOpts; + procedure doChanged; + procedure subOptsChanged(sender: TObject); + procedure setName(const aValue: string); + procedure setDocOpts(const aValue: TDocOpts); + procedure setDebugOpts(const aValue: TDebugOpts); + procedure setMsgOpts(const aValue: TMsgOpts); + procedure setOutputOpts(const aValue: TOutputOpts); + procedure setPathsOpts(const aValue: TPathsOpts); + procedure setOthers(const aValue: TOtherOpts); + protected + function nameFromID: string; + function getCmdLine: string; + published + property name: string read fName write setName; + property documentationOptions: TDocOpts read fDocOpts write setDocOpts; + property debugingOptions: TDebugOpts read fDebugOpts write setDebugOpts; + property messagesOptions: TMsgOpts read fMsgOpts write setMsgOpts; + property outputOptions: TOutputOpts read fOutputOpts write setOutputOpts; + property pathsOptions: TPathsOpts read fPathsOpts write setPathsOpts; + property otherOptions: TOtherOpts read fOthers write setOthers; + public + constructor create(aCollection: TCollection); override; + destructor destroy; override; + property cmdLine: string read getCmdLine; + property onChanged: TNotifyEvent read fOnChanged write fOnChanged; + end; + +implementation + +(******************************************************************************* + * TOptsGroup + *) +procedure TOptsGroup.doChanged; +begin + if assigned(fOnChange) then fOnChange(self); +end; + +(******************************************************************************* + * TDocOpts + *) +function TDocOpts.getOpts: string; +begin + result := ''; + if fGenDoc then result += '-D '; + if fGenJson then result += '-X '; + if fDocDir <> '' then result += '-Dd' + '"' + fDocDir + '" '; + if fJsonFname <> '' then result += '-Xf' + '"'+ fJsonFname + '" '; +end; + +procedure TDocOpts.setGenDoc(const aValue: boolean); +begin + if fGenDoc = aValue then exit; + fGenDoc := aValue; + doChanged; +end; + +procedure TDocOpts.setGenJSON(const aValue: boolean); +begin + if fGenJson = aValue then exit; + fGenJson := aValue; + doChanged; +end; + +procedure TDocOpts.setDocDir(const aValue: string); +begin + if fDocDir = aValue then exit; + fDocDir := aValue; + doChanged; +end; + +procedure TDocOpts.setJSONFile(const aValue: string); +begin + if fJsonFname = aValue then exit; + fJsonFname := aValue; + doChanged; +end; + +(******************************************************************************* + * TMsgOpts + *) +function TMsgOpts.getOpts: string; +const + DepStr : array[TDepHandling] of string = ('-d ','-dw ','-de '); +begin + result := DepStr[fDepHandling]; + if fVerb then result += '-v '; + if fWarn then result += '-w '; + if fWarnEx then result += '-wi '; + if fVtls then result += '-vtls '; + if fQuiet then result += '-quiet '; +end; + +procedure TMsgOpts.setDepHandling(const aValue: TDepHandling); +begin + if fDepHandling = aValue then exit; + fDepHandling := aValue; + doChanged; +end; + +procedure TMsgOpts.setVerb(const aValue: boolean); +begin + if fVerb = aValue then exit; + fVerb := aValue; + doChanged; +end; + +procedure TMsgOpts.setWarn(const aValue: boolean); +begin + if fWarn = aValue then exit; + fWarn := aValue; + doChanged; +end; + +procedure TMsgOpts.setWarnEx(const aValue: boolean); +begin + if fWarnEx = aValue then exit; + fWarnEx := aValue; + doChanged; +end; + +procedure TMsgOpts.setVtls(const aValue: boolean); +begin + if fVtls = aValue then exit; + fVtls := aValue; + doChanged; +end; + +procedure TMsgOpts.setQuiet(const aValue: boolean); +begin + if fQuiet = aValue then exit; + fQuiet := aValue; + doChanged; +end; + +(******************************************************************************* + * TOutputOpts + *) +function TOutputOpts.getOpts: string; +begin + result := ''; + if fInline then result += '-inline '; + if fNoBounds then result += '-noboundscheck '; + if fOptims then result += '-O '; + if fGenStack then result += '-gs '; + if fMain then result += '-main '; + if fRelease then result += '-release '; +end; + +procedure TOutputOpts.setInline(const aValue: boolean); +begin + if fInline = aValue then exit; + fInline := aValue; + doChanged; +end; + +procedure TOutputOpts.setNoBounds(const aValue: boolean); +begin + if fNoBounds = aValue then exit; + fNoBounds := aValue; + doChanged; +end; + +procedure TOutputOpts.setOptims(const aValue: boolean); +begin + if fOptims = aValue then exit; + fOptims := aValue; + doChanged; +end; + +procedure TOutputOpts.setGenStack(const aValue: boolean); +begin + if fGenStack = aValue then exit; + fGenStack := aValue; + doChanged; +end; + +procedure TOutputOpts.setMain(const aValue: boolean); +begin + if fMain = aValue then exit; + fMain := aValue; + doChanged; +end; + +procedure TOutputOpts.setRelease(const aValue: boolean); +begin + if fRelease = aValue then exit; + fRelease := aValue; + doChanged; +end; + +(******************************************************************************* + * TPathsOpts + *) +function TPathsOpts.getOpts: string; +var + str: string; +begin + result := ''; + for str in fSrcs do + result += '"'+ str +'" '; + for str in fIncl do + result += '-I"'+ str +'" '; + for str in fImpt do + result += '-J"'+ str +'" '; + if fFname <> '' then result += '-of"' + fFname + '" '; + if fObjDir <> '' then result += '-od"' + fObjDir + '" '; +end; + +constructor TPathsOpts.create; +begin + fSrcs := TStringList.Create; + fIncl := TStringList.Create; + fImpt := TStringList.Create; +end; + +destructor TPathsOpts.destroy; +begin + fSrcs.free; + fIncl.free; + fImpt.free; + inherited; +end; + +procedure TPathsOpts.setFname(const aValue: string); +begin + if fFname = aValue then exit; + fFname := aValue; + doChanged; +end; + +procedure TPathsOpts.setObjDir(const aValue: string); +begin + if fObjDir = aValue then exit; + fObjDir := aValue; + doChanged; +end; + +procedure TPathsOpts.setSrcs(const aValue: TStringList); +begin + fSrcs.Assign(aValue); + doChanged; +end; + +procedure TPathsOpts.setIncl(const aValue: TStringList); +begin + fIncl.Assign(aValue); + doChanged; +end; + +procedure TPathsOpts.setImpt(const aValue: TStringList); +begin + fImpt.Assign(aValue); + doChanged; +end; + +(******************************************************************************* + * TOtherOpts + *) +constructor TOtherOpts.create; +begin + fCustom := TStringList.Create; +end; + +destructor TOtherOpts.destroy; +begin + fCustom.Destroy; + inherited; +end; + +function TOtherOpts.getOpts: string; +var + str: string; +begin + result := ''; + for str in fCustom do + result += str + ' '; +end; + +procedure TOtherOpts.setCustom(const aValue: TStringList); +begin + fCustom.Assign(aValue); + doChanged; +end; + +(******************************************************************************* + * TCompilerConfiguration + *) +constructor TCompilerConfiguration.create(aCollection: TCollection); +begin + inherited create(aCollection); + + fDocOpts := TDocOpts.create; + fDebugOpts := TDebugOpts.create; + fMsgOpts := TMsgOpts.create; + fOutputOpts := TOutputOpts.create; + fPathsOpts := TPathsOpts.create; + fOthers := TOtherOpts.create; + + fDocOpts.onChange := @subOptsChanged; + fDebugOpts.onChange := @subOptsChanged; + fMsgOpts.onChange := @subOptsChanged; + fOutputOpts.onChange := @subOptsChanged; + fPathsOpts.onChange := @subOptsChanged; + fOthers.onChange := @subOptsChanged; + + fName := nameFromID; +end; + +destructor TCompilerConfiguration.destroy; +begin + fDocOpts.free; + fDebugOpts.free; + fMsgOpts.free; + fOutputOpts.free; + fPathsOpts.free; + fOthers.free; + inherited; +end; + +function TCompilerConfiguration.nameFromID: string; +begin + result := format('<configuration %d>',[ID]); +end; + +function TCompilerConfiguration.getCmdLine: string; +begin + result := + fDocOpts.getOpts + (*fDebugOpts.getOpts +*) fMsgOpts.getOpts + + fOutputOpts.getOpts + fPathsOpts.getOpts + fOthers.getOpts; + if result[length(result)] = ' ' then + setlength(result, length(result)-1); +end; + +procedure TCompilerConfiguration.setName(const aValue: string); +begin + if fName = aValue then exit; + fName := aValue; + if fName = '' then fName := nameFromID; + Changed(true); +end; + +procedure TCompilerConfiguration.subOptsChanged(sender: TObject); +begin + Changed(true); + doChanged; + {$IFDEF DEBUG} + writeln( #13#10 + getCmdLine); + {$ENDIF} +end; + +procedure TCompilerConfiguration.doChanged; +begin + if assigned(fOnChanged) then fOnChanged(self); +end; + +procedure TCompilerConfiguration.setDocOpts(const aValue: TDocOpts); +begin + fDocOpts.assign(aValue); +end; + +procedure TCompilerConfiguration.setDebugOpts(const aValue: TDebugOpts); +begin + fDebugOpts.assign(aValue); +end; + +procedure TCompilerConfiguration.setMsgOpts(const aValue: TMsgOpts); +begin + fMsgOpts.assign(aValue); +end; + +procedure TCompilerConfiguration.setOutputOpts(const aValue: TOutputOpts); +begin + fOutputOpts.assign(aValue); +end; + +procedure TCompilerConfiguration.setPathsOpts(const aValue: TPathsOpts); +begin + fPathsOpts.assign(aValue); +end; + +procedure TCompilerConfiguration.setOthers(const aValue: TOtherOpts); +begin + fOthers.Assign(aValue); +end; + +end. diff --git a/src/ce_editor.lfm b/src/ce_editor.lfm new file mode 100644 index 00000000..55ba5009 --- /dev/null +++ b/src/ce_editor.lfm @@ -0,0 +1,42 @@ +inherited CEEditorWidget: TCEEditorWidget + Left = 1248 + Height = 514 + Top = 89 + Width = 457 + Caption = 'EditorWidget' + ClientHeight = 514 + ClientWidth = 457 + inherited Back: TPanel + Height = 514 + Width = 457 + ClientHeight = 514 + ClientWidth = 457 + inherited Content: TScrollBox + Height = 488 + Width = 457 + HorzScrollBar.Page = 453 + VertScrollBar.Page = 484 + ClientHeight = 484 + ClientWidth = 453 + object PageControl: TExtendedNotebook[0] + Left = 2 + Height = 480 + Top = 2 + Width = 449 + Align = alClient + BorderSpacing.Around = 2 + TabOrder = 0 + OnChange = PageControlChange + end + end + inherited Header: TPanel + Width = 457 + end + end + object macRecorder: TSynMacroRecorder[1] + RecordShortCut = 24658 + PlaybackShortCut = 24656 + left = 8 + top = 8 + end +end diff --git a/src/ce_editor.pas b/src/ce_editor.pas new file mode 100644 index 00000000..135c8a3c --- /dev/null +++ b/src/ce_editor.pas @@ -0,0 +1,119 @@ +unit ce_editor; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, ExtendedNotebook, Forms, Controls, Graphics, + SynEditKeyCmds, ComCtrls, SynEditHighlighter, SynEditHighlighterFoldBase, SynMacroRecorder, + SynPluginSyncroEdit, SynEdit, Dialogs, ExtCtrls, ce_frame, ce_d2syn, ce_synmemo; + +type + { TCEWidgetEditor } + + { TCEEditorWidget } + + TCEEditorWidget = class(TCEWidget) + PageControl: TExtendedNotebook; + macRecorder: TSynMacroRecorder; + procedure PageControlChange(Sender: TObject); + private + function getCurrentEditor: TCESynMemo; + function getEditor(index: NativeInt): TCESynMemo; + function getEditorCount: NativeInt; + function getEditorIndex: NativeInt; + procedure identifierToD2Syn(const aMemo: TCESynMemo); + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + procedure addEditor; + // + procedure memoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure memoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + // + property currentEditor: TCESynMemo read getCurrentEditor; + property editor[index: NativeInt]: TCESynMemo read getEditor; + property editorCount: NativeInt read getEditorCount; + property editorIndex: NativeInt read getEditorIndex; + end; + +implementation +{$R *.lfm} + +constructor TCEEditorWidget.create(aOwner: TComponent); +begin + inherited; + fID := 'ID_EDIT'; +end; + +destructor TCEEditorWidget.destroy; +begin + inherited; +end; + +function TCEEditorWidget.getEditorCount: NativeInt; +begin + result := pageControl.PageCount; +end; + +function TCEEditorWidget.getEditorIndex: NativeInt; +begin + result := pageControl.PageIndex; +end; + +function TCEEditorWidget.getCurrentEditor: TCESynMemo; +begin + if pageControl.PageCount = 0 then result := nil + else result := TCESynMemo(pageControl.ActivePage.Controls[0]); +end; + +function TCEEditorWidget.getEditor(index: NativeInt): TCESynMemo; +begin + result := TCESynMemo(pageControl.Pages[index].Controls[0]); +end; + +procedure TCEEditorWidget.PageControlChange(Sender: TObject); +begin + //http://bugs.freepascal.org/view.php?id=26320 + macRecorder.Editor := getCurrentEditor; +end; + +procedure TCEEditorWidget.addEditor; +var + sheet: TTabSheet; + memo: TCESynMemo; +begin + sheet := pageControl.AddTabSheet; + memo := TCESynMemo.Create(sheet); + // + memo.Align:=alClient; + memo.Parent := sheet; + // + memo.OnKeyDown := @memoKeyDown; + memo.OnKeyUp := @memoKeyDown; + memo.OnMouseDown := @memoMouseDown; + // + macRecorder.Editor := memo; //http://bugs.freepascal.org/view.php?id=26320 +end; + +procedure TCEEditorWidget.identifierToD2Syn(const aMemo: TCESynMemo); +begin + D2Syn.CurrentIdentifier := aMemo.GetWordAtRowCol(aMemo.LogicalCaretXY); +end; + +procedure TCEEditorWidget.memoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (sender is TCESynMemo) then + identifierToD2Syn(TCESynMemo(Sender)); +end; + +procedure TCEEditorWidget.memoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + if (sender is TCESynMemo) then + identifierToD2Syn(TCESynMemo(Sender)); +end; + + +end. + diff --git a/src/ce_frame.lfm b/src/ce_frame.lfm new file mode 100644 index 00000000..63ade14d --- /dev/null +++ b/src/ce_frame.lfm @@ -0,0 +1,40 @@ +object CEWidget: TCEWidget + Left = 1180 + Height = 327 + Top = 523 + Width = 320 + Caption = 'CEWidget' + ClientHeight = 327 + ClientWidth = 320 + LCLVersion = '1.2.2.0' + object Back: TPanel + Left = 0 + Height = 327 + Top = 0 + Width = 320 + Align = alClient + BevelOuter = bvNone + ClientHeight = 327 + ClientWidth = 320 + TabOrder = 0 + object Content: TScrollBox + Left = 0 + Height = 301 + Top = 26 + Width = 320 + HorzScrollBar.Page = 316 + VertScrollBar.Page = 297 + Align = alClient + TabOrder = 0 + end + object Header: TPanel + Left = 0 + Height = 26 + Top = 0 + Width = 320 + Align = alTop + BevelOuter = bvNone + TabOrder = 1 + end + end +end diff --git a/src/ce_frame.pas b/src/ce_frame.pas new file mode 100644 index 00000000..18f0e698 --- /dev/null +++ b/src/ce_frame.pas @@ -0,0 +1,71 @@ +unit ce_frame; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, ExtCtrls, ce_common; + +type + + (** + * Base type for an UI module. + *) + PTCEWidget = ^TCEWidget; + + { TCEWidget } + TCEWidget = class(TForm) + Content: TScrollBox; + Back: TPanel; + Header: TPanel; + protected + fID: string; + published + property ID: string read fID write fID; + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + end; + + (** + * Holds a list of TCEWidget. + *) + TCEWidgetList = class(TList) + private + function getWidget(index: integer): TCEWidget; + public + procedure addWidget(aValue: PTCEWidget); + property frame[index: integer]: TCEWidget read getWidget; + end; + +implementation +{$R *.lfm} + + +constructor TCEWidget.create(aOwner: TComponent); +begin + inherited; + fID := 'ID_XXXX'; +end; + +destructor TCEWidget.destroy; +begin + inherited; +end; + +(******************************************************************************* + * TFrameList + *) +function TCEWidgetList.getWidget(index: integer): TCEWidget; +begin + result := PTCEWidget(Items[index])^; +end; + +procedure TCEWidgetList.addWidget(aValue: PTCEWidget); +begin + add(Pointer(aValue)); +end; + +end. + diff --git a/src/ce_main.lfm b/src/ce_main.lfm new file mode 100644 index 00000000..9d07d86a --- /dev/null +++ b/src/ce_main.lfm @@ -0,0 +1,176 @@ +object CEMainForm: TCEMainForm + Left = 1248 + Height = 52 + Top = 0 + Width = 655 + Caption = 'Coedit' + Menu = mainMenu + LCLVersion = '1.2.2.0' + object mainMenu: TMainMenu + object MenuItem1: TMenuItem + Caption = 'File' + object MenuItem5: TMenuItem + Action = actNewFile + end + object MenuItem2: TMenuItem + Action = actOpenFile + end + object MenuItem6: TMenuItem + Caption = '-' + end + object MenuItem3: TMenuItem + Action = actSaveFileAs + end + object MenuItem4: TMenuItem + Action = actSaveFile + end + end + object MenuItem7: TMenuItem + Caption = 'Edit' + object MenuItem15: TMenuItem + Action = actCopy + end + object MenuItem16: TMenuItem + Action = actCut + end + object MenuItem17: TMenuItem + Action = actPaste + end + object MenuItem18: TMenuItem + Caption = '-' + end + object MenuItem19: TMenuItem + Action = actUndo + end + object MenuItem20: TMenuItem + Action = actRedo + end + object MenuItem21: TMenuItem + Caption = '-' + end + object MenuItem22: TMenuItem + Action = actMacStartStop + end + object MenuItem23: TMenuItem + Action = actMacPlay + end + end + object MenuItem14: TMenuItem + Caption = 'Project' + end + object MenuItem8: TMenuItem + Caption = 'Run' + object MenuItem9: TMenuItem + Action = actCompAndRunFile + end + object MenuItem13: TMenuItem + Action = ActCompAndRunFileWithArgs + end + object MenuItem10: TMenuItem + Caption = '-' + end + object MenuItem11: TMenuItem + Action = actCompileProj + end + object MenuItem12: TMenuItem + Action = ActCompileAndRunProj + end + end + end + object Actions: TActionList + OnUpdate = ActionsUpdate + left = 32 + object actSaveFile: TAction + Category = 'File' + Caption = 'Save file' + OnExecute = actSaveFileExecute + end + object actCopy: TAction + Category = 'Edit' + Caption = 'Copy' + OnExecute = actCopyExecute + ShortCut = 16451 + end + object Action3: TAction + Category = 'Project' + Caption = 'Action3' + end + object Action4: TAction + Category = 'Windows' + Caption = 'Action4' + end + object actSaveFileAs: TAction + Category = 'File' + Caption = 'Save file as...' + OnExecute = actSaveFileAsExecute + end + object actOpenFile: TAction + Category = 'File' + Caption = 'Open file...' + OnExecute = actOpenFileExecute + end + object actNewFile: TAction + Category = 'File' + Caption = 'new empty file' + OnExecute = actNewFileExecute + end + object actCompAndRunFile: TAction + Category = 'Run' + Caption = 'Compile and run file' + OnExecute = actCompAndRunFileExecute + end + object ActCompAndRunFileWithArgs: TAction + Category = 'Run' + Caption = 'Compile and run file...' + OnExecute = ActCompAndRunFileWithArgsExecute + end + object actCompileProj: TAction + Category = 'Run' + Caption = 'Compile project' + end + object ActCompileAndRunProj: TAction + Category = 'Run' + Caption = 'Compile and run project' + end + object Action1: TAction + Category = 'Project' + Caption = 'Action1' + end + object actPaste: TAction + Category = 'Edit' + Caption = 'Paste' + OnExecute = actPasteExecute + ShortCut = 16470 + end + object actCut: TAction + Category = 'Edit' + Caption = 'Cut' + OnExecute = actCutExecute + ShortCut = 16472 + end + object actUndo: TAction + Category = 'Edit' + Caption = 'Undo' + OnExecute = actUndoExecute + ShortCut = 16474 + end + object actRedo: TAction + Category = 'Edit' + Caption = 'Redo' + OnExecute = actRedoExecute + ShortCut = 24666 + end + object actMacStartStop: TAction + Category = 'Edit' + Caption = 'Start/stop macro recording' + OnExecute = actMacStartStopExecute + ShortCut = 24658 + end + object actMacPlay: TAction + Category = 'Edit' + Caption = 'Play macro' + OnExecute = actMacPlayExecute + ShortCut = 24656 + end + end +end diff --git a/src/ce_main.pas b/src/ce_main.pas new file mode 100644 index 00000000..ebc5b27c --- /dev/null +++ b/src/ce_main.pas @@ -0,0 +1,453 @@ +unit ce_main; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, + ActnList, ce_common, ce_frame, ce_messages, ce_editor, ce_project, + ce_synmemo; + +type + + { TCEMainForm } + TCEMainForm = class(TForm) + actCompAndRunFile: TAction; + actCompileProj: TAction; + ActCompileAndRunProj: TAction; + ActCompAndRunFileWithArgs: TAction; + Action1: TAction; + actCut: TAction; + actMacPlay: TAction; + actMacStartStop: TAction; + actRedo: TAction; + actUndo: TAction; + actPaste: TAction; + actNewFile: TAction; + actOpenFile: TAction; + actSaveFileAs: TAction; + actSaveFile: TAction; + actCopy: TAction; + Action3: TAction; + Action4: TAction; + Actions: TActionList; + mainMenu: TMainMenu; + MenuItem1: TMenuItem; + MenuItem10: TMenuItem; + MenuItem11: TMenuItem; + MenuItem12: TMenuItem; + MenuItem13: TMenuItem; + MenuItem14: TMenuItem; + MenuItem15: TMenuItem; + MenuItem16: TMenuItem; + MenuItem17: TMenuItem; + MenuItem18: TMenuItem; + MenuItem19: TMenuItem; + MenuItem2: TMenuItem; + MenuItem20: TMenuItem; + MenuItem21: TMenuItem; + MenuItem22: TMenuItem; + MenuItem23: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MenuItem8: TMenuItem; + MenuItem9: TMenuItem; + procedure actCompAndRunFileExecute(Sender: TObject); + procedure ActCompAndRunFileWithArgsExecute(Sender: TObject); + procedure actCopyExecute(Sender: TObject); + procedure actCutExecute(Sender: TObject); + procedure ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); + procedure actMacPlayExecute(Sender: TObject); + procedure actMacStartStopExecute(Sender: TObject); + procedure actNewFileExecute(Sender: TObject); + procedure actOpenFileExecute(Sender: TObject); + procedure actPasteExecute(Sender: TObject); + procedure actRedoExecute(Sender: TObject); + procedure actSaveFileAsExecute(Sender: TObject); + procedure actSaveFileExecute(Sender: TObject); + procedure actUndoExecute(Sender: TObject); + private + fProject: TCEProject; + fWidgList: TCEWidgetList; + fMesgWidg: TCEMessagesWidget; + fEditWidg: TCEEditorWidget; + fProjWidg: TCEProjectWidget; + // + procedure newFile; + function findFile(const aFilename: string): NativeInt; + procedure openFile(const aFilename: string); + procedure saveFile(const edIndex: NativeInt); + procedure saveFileAs(const edIndex: NativeInt; const aFilename: string); + // + procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + end; + +var + mainForm: TCEMainForm; + +implementation +{$R *.lfm} + +uses + process, SynMacroRecorder; + +{$REGION std comp methods ******************************************************} +constructor TCEMainForm.create(aOwner: TComponent); +begin + inherited create(aOwner); + // + fWidgList := TCEWidgetList.Create; + fMesgWidg := TCEMessagesWidget.create(nil); + fEditWidg := TCEEditorWidget.create(nil); + fProjWidg := TCEProjectWidget.create(nil); + + fWidgList.addWidget(@fMesgWidg); + fWidgList.addWidget(@fEditWidg); + fWidgList.addWidget(@fProjWidg); + + fMesgWidg.Show; + fEditWidg.Show; + fProjWidg.Show; + + fProject := TCEProject.Create(self); + fProjWidg.project := fProject; +end; + +destructor TCEMainForm.destroy; +begin + fWidgList.Free; + fMesgWidg.Free; + fEditWidg.Free; + fProjWidg.Free; + // + inherited; +end; + +procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean); +var + curr: TCESynMemo; + hasEd: boolean; +begin + if fEditWidg = nil then exit; + // + curr := fEditWidg.currentEditor; + hasEd := curr <> nil; + if hasEd then + begin + actCopy.Enabled := curr.SelAvail; + actCut.Enabled := curr.SelAvail; + actPaste.Enabled := curr.CanPaste; + actUndo.Enabled := curr.CanUndo; + actRedo.Enabled := curr.CanRedo; + actMacPlay.Enabled := true; + actMacStartStop.Enabled := true; + // + actCompAndRunFile.Enabled := true; + actCompAndRunFileWithArgs.Enabled := true; + // + actSaveFile.Enabled := true; + actSaveFileAs.Enabled := true; + end + else begin + actCopy.Enabled := false; + actCut.Enabled := false ; + actPaste.Enabled := false ; + actUndo.Enabled := false ; + actRedo.Enabled := false ; + actMacPlay.Enabled := false; + actMacStartStop.Enabled := false; + // + actCompAndRunFile.Enabled := false; + actCompAndRunFileWithArgs.Enabled := false; + // + actSaveFile.Enabled := false; + actSaveFileAs.Enabled := false; + end; + +end; +{$ENDREGION} + +{$REGION file ******************************************************************} +procedure TCEMainForm.newFile; +var + i: NativeInt; + str: string; +begin + if fEditWidg = nil then exit; + // + i := fEditWidg.editorCount; + fEditWidg.addEditor; + i := 0; + while(true) do + begin + str := format('<new %d>',[i]); + if findFile(str) = -1 then break; + if i >= high(NativeInt) then break; + i += 1; + end; + fEditWidg.editor[i].fileName := str; + fEditWidg.editor[i].modified := true; + fEditWidg.PageControl.PageIndex := i; +end; + +function TCEMainForm.findFile(const aFilename: string): NativeInt; +var + i: NativeInt; +begin + result := -1; + if fEditWidg = nil then exit; + for i := 0 to fEditWidg.editorCount-1 do + if fEditWidg.editor[i].fileName = aFilename then + begin + result := i; + exit; + end; +end; + +procedure TCEMainForm.openFile(const aFilename: string); +var + i: NativeInt; +begin + if fEditWidg = nil then exit; + // + i := findFile(aFilename); + if i > -1 then + begin + fEditWidg.PageControl.PageIndex := i; + exit; + end; + i := fEditWidg.editorCount; + fEditWidg.addEditor; + fEditWidg.editor[i].Lines.LoadFromFile(aFilename); + fEditWidg.PageControl.PageIndex := i; +end; + +procedure TCEMainForm.saveFile(const edIndex: NativeInt); +var + str: string; +begin + if fEditWidg = nil then exit; + if edIndex >= fEditWidg.editorCount then exit; + // + str := fEditWidg.editor[edIndex].fileName; + if str = '' then exit; + try + fEditWidg.editor[edIndex].Lines.SaveToFile(str); + finally + fEditWidg.editor[edIndex].modified := false; + end; +end; + +procedure TCEMainForm.saveFileAs(const edIndex: NativeInt; const aFilename: string); +begin + if fEditWidg = nil then exit; + if edIndex < 0 then exit; + if edIndex >= fEditWidg.editorCount then exit; + // + try + fEditWidg.editor[edIndex].Lines.SaveToFile(aFilename); + finally + fEditWidg.editor[edIndex].fileName := aFilename; + fEditWidg.editor[edIndex].modified := false; + end; +end; + +procedure TCEMainForm.actOpenFileExecute(Sender: TObject); +begin + if fEditWidg = nil then exit; + // + with TOpenDialog.Create(nil) do + try + if execute then + begin + openFile(filename); + end; + finally + free; + end; +end; + +procedure TCEMainForm.actNewFileExecute(Sender: TObject); +begin + newFile; +end; + +procedure TCEMainForm.actSaveFileAsExecute(Sender: TObject); +begin + if fEditWidg = nil then exit; + if fEditWidg.editorIndex < 0 then exit; + // + with TSaveDialog.Create(nil) do + try + if execute then + begin + saveFileAs(fEditWidg.editorIndex, filename); + end; + finally + free; + end; +end; + +procedure TCEMainForm.actSaveFileExecute(Sender: TObject); +var + str: string; +begin + if fEditWidg = nil then exit; + if fEditWidg.editorIndex < 0 then exit; + // + str := fEditWidg.editor[fEditWidg.editorIndex].fileName; + if fileExists(str) then saveFile(fEditWidg.editorIndex) + else actSaveFileAs.Execute; +end; +{$ENDREGION} + +{$REGION edit ******************************************************************} +procedure TCEMainForm.actCopyExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then curr.CopyToClipboard; +end; + +procedure TCEMainForm.actCutExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then curr.CutToClipboard; +end; + +procedure TCEMainForm.actPasteExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then curr.PasteFromClipboard; +end; + +procedure TCEMainForm.actUndoExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then curr.Undo; +end; + +procedure TCEMainForm.actRedoExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then curr.Redo; +end; + +procedure TCEMainForm.actMacPlayExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then fEditWidg.macRecorder.PlaybackMacro(curr); +end; + +procedure TCEMainForm.actMacStartStopExecute(Sender: TObject); +var + curr: TCESynMemo; +begin + curr := fEditWidg.currentEditor; + if assigned(curr) then + begin + if fEditWidg.macRecorder.State = msRecording then + fEditWidg.macRecorder.Stop + else fEditWidg.macRecorder.RecordMacro(curr); + end; +end; + + +{$ENDREGION} + +{$REGION run ******************************************************************} +procedure TCEMainForm.compileAndRunFile(const edIndex: NativeInt; const runArgs: string = ''); +var + dmdproc: TProcess; + runproc: TProcess; + fname, temppath: string; +begin + dmdproc := TProcess.Create(nil); + runproc := TProcess.Create(nil); + try + temppath := ''; + {$IFDEF DEBUG}{$WARNINGS OFF}{$HINTS OFF}{$ENDIF} + fname := temppath + format('temp_%.8x',[NativeInt(@dmdproc)]); + {$IFDEF DEBUG}{$WARNINGS ON}{$HINTS ON}{$ENDIF} + fEditWidg.editor[edIndex].Lines.SaveToFile(fname + '.d'); + + dmdproc.Options:= [poWaitOnExit]; + dmdproc.Executable:= 'dmd'; + dmdproc.Parameters.Text := '"'+ fname +'.d"'; + try + dmdproc.Execute; + finally + DeleteFile(fname + '.d'); + end; + // + output to msgs widget + + if dmdProc.ExitStatus = 0 then + begin + runproc.Options:= [poWaitOnExit,poStderrToOutPut]; + {$IFDEF MSWINDOWS} + runproc.Executable := fname + '.exe'; + runproc.Parameters.Text := runArgs; + {$ELSE} + runproc.Executable := fname; + {$ENDIF} + runproc.Execute; + // + output to msgs widget + + {$IFDEF MSWINDOWS} + DeleteFile(fname + '.exe'); + DeleteFile(fname + '.obj'); + {$ELSE} + DeleteFile(fname); + DeleteFile(fname + '.o'); + {$ENDIF} + end; + + finally + dmdproc.Free; + runproc.Free; + end; +end; + +procedure TCEMainForm.actCompAndRunFileExecute(Sender: TObject); +begin + if fEditWidg = nil then exit; + if fEditWidg.editorIndex < 0 then exit; + // + compileAndRunFile(fEditWidg.editorIndex); +end; + +procedure TCEMainForm.ActCompAndRunFileWithArgsExecute(Sender: TObject); +var + runargs: string; +begin + if fEditWidg = nil then exit; + if fEditWidg.editorIndex < 0 then exit; + // + runargs := ''; + if InputQuery('Execution arguments', 'enter switches and arguments', + runargs) then compileAndRunFile(fEditWidg.editorIndex, runargs); +end; +{$ENDREGION} + +{$REGION view ******************************************************************} +{$ENDREGION} + +end. diff --git a/src/ce_messages.lfm b/src/ce_messages.lfm new file mode 100644 index 00000000..390e9d9e --- /dev/null +++ b/src/ce_messages.lfm @@ -0,0 +1,36 @@ +inherited CEMessagesWidget: TCEMessagesWidget + Left = 1248 + Height = 139 + Top = 640 + Width = 652 + Caption = 'MessagesWidget' + ClientHeight = 139 + ClientWidth = 652 + inherited Back: TPanel + Height = 139 + Width = 652 + ClientHeight = 139 + ClientWidth = 652 + inherited Content: TScrollBox + Height = 113 + Width = 652 + HorzScrollBar.Page = 631 + VertScrollBar.Page = 109 + ClientHeight = 109 + ClientWidth = 631 + object List: TListView[0] + Left = 2 + Height = 150 + Top = 2 + Width = 627 + Align = alClient + BorderSpacing.Around = 2 + Columns = <> + TabOrder = 0 + end + end + inherited Header: TPanel + Width = 652 + end + end +end diff --git a/src/ce_messages.pas b/src/ce_messages.pas new file mode 100644 index 00000000..af60f3a3 --- /dev/null +++ b/src/ce_messages.pas @@ -0,0 +1,52 @@ +unit ce_messages; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, ComCtrls, ce_frame, ce_common; + +type + + { TCEWidgetMessages } + + TCEMessagesWidget = class(TCEWidget,ICEMultiDocMonitor) + List: TListView; + private + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + // + procedure docChange(const aNewIndex: integer); + procedure docClose(const aNewIndex: integer); + end; + +implementation +{$R *.lfm} + +constructor TCEMessagesWidget.create(aOwner: TComponent); +begin + inherited; + fID := 'ID_MSGS'; +end; + +destructor TCEMessagesWidget.destroy; +begin + inherited; +end; + +procedure TCEMessagesWidget.docChange(const aNewIndex: integer); +begin + // can grow the list... + // can display matching msgs from a list... +end; + +procedure TCEMessagesWidget.docClose(const aNewIndex: integer); +begin + // can shrink the list... +end; + +end. + diff --git a/src/ce_project.lfm b/src/ce_project.lfm new file mode 100644 index 00000000..a268cb37 --- /dev/null +++ b/src/ce_project.lfm @@ -0,0 +1,37 @@ +inherited CEProjectWidget: TCEProjectWidget + Left = 1721 + Height = 514 + Top = 89 + Width = 180 + Caption = 'ProjectWidget' + ClientHeight = 514 + ClientWidth = 180 + inherited Back: TPanel + Height = 514 + Width = 180 + ClientHeight = 514 + ClientWidth = 180 + inherited Content: TScrollBox + Height = 488 + Width = 180 + HorzScrollBar.Page = 176 + VertScrollBar.Page = 484 + ClientHeight = 484 + ClientWidth = 176 + object Tree: TTreeView[0] + Left = 2 + Height = 206 + Top = 2 + Width = 172 + Align = alTop + BorderSpacing.Around = 2 + DefaultItemHeight = 18 + ScrollBars = ssAutoBoth + TabOrder = 0 + end + end + inherited Header: TPanel + Width = 180 + end + end +end diff --git a/src/ce_project.pas b/src/ce_project.pas new file mode 100644 index 00000000..86ce0bab --- /dev/null +++ b/src/ce_project.pas @@ -0,0 +1,56 @@ +unit ce_project; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + ComCtrls, ce_common, ce_frame; + +type + + { TCEWidgetProject } + + TCEProjectWidget = class(TCEWidget) + Tree: TTreeView; + private + fProject: TCEProject; + procedure updateView; + procedure setProject(aValue: TCEProject); + public + constructor create(aOwner: TComponent); override; + destructor destroy; override; + // + property project: TCEProject read fProject write setProject; + end; + +implementation +{$R *.lfm} + +constructor TCEProjectWidget.create(aOwner: TComponent); +begin + inherited; + fID := 'ID_PROJ'; +end; + +destructor TCEProjectWidget.destroy; +begin + inherited; +end; + +procedure TCEProjectWidget.setProject(aValue: TCEProject); +begin + if fProject = aValue then exit; + fProject := aValue; + if aValue = nil then exit; + updateView; +end; + +procedure TCEProjectWidget.updateView; +begin + +end; + +end. + diff --git a/src/ce_synmemo.pas b/src/ce_synmemo.pas new file mode 100644 index 00000000..868c17c2 --- /dev/null +++ b/src/ce_synmemo.pas @@ -0,0 +1,58 @@ +unit ce_synmemo; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, SynEdit, SynMemo, ce_common, ce_d2syn, + SynPluginSyncroEdit, SynEditKeyCmds; + +type + + TCESynMemo = class(TSynMemo) + private + fFilename: string; + fModified: boolean; + fAssocProject: TCEProject; + public + constructor Create(aOwner: TComponent); override; + // + property fileName: string read fFilename write fFilename; + property modified: boolean read fModified write fModified; + property project: TCEProject read fAssocProject write fAssocProject; + end; + +var + D2Syn: TSynD2Syn; + +implementation + +uses + graphics; + +constructor TCESynMemo.Create(aOwner: TComponent); +begin + inherited; + Font.Quality := fqProof; + TabWidth := 4; + Options := + [ eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoTabsToSpaces, + eoTrimTrailingSpaces, eoDragDropEditing, eoShowCtrlMouseLinks]; + Options2 := [eoEnhanceEndKey, eoFoldedCopyPaste, eoOverwriteBlock]; + // + Gutter.LineNumberPart.ShowOnlyLineNumbersMultiplesOf := 5; + Gutter.LineNumberPart.MarkupInfo.Foreground := clSilver; + Gutter.SeparatorPart.LineOffset:=1; + Gutter.SeparatorPart.LineWidth:=1; + Gutter.SeparatorPart.MarkupInfo.Foreground := clSilver; + Gutter.CodeFoldPart.MarkupInfo.Foreground := clSilver; + // + Highlighter := D2Syn; +end; + +initialization + D2Syn := TSynD2Syn.create(nil); +finalization + D2Syn.free; +end.