forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

r20

This commit is contained in:
Basile Burg 2014-07-15 06:55:07 +02:00
parent cf7d601ef9
commit fe9fecde64
12 changed files with 123 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/ce_common.pas
View File

@ -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}

1
src/ce_d2syn.pas
View File

@ -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;

27
src/ce_dlang.pas
View File

@ -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;

15
src/ce_dmdwrap.pas
View File

@ -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;

1
src/ce_main.lfm
View File

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

35
src/ce_main.pas
View File

@ -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;

1
src/ce_messages.lfm
View File

@ -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

34
src/ce_messages.pas
View File

@ -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);

2
src/ce_project.pas
View File

@ -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;

1
src/ce_staticexplorer.lfm
View File

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

33
src/ce_staticexplorer.pas
View File

@ -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;

4
src/ce_widgettypes.pas
View File

@ -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