r20

src/ce_common.pas

@@ -80,10 +80,15 @@ type
   function dlgOkCancel(const aMsg: string): TModalResult;
 
   (**
-   * Info dialog
+   * Info message
    *)
   function dlgOkInfo(const aMsg: string): TModalResult;
 
+  (**
+   * Error message
+   *)
+  function dlgOkError(const aMsg: string): TModalResult;
+
   (**
    * Returns an unique object identifier, based on its heap address.
    *)
@@ -302,6 +307,13 @@ begin
   exit( MessageDlg('Coedit', aMsg, mtInformation, Btns, ''));
 end;
 
+function dlgOkError(const aMsg: string): TModalResult;
+const
+  Btns = [mbOK];
+begin
+  exit( MessageDlg('Coedit', aMsg, mtError, Btns, ''));
+end;
+
 function uniqueObjStr(const aObject: Tobject): string;
 begin
   {$HINTS OFF}{$WARNINGS OFF}

src/ce_d2syn.pas

@@ -448,6 +448,7 @@ end;
 //TODO-cstring literals: token strings.
 //TODO-cstring literals: escape bug: std.path/std.regex: "\\"
 //TODO-ccomments: correct nested comments handling.
+//TODO-cidea: something like pascal {$region} : /*folder blabla*/  /*endfolder*/
 
 {$BOOLEVAL ON}
 procedure TSynD2Syn.next;

src/ce_dlang.pas

@@ -723,7 +723,7 @@ procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorLis
 const
   errPrefix = 'syntactic error: ';
 var
-  tk, old1, old2: TLexToken;
+  tk, old1, old2, lastSig: TLexToken;
   err: PLexError;
   tkIndex: NativeInt;
   pareCnt, curlCnt, squaCnt: NativeInt;
@@ -746,6 +746,9 @@ begin
   pareLeft:= False;
   curlLeft:= False;
   squaLeft:= False;
+  FillByte( old1, sizeOf(TLexToken), 0);
+  FillByte( old2, sizeOf(TLexToken), 0);
+  FillByte( lastSig, sizeOf(TLexToken), 0);
 
   for tk in aTokenList do
   begin
@@ -802,29 +805,29 @@ begin
     end;
 
 _preSeq:
+
     // invalid sequences
-    if tkIndex > 0 then // can use old1
+    if tkIndex > 0 then
     begin
+      // empty statements:
+      if (tk.kind = ltkSymbol) and (tk.data = ';') then
+        if (lastSig.kind = ltkSymbol) and (lastSig.data = ';') then
+          addError('invalid syntax for empty statement');
+      if tk.kind <> ltkComment then lastSig := tk;
+
+      // suspicious double keywords
       if (old1.kind = ltkKeyword) and (tk.kind = ltkKeyword) then
         if old1.data = tk.data then
           addError('keyword is duplicated');
 
-(*
+      // suspicious double numbers
-      if (old1.kind = ltkOperator) and (tk.kind = ltkOperator) then
-        if not isPtrOperator(tk.data[1]) then // ident operator [&,*] ident
-          addError('operator rhs cannot be an operator');
-*)
-
       if (old1.kind = ltkNumber) and (tk.kind = ltkNumber) then
         addError('symbol or operator expected after number');
-
     end;
-    if tkIndex > 1 then // can use old2
+    if tkIndex > 1 then
     begin
-
     end;
 
-
     old1 := tk;
     old2 := old1;
   end;

src/ce_dmdwrap.pas

@@ -245,15 +245,18 @@ type
   TCustomProcOptions = class(TOptsGroup)
   private
     fExecutable: string;
+    fWorkDir: string;
     fOptions: TProcessOptions;
     fParameters: TStringList;
     fShowWin: TShowWindowOptions;
     procedure setExecutable(const aValue: string);
+    procedure setWorkDir(const aValue: string);
     procedure setOptions(const aValue: TProcessOptions);
     procedure setParameters(const aValue: TStringList);
     procedure setShowWin(const aValue: TShowWindowOptions);
   protected
     property executable: string read fExecutable write setExecutable;
+    property workingDirectory: string read fWorkDir write setWorkDir;
     property options: TProcessOptions read fOptions write setOptions;
     property parameters: TStringList read fParameters write setParameters;
     property showWindow: TShowWindowOptions read fShowWin write setShowWin;
@@ -271,6 +274,7 @@ type
   TCompileProcOptions = class(TCustomProcOptions)
   published
     property executable;
+    property workingDirectory;
     property options;
     property parameters;
     property showWindow;
@@ -282,6 +286,7 @@ type
    *)
   TProjectRunOptions = class(TCustomProcOptions)
   published
+    property workingDirectory;
     property options;
     property parameters;
     property showWindow;
