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

getModuleName uses TLexTokenList

This commit is contained in:
Basile Burg 2014-07-05 13:07:56 +02:00
parent f35d7500b6
commit a7780320a0
7 changed files with 99 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
src/ce_common.pas
View File

@ -21,6 +21,8 @@ type
fMaxCount: Integer;
fObj: TObject;
protected
fChecking: boolean;
procedure clearOutOfRange;
procedure setMaxCount(aValue: Integer);
function checkItem(const S: string): boolean; virtual;
procedure Put(Index: Integer; const S: string); override;
@ -55,11 +57,6 @@ type
*)
function expandFilenameEx(const aBasePath, aFilename: string): string;
(**
* Extracts the module name of a D source file.
*)
function getModuleName(const aSource: TStrings): string;
(**
* Patches the directory separators from a string.
* This is used to ensure that a project saved on a platform can be loaded
@ -96,30 +93,42 @@ begin
fMaxCount := 10;
end;
procedure TMRUList.clearOutOfRange;
begin
while Count > fMaxCount do delete(Count-1);
end;
procedure TMRUList.setMaxCount(aValue: Integer);
begin
if aValue < 0 then aValue := 0;
if fMaxCount = aValue then exit;
while Count > fMaxCount do delete(Count-1);
clearOutOfRange;
end;
function TMRUList.checkItem(const S: string): boolean;
var
i: NativeInt;
begin
exit( indexOf(S) = -1 );
i := indexOf(S);
if i = -1 then exit(true);
if i = 0 then exit(false);
if Count < 2 then exit(false);
exchange(i, i-1);
exit( false);
end;
procedure TMRUList.Put(Index: Integer; const S: string);
begin
if not (checkItem(S)) then exit;
inherited;
while Count > fMaxCount do delete(Count-1);
clearOutOfRange;
end;
procedure TMRUList.Insert(Index: Integer; const S: string);
begin
if not (checkItem(S)) then exit;
inherited;
while Count > fMaxCount do delete(Count-1);
clearOutOfRange;
end;
function TMRUFileList.checkItem(const S: string): boolean;
@ -127,7 +136,6 @@ begin
exit( inherited checkItem(S) and fileExists(S));
end;
procedure saveCompToTxtFile(const aComp: TComponent; const aFilename: string);
var
str1, str2: TMemoryStream;
@ -171,7 +179,7 @@ var
curr: string;
begin
curr := '';
getDir(0,curr);
getDir(0, curr);
try
if curr <> aBasePath then
chDir(aBasePath);
@ -200,16 +208,16 @@ end;
begin
result := aPath;
{$IFDEF MSWINDOWS}
result := patchProc(result,'/');
result := patchProc(result,':');
result := patchProc(result, '/');
result := patchProc(result, ':');
{$ENDIF}
{$IFDEF LINUX}
result := patchProc(result,'\');
result := patchProc(result,':');
result := patchProc(result, '\');
result := patchProc(result, ':');
{$ENDIF}
{$IFDEF MACOS}
result := patchProc(result,'\');
result := patchProc(result,'/');
result := patchProc(result, '\');
result := patchProc(result, '/');
{$ENDIF}
end;
@ -225,59 +233,6 @@ begin
end;
end;
// TODO: block comments handling
function getModuleName(const aSource: TStrings): string;
var
ln: string;
pos, lcnt: NativeInt;
id: string;
tok: boolean;
begin
result := '';
tok := false;
lcnt := -1;
for ln in aSource do
begin
pos := 1;
id := '';
lcnt += 1;
if lcnt > 100 then exit;
while(true) do
begin
if pos > length(ln) then
break;
if ln[pos] in [#0..#32] then
begin
Inc(pos);
id := '';
continue;
end;
if tok then if ln[pos] = ';' then
exit(id);
id += ln[pos];
Inc(pos);
if id = '//' then
begin
Inc(pos, length(ln));
break;
end;
if id = 'module' then
begin
tok := true;
id := '';
continue;
end;
end;
end;
end;
function dlgOkCancel(const aMsg: string): TModalResult;
const
Btns = [mbOK,mbCancel];

20
src/ce_d2syn.pas
View File

@ -696,15 +696,11 @@ begin
fTokKind := tkSymbl;
while isOperator1(readNext) do (*!*);
case fTokStop - fTokStart of
1:begin
if not isOperator1(readCurr) then exit
else Dec(fTokStop);
end;
2:begin
4:begin
if (not isOperator1(readCurr)) and
isOperator2(fLineBuf[fTokStart..fTokStop-1])
isOperator4(fLineBuf[fTokStart..fTokStop-1])
then exit
else Dec(fTokStop, 2);
else Dec(fTokStop, 4);
end;
3:begin
if (not isOperator1(readCurr)) and
@ -712,11 +708,15 @@ begin
then exit
else Dec(fTokStop, 3);
end;
4:begin
2:begin
if (not isOperator1(readCurr)) and
isOperator4(fLineBuf[fTokStart..fTokStop-1])
isOperator2(fLineBuf[fTokStart..fTokStop-1])
then exit
else Dec(fTokStop, 4);
else Dec(fTokStop, 2);
end;
1:begin
if not isOperator1(readCurr) then exit
else Dec(fTokStop);
end;
end;
fTokKind := tkIdent;

53
src/ce_dlang.pas
View File

@ -163,12 +163,16 @@ type
* Lexes aText and fills aList with the TLexToken found.
*)
procedure lex(const aText: string; const aList: TLexTokenList);
(*****************************************************************************
* Detects various syntaxic error in a TLexTokenList
* Detects various syntactic errors in a TLexTokenList
*)
procedure checkSyntaxicErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
(*****************************************************************************
* Outputs the module name from a tokenized D source.
*)
function getModuleName(const aTokenList: TLexTokenList):string;
(*****************************************************************************
* Compares two TPoints.
@ -677,7 +681,7 @@ end;
{$BOOLEVAL OFF}
{$ENDREGION}
{$REGION Syntaxic errors}
{$REGION Syntactic errors}
function TLexErrorList.getError(index: integer): TLexError;
begin
result := PLexError(Items[index])^;
@ -715,9 +719,9 @@ begin
result.fIndex := -1;
end;
procedure checkSyntaxicErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
const
errPrefix = 'syntaxic error: ';
errPrefix = 'syntactic error: ';
var
tk, old1, old2: TLexToken;
err: PLexError;
@ -797,13 +801,6 @@ begin
goto _preSeq;
end;
// invalid numbers
if tk.kind = ltkNumber then
begin
goto _preSeq;
end;
_preSeq:
// invalid sequences
if tkIndex > 0 then // can use old1
@ -812,8 +809,8 @@ _preSeq:
if old1.data = tk.data then
addError('keyword is duplicated');
if tk.data <> '&' then // ident = &ident
if (old1.kind = ltkOperator) and (tk.kind = ltkOperator) then
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
@ -832,6 +829,32 @@ _preSeq:
end;
function getModuleName(const aTokenList: TLexTokenList): string;
var
ltk: TLexToken;
mtok: boolean;
begin
result := '';
for ltk in aTokenList do
begin
if mtok then
begin
if ltk.kind = ltkIdentifier then
result += ltk.data;
if ltk.kind = ltkSymbol then
case ltk.data of
'.': result += ltk.data;
';': exit;
end;
end
else
if ltk.kind = ltkKeyword then
if ltk.data = 'module' then
mtok := true;
end;
end;
{$ENDREGION}
initialization

11
src/ce_dlangutils.pas
View File

@ -15,6 +15,7 @@ function isBit(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isAlNum(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isHex(const c: Char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isSymbol(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isPtrOperator(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isOperator1(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isOperator2(const s: string): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
function isOperator3(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF}
@ -66,6 +67,11 @@ begin
exit(c in [';', '{', '}', '(', ')', '[', ']', ',', '.', ':' , '"', #39, '?', '$']);
end;
function isPtrOperator(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
begin
exit(c in ['&', '*']);
end;
function isOperator1(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}
begin
exit(c in ['/', '*', '-', '+', '%', '>', '<', '=', '!',
@ -86,7 +92,7 @@ begin
'+': result := s[2] in ['+', '='];
'-': result := s[2] in ['-', '='];
'/': result := s[2] in ['='];
'*': result := s[2] in ['='];
'*': result := s[2] in ['=', '*']; // **: pointers
'%': result := s[2] in ['='];
'~': result := s[2] in ['='];
@ -107,12 +113,13 @@ begin
or (s[2] = '>') and (s[3] = '=');
'!': result := ((s[2] = '<') and (s[3] in ['>', '=']))
or ((s[2] = '>')and (s[3] = '='));
'*': result := (s[2] = '*') and (s[3] = '*'); // ***: pointers
end;
end;
function isOperator4(const s: string): boolean; {$IFNDEF DEBUG} inline; {$ENDIF}
begin
result := (s = '>>>=') or (s = '!<>=');
result := (s = '>>>=') or (s = '!<>=') or (s = '****');
end;
function isStringPostfix(const c: char): boolean; {$IFNDEF DEBUG}inline;{$ENDIF}

15
src/ce_editor.pas
View File

@ -112,18 +112,16 @@ end;
procedure TCEEditorWidget.focusedEditorChanged;
var
curr: TCESynMemo;
md: string;
begin
curr := getCurrentEditor;
macRecorder.Editor := curr;
fSyncEdit.Editor := curr;
identifierToD2Syn(curr);
md := getModuleName(curr.Lines);
if md = '' then md := extractFileName(curr.fileName);
pageControl.ActivePage.Caption := md;
//
if pageControl.ActivePageIndex <> -1 then
mainForm.docFocusedNotify(Self, pageControl.ActivePageIndex);
//
fKeyChanged := true; // re-tokenize.
end;
procedure TCEEditorWidget.PageControlChange(Sender: TObject);
@ -214,6 +212,7 @@ const
var
ed: TCESynMemo;
err: TLexError;
md: string;
begin
ed := getCurrentEditor;
if ed <> nil then
@ -229,10 +228,16 @@ begin
mainForm.MessageWidget.Clear;
lex( ed.Lines.Text, tokLst );
checkSyntaxicErrors( tokLst, errLst);
checkSyntacticErrors( tokLst, errLst);
for err in errLst do
mainForm.MessageWidget.addMessage(format(
'%s (@line:%4.d @char:%.4d)',[err.msg, err.position.y, err.position.x]));
md := getModuleName(tokLst);
if md = '' then md := extractFileName(ed.fileName);
pageControl.ActivePage.Caption := md;
mainForm.MessageWidget.scrollToBack;
tokLst.Clear;
errLst.Clear;

5
src/ce_widget.pas
View File

@ -67,6 +67,7 @@ type
procedure projNew(const aProject: TCEProject); virtual;
procedure projChange(const aProject: TCEProject); virtual;
procedure projClose(const aProject: TCEProject); virtual;
procedure projFocused(const aProject: TCEProject); virtual;
//
function contextName: string; virtual;
function contextActionCount: integer; virtual;
@ -223,6 +224,10 @@ procedure TCEWidget.projClose(const aProject: TCEProject);
begin
end;
procedure TCEWidget.projFocused(const aProject: TCEProject);
begin
end;
function TCEWidget.contextName: string;
begin
result := '';

2
src/ce_widgettypes.pas
View File

@ -37,6 +37,8 @@ type
procedure projNew(const aProject: TCEProject);
procedure projChange(const aProject: TCEProject);
procedure projClose(const aProject: TCEProject);
// not used yet.
procedure projFocused(const aProject: TCEProject);
end;
implementation