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

View File

@ -21,6 +21,8 @@ type
fMaxCount: Integer; fMaxCount: Integer;
fObj: TObject; fObj: TObject;
protected protected
fChecking: boolean;
procedure clearOutOfRange;
procedure setMaxCount(aValue: Integer); procedure setMaxCount(aValue: Integer);
function checkItem(const S: string): boolean; virtual; function checkItem(const S: string): boolean; virtual;
procedure Put(Index: Integer; const S: string); override; procedure Put(Index: Integer; const S: string); override;
@ -55,11 +57,6 @@ type
*) *)
function expandFilenameEx(const aBasePath, aFilename: string): string; 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. * Patches the directory separators from a string.
* This is used to ensure that a project saved on a platform can be loaded * This is used to ensure that a project saved on a platform can be loaded
@ -96,30 +93,42 @@ begin
fMaxCount := 10; fMaxCount := 10;
end; end;
procedure TMRUList.clearOutOfRange;
begin
while Count > fMaxCount do delete(Count-1);
end;
procedure TMRUList.setMaxCount(aValue: Integer); procedure TMRUList.setMaxCount(aValue: Integer);
begin begin
if aValue < 0 then aValue := 0; if aValue < 0 then aValue := 0;
if fMaxCount = aValue then exit; if fMaxCount = aValue then exit;
while Count > fMaxCount do delete(Count-1); clearOutOfRange;
end; end;
function TMRUList.checkItem(const S: string): boolean; function TMRUList.checkItem(const S: string): boolean;
var
i: NativeInt;
begin 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; end;
procedure TMRUList.Put(Index: Integer; const S: string); procedure TMRUList.Put(Index: Integer; const S: string);
begin begin
if not (checkItem(S)) then exit; if not (checkItem(S)) then exit;
inherited; inherited;
while Count > fMaxCount do delete(Count-1); clearOutOfRange;
end; end;
procedure TMRUList.Insert(Index: Integer; const S: string); procedure TMRUList.Insert(Index: Integer; const S: string);
begin begin
if not (checkItem(S)) then exit; if not (checkItem(S)) then exit;
inherited; inherited;
while Count > fMaxCount do delete(Count-1); clearOutOfRange;
end; end;
function TMRUFileList.checkItem(const S: string): boolean; function TMRUFileList.checkItem(const S: string): boolean;
@ -127,7 +136,6 @@ begin
exit( inherited checkItem(S) and fileExists(S)); exit( inherited checkItem(S) and fileExists(S));
end; end;
procedure saveCompToTxtFile(const aComp: TComponent; const aFilename: string); procedure saveCompToTxtFile(const aComp: TComponent; const aFilename: string);
var var
str1, str2: TMemoryStream; str1, str2: TMemoryStream;
@ -225,59 +233,6 @@ begin
end; end;
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; function dlgOkCancel(const aMsg: string): TModalResult;
const const
Btns = [mbOK,mbCancel]; Btns = [mbOK,mbCancel];

View File

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

View File

@ -163,12 +163,16 @@ type
* Lexes aText and fills aList with the TLexToken found. * Lexes aText and fills aList with the TLexToken found.
*) *)
procedure lex(const aText: string; const aList: TLexTokenList); 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. * Compares two TPoints.
@ -677,7 +681,7 @@ end;
{$BOOLEVAL OFF} {$BOOLEVAL OFF}
{$ENDREGION} {$ENDREGION}
{$REGION Syntaxic errors} {$REGION Syntactic errors}
function TLexErrorList.getError(index: integer): TLexError; function TLexErrorList.getError(index: integer): TLexError;
begin begin
result := PLexError(Items[index])^; result := PLexError(Items[index])^;
@ -715,9 +719,9 @@ begin
result.fIndex := -1; result.fIndex := -1;
end; end;
procedure checkSyntaxicErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList); procedure checkSyntacticErrors(const aTokenList: TLexTokenList; const anErrorList: TLexErrorList);
const const
errPrefix = 'syntaxic error: '; errPrefix = 'syntactic error: ';
var var
tk, old1, old2: TLexToken; tk, old1, old2: TLexToken;
err: PLexError; err: PLexError;
@ -797,13 +801,6 @@ begin
goto _preSeq; goto _preSeq;
end; end;
// invalid numbers
if tk.kind = ltkNumber then
begin
goto _preSeq;
end;
_preSeq: _preSeq:
// invalid sequences // invalid sequences
if tkIndex > 0 then // can use old1 if tkIndex > 0 then // can use old1
@ -812,8 +809,8 @@ _preSeq:
if old1.data = tk.data then if old1.data = tk.data then
addError('keyword is duplicated'); 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'); addError('operator rhs cannot be an operator');
if (old1.kind = ltkNumber) and (tk.kind = ltkNumber) then if (old1.kind = ltkNumber) and (tk.kind = ltkNumber) then
@ -832,6 +829,32 @@ _preSeq:
end; 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} {$ENDREGION}
initialization initialization

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

View File

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

View File

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

View File

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