@@ -523,7 +528,7 @@ var
 const
   trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
   binKindStr: array[TBinaryKind] of string = ('', '-lib', '-shared', '-c');
-  bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
+  //bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
 begin
   depPatch;
   //
@@ -946,6 +951,7 @@ begin
   aProcess.Executable := fExecutable;
   aProcess.ShowWindow := fShowWin;
   aProcess.Options    := fOptions;
+  aProcess.CurrentDirectory := fWorkDir;
   aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
 end;
 
@@ -956,6 +962,13 @@ begin
   doChanged;
 end;
 
+procedure TCustomProcOptions.setWorkDir(const aValue: string);
+begin
+  if fWorkDir = aValue then exit;
+  fWorkDir := aValue;
+  doChanged;
+end;
+
 procedure TCustomProcOptions.setOptions(const aValue: TProcessOptions);
 begin
   if fOptions = aValue then exit;

src/ce_main.lfm

@@ -2789,6 +2789,7 @@ object CEMainForm: TCEMainForm
     HintHidePause = 1000
     HintPause = 25
     HintShortPause = 8
+    OnException = ApplicationProperties1Exception
     left = 96
   end
   object LfmSyn: TSynLFMSyn

src/ce_main.pas

@@ -181,6 +181,7 @@ type
     procedure actEdUndoExecute(Sender: TObject);
     procedure actProjSourceExecute(Sender: TObject);
     procedure actEdUnIndentExecute(Sender: TObject);
+    procedure ApplicationProperties1Exception(Sender: TObject; E: Exception);
     procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
   private
     fUpdateCount: NativeInt;
@@ -200,7 +201,7 @@ type
     procedure widgetShowFromAction(sender: TObject);
 
     // run & exec sub routines
-    procedure ProcessOutputToMsg(const aProcess: TProcess);
+    procedure ProcessOutputToMsg(const aProcess: TProcess;aCtxt: TMessageContext = msUnknown);
     procedure compileAndRunFile(const edIndex: NativeInt; const runArgs: string = '');
     procedure compileProject(const aProject: TCEProject);
     procedure runProject(const aProject: TCEProject; const runArgs: string = '');
@@ -352,6 +353,13 @@ begin
   inherited;
 end;
 
+procedure TCEMainForm.ApplicationProperties1Exception(Sender: TObject;E: Exception);
+begin
+  if fMesgWidg = nil then
+    ce_common.dlgOkError(E.Message)
+  else fMesgWidg.addCeErr(E.Message);
+end;
+
 procedure TCEMainForm.ActionsUpdate(AAction: TBasicAction; var Handled: Boolean);
 var
   curr: TCESynMemo;
@@ -808,11 +816,10 @@ begin
   curr := fEditWidg.currentEditor;
   if assigned(curr) then curr.ExecuteCommand(ecBlockUnIndent, '', nil);
 end;
-
 {$ENDREGION}
 
 {$REGION run  ******************************************************************}
-procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess);
+procedure TCEMainForm.ProcessOutputToMsg(const aProcess: TProcess; aCtxt: TMessageContext = msUnknown);
 var
   str: TMemoryStream;
   lns: TStringList;
@@ -837,7 +844,7 @@ begin
     end;
     Str.SetSize(readSz);
     lns.LoadFromStream(Str);
-    for msg in lns do fMesgWidg.addMessage(msg); // proj/file ?
+    for msg in lns do fMesgWidg.addMessage(msg, aCtxt);
   finally
     str.Free;
     lns.Free;
@@ -878,7 +885,7 @@ begin
     try
       dmdproc.Execute;
       while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break;
-      ProcessOutputToMsg(dmdproc);
+      ProcessOutputToMsg(dmdproc, msEditor);
     finally
       DeleteFile(fname + '.d');
     end;
@@ -896,13 +903,14 @@ begin
       runproc.Options:= [poStderrToOutPut, poUsePipes];
       {$IFDEF MSWINDOWS}
       runproc.Executable := fname + '.exe';
+      runproc.CurrentDirectory := extractFilePath(runProc.Executable);
       runproc.Parameters.Text := runArgs;
       {$ELSE}
       runproc.Executable := fname;
       {$ENDIF}
       runproc.Execute;
       while runproc.Running do if runproc.ExitStatus <> 0 then break;
-      ProcessOutputToMsg(runproc);
+      ProcessOutputToMsg(runproc, msEditor);
       {$IFDEF MSWINDOWS}
       DeleteFile(fname + '.exe');
       DeleteFile(fname + '.obj');
@@ -949,6 +957,8 @@ begin
         ppproc := TProcess.Create(nil);
         try
           preBuildProcess.setProcess(ppproc);
+          if ppproc.CurrentDirectory = '' then
+            ppproc.CurrentDirectory := extractFilePath(ppproc.Executable);
           ppproc.Execute;
         finally
           ppproc.Free;
