getModuleName uses TLexTokenList

src/ce_common.pas

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

src/ce_d2syn.pas

@@ -696,15 +696,11 @@ begin
     fTokKind := tkSymbl;
     while isOperator1(readNext) do (*!*);
     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
-            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;

src/ce_dlang.pas

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

src/ce_dlangutils.pas

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

src/ce_editor.pas

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

src/ce_widget.pas

@@ -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 := '';

src/ce_widgettypes.pas

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