MG: added GUID and alias parsing, added DoJumpToCodeToolBossError

git-svn-id: trunk@551 -

components/codetools/pascalparsertool.pas

@@ -31,9 +31,7 @@
     
 
   ToDo:
-    -Parsing of GUID
-    -Parsing of With and Case
-    -Parsing of proc modifier alias [Alias: ''];
+  
 }
 unit PascalParserTool;
 
@@ -526,8 +524,21 @@ begin
     CurNode.Desc:=ctnClassPrivate
   else if UpAtomIs('PROTECTED') then
     CurNode.Desc:=ctnClassProtected
-  else
+  else begin
     CurNode.Desc:=ctnClassPublished;
+    if AtomIsChar('[') then begin
+      // read GUID
+      ReadNextAtom;
+      if not AtomIsStringConstant then
+        RaiseException('string constant expected, but '+GetAtom+' found');
+      if not ReadNextAtomIsChar(']') then
+        RaiseException('] expected, but '+GetAtom+' found');
+      ReadNextAtom;
+      if (not (AtomIsChar(';') or UpAtomIs('END'))) then
+        RaiseException('; expected, but '+GetAtom+' found');
+      ReadNextAtom;
+    end;
+  end;
   // parse till "end" of class/object
   CurKeyWordFuncList:=InnerClassKeyWordFuncList;
   try
@@ -989,6 +1000,7 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
  proc specifiers with parameters:
    message <id or number>
    external <id or number> name <id>
+   [alias: <string constant>]
 }
 var IsSpecifier: boolean;
 begin
@@ -1047,7 +1059,24 @@ begin
             exit;
           end;
         until (CurPos.Startpos>SrcLen) or AtomIsChar(';');
+      end else if AtomIsChar(';') then begin
+        // read assembler alias   [alias: 'alternative name']
+        if not ReadNextUpAtomIs('ALIAS') then
+          RaiseException('alias keyword expected, but '+GetAtom+' found');
+        if not ReadNextAtomIsChar(':') then
+          RaiseException('; expected, but '+GetAtom+' found');
+        ReadNextAtom;
+        if not AtomIsStringConstant then
+          RaiseException('string constant expected, but '+GetAtom+' found');
+        if not ReadNextAtomIsChar(']') then
+          RaiseException('] expected, but '+GetAtom+' found');
+        ReadNextAtom;
+        if UpAtomIs('END') then begin
+          UndoReadNextAtom;
+          exit;
+        end;
       end else begin
+        // read specifier without parameters
         if UpAtomIs('FORWARD') then HasForwardModifier:=true;
         ReadNextAtom;
         if UpAtomIs('END') then begin
@@ -1357,10 +1386,10 @@ begin
 end;
 
 function TPascalParserTool.KeyWordFuncEnd: boolean;
-// keyword 'end'  (parse end of block, e.g. begin..end)
+// keyword 'end'  (source end.)
 begin
   if LastAtomIs(0,'@') then
-    RaiseException('syntax error: identifer expected but keyword end found');
+    RaiseException('syntax error: identifier expected but keyword end found');
   if LastAtomIs(0,'@@') then begin
     // for Delphi compatibility @@end is allowed
     Result:=true;
@@ -1372,10 +1401,9 @@ begin
     CurNode.EndPos:=CurPos.EndPos;
   EndChildNode;
   ReadNextAtom;
-  if AtomIsChar('.') then
-    CurSection:=ctnNone
-  else
-    UndoReadNextAtom;
+  if not AtomIsChar('.') then
+    RaiseException('. expected, but '+GetAtom+' found');
+  CurSection:=ctnNone;
   Result:=true;
 end;
 

ide/main.pp

@@ -364,8 +364,6 @@ type
       var Handled, Abort: boolean);
     function OnMacroPromptFunction(const s:string; var Abort: boolean):string;
     procedure OnCmdLineCreate(var CmdLine: string; var Abort:boolean);
-    function DoJumpToCompilerMessage(Index:integer;
-      FocusEditor: boolean): boolean;
     procedure DoShowMessagesView;
     procedure DoArrangeSourceEditorAndMessageView;
     function GetProjectTargetFilename: string;