@@ -978,7 +988,7 @@ begin
     try
       dmdproc.Execute;
       while dmdproc.Running do if dmdproc.ExitStatus <> 0 then break;
-      ProcessOutputToMsg(dmdproc);
+      ProcessOutputToMsg(dmdproc, msProject);
     finally
       {$IFDEF MSWINDOWS} //  STILL_ACTIVE ambiguity
       if (dmdProc.ExitStatus = 0) or (dmdProc.ExitStatus = 259) then
@@ -1000,6 +1010,8 @@ begin
           ppproc := TProcess.Create(nil);
           try
             postBuildProcess.setProcess(ppproc);
+            if ppproc.CurrentDirectory = '' then
+              ppproc.CurrentDirectory := extractFilePath(ppproc.Executable);
             ppproc.Execute;
           finally
             ppproc.Free;
@@ -1028,11 +1040,8 @@ begin
 
   runproc := TProcess.Create(nil);
   try
-    runproc.Options := aProject.currentConfiguration.runOptions.options;
+    aProject.currentConfiguration.runOptions.setProcess(runProc);
-    runproc.Parameters := aProject.currentConfiguration.runOptions.parameters;
-    runproc.ShowWindow := aProject.currentConfiguration.runOptions.showWindow;
     runproc.Parameters.AddText(runArgs);
-
     procname := aProject.currentConfiguration.pathsOptions.outputFilename;
     if procname <> '' then procname := aProject.getAbsoluteFilename(procname)
     else if aProject.Sources.Count > 0 then
@@ -1053,9 +1062,11 @@ begin
     end;
 
     runproc.Executable := procname;
+    if runproc.CurrentDirectory = '' then
+      runproc.CurrentDirectory := extractFilePath(runproc.Executable);
     runproc.Execute;
     while runproc.Running do if runproc.ExitStatus <> 0 then break;
-    ProcessOutputToMsg(runproc);
+    ProcessOutputToMsg(runproc, msProject);
 
   finally
     runproc.Free;

src/ce_messages.lfm

@@ -38,6 +38,7 @@ inherited CEMessagesWidget: TCEMessagesWidget
         ShowLines = False
         ShowRoot = False
         TabOrder = 0
+        OnKeyDown = ListKeyDown
         Options = [tvoAllowMultiselect, tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoToolTips, tvoThemedDraw]
       end
     end

src/ce_messages.pas

@@ -6,7 +6,8 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
-  ce_widget, ActnList, Menus, clipbrd, AnchorDocking, ce_project, ce_synmemo;
+  lcltype, ce_widget, ActnList, Menus, clipbrd, AnchorDocking, ce_project,
+  ce_synmemo, LMessages;
 
 type
 
@@ -22,6 +23,7 @@ type
   TCEMessagesWidget = class(TCEWidget)
     imgList: TImageList;
     List: TTreeView;
+    procedure ListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
     fActClearAll: TAction;
     fActClearEdi: TAction;
@@ -42,7 +44,7 @@ type
     procedure listDeletion(Sender: TObject; Node: TTreeNode);
     function newMessageItemData(aCtxt: TMessageContext): PMessageItemData;
   published
-    property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount default 250;
+    property maxMessageCount: Integer read fMaxMessCnt write setMaxMessageCount default 125;
   public
     constructor create(aOwner: TComponent); override;
     //
@@ -82,7 +84,7 @@ uses
 
 constructor TCEMessagesWidget.create(aOwner: TComponent);
 begin
-  fMaxMessCnt := 250;
+  fMaxMessCnt := 125;
   //
   fActClearAll := TAction.Create(self);
   fActClearAll.OnExecute := @actClearAllExecute;
@@ -147,6 +149,23 @@ begin
     List.BottomItem.MakeVisible;
 end;
 
+procedure TCEMessagesWidget.ListKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+var
+  i: NativeInt;
+begin
+  if Key in [VK_BACK, VK_DELETE] then
+  begin
+    if List.SelectionCount > 0 then
+    begin
+    for i := List.Items.Count-1 downto 0 do
+      if List.Items[i].MultiSelected then
+        List.Items.Delete(List.Items[i]);
+    end
+    else ClearAllMessages;
+  end;
+end;
+
 procedure TCEMessagesWidget.filterMessages;
 var
   itm: TTreeNode;
@@ -327,6 +346,7 @@ begin
   end;
 end;
 
+// TODO: link to editor line when possible.
 function semanticMsgAna(const aMessg: string): TMessageKind;
 var
   pos: Nativeint;
@@ -335,11 +355,13 @@ function checkIdent: TMessageKind;
 begin
   case idt of
     'ERROR', 'error', 'Error', 'Invalid', 'invalid',
