From fe9fecde649f3fb1f5c6e5a3762a03acfb75c67b Mon Sep 17 00:00:00 2001
From: Basile Burg <basile.burg@gmx.com>
Date: Tue, 15 Jul 2014 06:55:07 +0200
Subject: [PATCH] r20
---
src/ce_common.pas | 14 +++++++++++++-
src/ce_d2syn.pas | 1 +
src/ce_dlang.pas | 27 +++++++++++++++------------
src/ce_dmdwrap.pas | 15 ++++++++++++++-
src/ce_main.lfm | 1 +
src/ce_main.pas | 35 +++++++++++++++++++++++------------
src/ce_messages.lfm | 1 +
src/ce_messages.pas | 34 ++++++++++++++++++++++++++++------
src/ce_project.pas | 2 +-
src/ce_staticexplorer.lfm | 1 +
src/ce_staticexplorer.pas | 33 +++++++++++++++++++++++----------
src/ce_widgettypes.pas | 4 ++--
12 files changed, 123 insertions(+), 45 deletions(-)
diff --git a/src/ce_common.pas b/src/ce_common.pas
index a4125d39..f3fe4fd5 100644
--- a/src/ce_common.pas
+++ b/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}
diff --git a/src/ce_d2syn.pas b/src/ce_d2syn.pas
index 578888fb..90f791c4 100644
--- a/src/ce_d2syn.pas
+++ b/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;
diff --git a/src/ce_dlang.pas b/src/ce_dlang.pas
index d913cf2a..87c31003 100644
--- a/src/ce_dlang.pas
+++ b/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');
-(*
- 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');
-*)
-
+ // suspicious double numbers
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;
diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas
index 7aee7e97..cf2f973e 100644
--- a/src/ce_dmdwrap.pas
+++ b/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;
diff --git a/src/ce_main.lfm b/src/ce_main.lfm
index 86662859..9106667e 100644
--- a/src/ce_main.lfm
+++ b/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
diff --git a/src/ce_main.pas b/src/ce_main.pas
index eda3440e..5eff41df 100644
--- a/src/ce_main.pas
+++ b/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;
- runproc.Parameters := aProject.currentConfiguration.runOptions.parameters;
- runproc.ShowWindow := aProject.currentConfiguration.runOptions.showWindow;
+ aProject.currentConfiguration.runOptions.setProcess(runProc);
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;
diff --git a/src/ce_messages.lfm b/src/ce_messages.lfm
index 285e7b9a..17de1dac 100644
--- a/src/ce_messages.lfm
+++ b/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
diff --git a/src/ce_messages.pas b/src/ce_messages.pas
index aede1569..5cdb78c5 100644
--- a/src/ce_messages.pas
+++ b/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);
diff --git a/src/ce_project.pas b/src/ce_project.pas
index e4b42a29..9b7e9a12 100644
--- a/src/ce_project.pas
+++ b/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;
diff --git a/src/ce_staticexplorer.lfm b/src/ce_staticexplorer.lfm
index ec8a7809..e8e006c9 100644
--- a/src/ce_staticexplorer.lfm
+++ b/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
diff --git a/src/ce_staticexplorer.pas b/src/ce_staticexplorer.pas
index 5c582a0f..67b4141b 100644
--- a/src/ce_staticexplorer.pas
+++ b/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;
- 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;
+ updateVisibleCat;
if fDoc = nil then exit;
if fDoc.Lines.Count = 0 then exit;
diff --git a/src/ce_widgettypes.pas b/src/ce_widgettypes.pas
index aff46c29..60750f61 100644
--- a/src/ce_widgettypes.pas
+++ b/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