@@ -373,11 +371,14 @@ type
     function GetTestUnitFilename(AnUnitInfo: TUnitInfo): string;
     procedure SaveSourceEditorChangesToCodeCache;
     procedure ApplyCodeToolChanges;
+    function DoJumpToCompilerMessage(Index:integer;
+      FocusEditor: boolean): boolean;
     procedure DoJumpToProcedureSection;
     procedure DoFindDeclarationAtCursor;
     procedure DoCompleteCodeAtCursor;
-    function DoInitDebugger: TModalResult;
+    procedure DoJumpToCodeToolBossError;
     function DoCheckSyntax: TModalResult;
+    function DoInitDebugger: TModalResult;
     procedure UpdateDefaultPascalFileExtensions;
 
     procedure LoadMainMenu;
@@ -4143,28 +4144,9 @@ begin
   CodeToolBoss.VisibleEditorLines:=ActiveSrcEdit.EditorComponent.LinesInWindow;
   SaveSourceEditorChangesToCodeCache;
   if not CodeToolBoss.CheckSyntax(ActiveUnitInfo.Source,NewCode,NewX,NewY,
-    NewTopLine,ErrorMsg) then begin
-    // syntax error -> show error and jump
-    // show error in message view
-    DoArrangeSourceEditorAndMessageView;
-    MessagesView.AddSeparator;
-    MessagesView.Add(ErrorMsg);
-    // jump to error in source editor
-    if NewCode<>nil then begin
-      Result:=DoOpenEditorFile(NewCode.Filename,false);
-      if Result=mrOk then begin
-        ActiveSrcEdit:=SourceNoteBook.GetActiveSE;
-        SourceNotebook.BringToFront;
-        with ActiveSrcEdit.EditorComponent do begin
-          SetFocus;
-          CaretXY:=Point(NewX,NewY);
-          BlockBegin:=CaretXY;
-          BlockEnd:=CaretXY;
-          TopLine:=NewTopLine;
-        end;
-        ActiveSrcEdit.ErrorLine:=NewY;
-      end;
-    end;
+    NewTopLine,ErrorMsg) then
+  begin
+    DoJumpToCodeToolBossError;
   end;
 end;
 
@@ -5042,7 +5024,44 @@ writeln('[TMainIDE.DoJumpToProcedureSection] ************');
       TopLine:=NewTopLine;
     end;
   end else begin
-    // probably a syntax error or just not in a procedure head/body -> ignore
+    if CodeToolBoss.ErrorMessage<>'' then
+      DoJumpToCodeToolBossError;
+  end;
+end;
+
+procedure TMainIDE.DoJumpToCodeToolBossError;
+var
+  ActiveSrcEdit:TSourceEditor;
+begin
+  if CodeToolBoss.ErrorMessage='' then exit;
+  // syntax error -> show error and jump
+  // show error in message view
+  DoArrangeSourceEditorAndMessageView;
+  MessagesView.AddSeparator;
+  if CodeToolBoss.ErrorCode<>nil then begin
+    MessagesView.Add(Project.RemoveProjectPathFromFilename(
+       CodeToolBoss.ErrorCode.Filename)
+      +'('+IntToStr(CodeToolBoss.ErrorLine)
+      +','+IntToStr(CodeToolBoss.ErrorColumn)
+      +') Error: '+CodeToolBoss.ErrorMessage);
+  end else
+    MessagesView.Add(CodeToolBoss.ErrorMessage);
+  // jump to error in source editor
+  if CodeToolBoss.ErrorCode<>nil then begin
+    SourceNotebook.AddJumpPointClicked(Self);
+    if DoOpenEditorFile(CodeToolBoss.ErrorCode.Filename,false)=mrOk then begin
+      ActiveSrcEdit:=SourceNoteBook.GetActiveSE;
+      SourceNotebook.BringToFront;
+      with ActiveSrcEdit.EditorComponent do begin
+        SetFocus;
+        CaretXY:=Point(CodeToolBoss.ErrorColumn,CodeToolBoss.ErrorLine);
+        BlockBegin:=CaretXY;
+        BlockEnd:=CaretXY;
+        if CodeToolBoss.ErrorTopLine>0 then
+          TopLine:=CodeToolBoss.ErrorTopLine;
+      end;
+      ActiveSrcEdit.ErrorLine:=CodeToolBoss.ErrorLine;
+    end;
   end;
 end;
 