-    'illegal', 'Illegal', 'fatal', 'Fatal', 'Critical', 'critical':
+    'exception', 'Exception', 'illegal', 'Illegal',
+    'fatal', 'Fatal', 'Critical', 'critical':
       exit(msgkError);
-    'Warning', 'warning':
+    'Warning', 'warning', 'caution', 'Caution':
       exit(msgkWarn);
-    'Hint', 'hint', 'Tip', 'tip':
+    'Hint', 'hint', 'Tip', 'tip', 'advice', 'Advice',
+    'suggestion', 'Suggestion':
       exit(msgkHint);
     'Information', 'information':
       exit(msgkInfo);

src/ce_project.pas

@@ -275,7 +275,7 @@ end;
 procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent;
       var PropName: string; IsPath: boolean; var Handled, Skip: Boolean);
 begin
-  // continue loading: this method grants the project compat. in case of drastical changes.
+  // continue loading: this method grants the project compat. in case of drastic changes.
   Skip := true;
   Handled := true;
 end;

src/ce_staticexplorer.lfm

@@ -71,6 +71,7 @@ inherited CEStaticExplorerWidget: TCEStaticExplorerWidget
           Height = 23
           Top = 2
           Width = 226
+          OnAfterFilter = TreeFilterEdit1AfterFilter
           ButtonWidth = 23
           NumGlyphs = 1
           Align = alCustom

src/ce_staticexplorer.pas

@@ -18,6 +18,7 @@ type
     Tree: TTreeView;
     TreeFilterEdit1: TTreeFilterEdit;
     procedure TreeDeletion(Sender: TObject; Node: TTreeNode);
+    procedure TreeFilterEdit1AfterFilter(Sender: TObject);
     procedure TreeKeyPress(Sender: TObject; var Key: char);
   private
     fActRefresh: TAction;
@@ -32,6 +33,7 @@ type
     procedure TreeDblClick(Sender: TObject);
     procedure actRefreshExecute(Sender: TObject);
     procedure actAutoRefreshExecute(Sender: TObject);
+    procedure updateVisibleCat;
   protected
     procedure UpdateByDelay; override;
   published
@@ -178,6 +180,26 @@ begin
     Dispose(PInt64(node.Data));
 end;
 
+procedure TCEStaticExplorerWidget.updateVisibleCat;
+begin
+  ndAlias.Visible := ndAlias.Count > 0;
+  ndClass.Visible := ndClass.Count > 0;
+  ndEnum.Visible := ndEnum.Count > 0;
+  ndFunc.Visible := ndFunc.Count > 0;
+  ndImp.Visible := ndImp.Count > 0;
+  ndIntf.Visible := ndIntf.Count > 0;
+  ndMix.Visible := ndMix.Count > 0;
+  ndStruct.Visible := ndStruct.Count > 0;
+  ndTmp.Visible := ndTmp.Count > 0;
+  ndVar.Visible := ndVar.Count > 0;
+end;
+
+procedure TCEStaticExplorerWidget.TreeFilterEdit1AfterFilter(Sender: TObject);
+begin
+  if TreeFilterEdit1.Filter ='' then
+    updateVisibleCat;
+end;
+
 procedure TCEStaticExplorerWidget.TreeKeyPress(Sender: TObject; var Key: char);
 begin
   if Key = #13 then TreeDblClick(nil);
@@ -244,16 +266,7 @@ begin
   ndTmp.DeleteChildren;
   ndVar.DeleteChildren;
 
-  ndAlias.Visible := false;
+  updateVisibleCat;
-  ndClass.Visible := false;
-  ndEnum.Visible := false;
-  ndFunc.Visible := false;
-  ndImp.Visible := false;
-  ndIntf.Visible := false;
-  ndMix.Visible := false;
-  ndStruct.Visible := false;
-  ndTmp.Visible := false;
-  ndVar.Visible := false;
 
   if fDoc = nil then exit;
   if fDoc.Lines.Count = 0 then exit;

src/ce_widgettypes.pas

@@ -16,7 +16,7 @@ type
    *)
   ICEMultiDocMonitor = interface
     procedure docNew(const aDoc: TCESynMemo);
-    procedure docFocused(const aDoc: TCESynMemo);
+    procedure docFocused(const aDoc: TCESynMemo); // docSelected or docActivated
     procedure docChanged(const aDoc: TCESynMemo);
     procedure docClose(const aDoc: TCESynMemo);
   end;
@@ -41,7 +41,7 @@ type
     procedure projRun(const aProject: TCEProject);
 
     // not used yet: (project group)
-    procedure projFocused(const aProject: TCEProject);
+    procedure projFocused(const aProject: TCEProject); // projSelected or projActivated
   end;
 
 implementation