@@ -5130,6 +5149,8 @@ writeln('[TMainIDE.DoCompleteCodeAtCursor] ************');
     // or not in a class
     // -> there are enough events to handle everything, so it can be ignored here
     ApplyCodeToolChanges;
+    if CodeToolBoss.ErrorMessage<>'' then
+      DoJumpToCodeToolBossError;
   end;
   FOpenEditorsOnCodeToolChange:=false;
 end;
@@ -5453,17 +5474,35 @@ end.
 
 
 { =============================================================================
+<<<<<<< main.pp
+=======
 
   $Log$
+  Revision 1.192  2001/12/19 22:09:13  lazarus
+  MG: added GUID and alias parsing, added DoJumpToCodeToolBossError
+
   Revision 1.191  2001/12/19 20:28:50  lazarus
   Enabled Alignment of columns in a TListView.
   Shane
+>>>>>>> 1.191
+
+<<<<<<< main.pp
+  $Log$
+  Revision 1.192  2001/12/19 22:09:13  lazarus
+  MG: added GUID and alias parsing, added DoJumpToCodeToolBossError
 
   Revision 1.190  2001/12/18 21:09:58  lazarus
   MOre additions for breakpoints dialog
   Added a TSynEditPlugin in SourceEditor to get notified of lines inserted and deleted from the source.
   Shane
 
+=======
+  Revision 1.190  2001/12/18 21:09:58  lazarus
+  MOre additions for breakpoints dialog
+  Added a TSynEditPlugin in SourceEditor to get notified of lines inserted and deleted from the source.
+  Shane
+
+>>>>>>> 1.191
   Revision 1.189  2001/12/18 21:00:59  lazarus
   MG: compiler, fpc source and lazarus src can now be changed without restart
 

ide/project.pp

@@ -197,6 +197,7 @@ type
     function SearchFile(const Filename,SearchPaths,InitialDir:string):string;
     function GetMainResourceFilename(AnUnitInfo: TUnitInfo): string;
     function IsVirtual: boolean;
+    function RemoveProjectPathFromFilename(const AFilename: string): string;
 
     property ActiveEditorIndexAtStart: integer 
        read fActiveEditorIndexAtStart write fActiveEditorIndexAtStart;
@@ -1198,12 +1199,29 @@ begin
   end else begin
     // try making filename relative to project file
     if FilenameIsAbsolute(AFilename) 
-    and (copy(AFilename,1,length(ProjectPath))=ProjectPath) then
+    and (CompareFileNames(copy(AFilename,1,length(ProjectPath)),ProjectPath)=0)
+    then
       AFilename:=copy(AFilename,length(ProjectPath)+1,
            length(AFilename)-length(ProjectPath));
   end;
 end;
 
+function TProject.RemoveProjectPathFromFilename(
+  const AFilename: string): string;
+var ProjectPath:string;
+begin
+  ProjectPath:=ExtractFilePath(ProjectFile);
+  if ProjectPath='' then ProjectPath:=GetCurrentDir;
+  Result:=AFilename;
+  DoDirSeparators(Result);
+  // try making filename relative to project file
+  if FilenameIsAbsolute(Result)
+  and (CompareFileNames(copy(Result,1,length(ProjectPath)),ProjectPath)=0)
+  then
+    Result:=copy(Result,length(ProjectPath)+1,
+         length(Result)-length(ProjectPath));
+end;
+
 procedure TProject.OnUnitNameChange(AnUnitInfo: TUnitInfo; 
   const OldUnitName, NewUnitName: string;  var Allowed: boolean);
 var i:integer;
@@ -1269,6 +1287,9 @@ end.
 
 {
   $Log$
+  Revision 1.47  2001/12/19 22:09:14  lazarus
+  MG: added GUID and alias parsing, added DoJumpToCodeToolBossError
+
   Revision 1.46  2001/12/16 22:24:54  lazarus
   MG: changes for new compiler 20011216