added symlink test and unit types

git-svn-id: trunk@3726 -

components/codetools/finddeclarationtool.pas

@@ -2134,10 +2134,12 @@ function TFindDeclarationTool.FindBaseTypeOfNode(Params: TFindDeclarationParams;
     RaiseExceptionFmt(ctsBaseTypeOfNotFound,[GetIdentifier(Params.Identifier)]);
   end;
   
-var OldInput: TFindDeclarationInput;
+var
+  OldInput: TFindDeclarationInput;
   ClassIdentNode, DummyNode: TCodeTreeNode;
   NodeStack: TCodeTreeNodeStack;
   OldPos: integer;
+  TypeFound: boolean;
   
   procedure RaiseForwardNotResolved;
   begin
@@ -2237,7 +2239,24 @@ begin
         if Params.ContextNode.Desc=ctnProcedureHead then
           // skip search in proc parameters
           Params.ContextNode:=Params.ContextNode.Parent;
-        if FindIdentifierInContext(Params) then begin
+        TypeFound:=FindIdentifierInContext(Params);
+        if TypeFound and (Params.NewNode.Desc in [ctnUnit,ctnLibrary,ctnPackage])
+        then begin
+          // unitname.typename
+          MoveCursorToNodeStart(Result.Node);
+          ReadNextAtom; // read unitname
+          ReadNextAtomIsChar('.');
+          ReadNextAtom; // read type identifier
+          Params.Load(OldInput);
+          Params.SetIdentifier(Self,@Src[CurPos.StartPos],
+                               @CheckSrcIdentifier);
+          Params.Flags:=[fdfExceptionOnNotFound]
+                        +(fdfGlobals*OldInput.Flags)
+                        +[fdfIgnoreUsedUnits];
+          Params.ContextNode:=Params.NewCodeTool.FindInterfaceNode;
+          TypeFound:=Params.NewCodeTool.FindIdentifierInContext(Params);
+        end;
+        if TypeFound then begin
           if Params.NewNode.Desc in [ctnTypeDefinition] then begin
             if NodeExistsInStack(@NodeStack,Params.NewNode) then begin
               // circle detected

lcl/filectrl.pp

@@ -46,10 +46,12 @@ uses
 // file attributes and states
 function FilenameIsAbsolute(TheFilename: string):boolean;
 procedure CheckIfFileIsExecutable(const AFilename: string);
+procedure CheckIfFileIsSymlink(const AFilename: string);
 function FileIsReadable(const AFilename: string): boolean;
 function FileIsWritable(const AFilename: string): boolean;
 function FileIsText(const AFilename: string): boolean;
 function FileIsExecutable(const AFilename: string): boolean;
+function FileIsSymlink(const AFilename: string): boolean;
 function GetFileDescription(const AFilename: string): string;
 
 // directories
@@ -106,6 +108,9 @@ end.
 
 {
   $Log$
+  Revision 1.8  2002/12/23 10:12:40  mattias
+  added symlink test and unit types
+
   Revision 1.7  2002/12/17 19:49:34  mattias
   finished publish project
 

lcl/include/filectrl.inc

@@ -290,6 +290,51 @@ begin
   end;
 end;
 
+{------------------------------------------------------------------------------
+  procedure CheckIfFileIsSymlink(const AFilename: string);
+ ------------------------------------------------------------------------------}
+
+procedure CheckIfFileIsSymlink(const AFilename: string);
+{$IFNDEF win32}
+var
+  AText: string;
+{$ENDIF}
+begin
+  // to get good error messages consider the OS
+  if not FileExists(AFilename) then begin
+    raise Exception.Create('file "'+AFilename+'" does not exist');
+  end;
+  {$IFNDEF win32}
+  if {$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.ReadLink(AFilename)='' then begin
+    AText:='"'+AFilename+'"';
+    case LinuxError of
+    sys_eacces: AText:='read access denied for '+AText;
+    sys_enoent: AText:='a directory component in '+AText
+                          +' does not exist or is a dangling symlink';
+    sys_enotdir: AText:='a directory component in '+Atext+' is not a directory';
+    sys_enomem: AText:='insufficient memory';
+    sys_eloop: AText:=AText+' has a circular symbolic link';
+    else
+      AText:=AText+' is not a symbolic link';
+    end;
+    raise Exception.Create(AText);
+  end;
+  {$ENDIF}
+end;
+
+{------------------------------------------------------------------------------
+  function FileIsSymlink(const AFilename: string): boolean;
+ ------------------------------------------------------------------------------}
+function FileIsSymlink(const AFilename: string): boolean;
+begin
+  try
+    CheckIfFileIsSymlink(AFilename);
+    Result:=true;
+  except
+    Result:=false;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   function FileIsReadable(const AFilename: string): boolean;
  ------------------------------------------------------------------------------}
@@ -462,8 +507,6 @@ begin
     raise Exception.Create(AText);
   end;
   {$ENDIF}
-
-  // ToDo: windows and xxxbsd
 end;
 
 {------------------------------------------------------------------------------
@@ -631,6 +674,9 @@ end;
 
 {
   $Log$
+  Revision 1.7  2002/12/23 10:12:40  mattias
+  added symlink test and unit types
+
   Revision 1.6  2002/12/17 19:49:34  mattias
   finished publish project
 

lcl/interfaces/gtk/gtkwinapiwindow.pp

@@ -156,13 +156,16 @@ procedure GTKAPIWidgetClient_Realize(Widget: PGTKWidget); cdecl;
 var
   Attributes: TGdkWindowAttr;
   AttributesMask: gint;
-
+  {$IFNDEF WinAPIChilds}
   Client: PGTKAPIWidgetClient;
+  {$ENDIF}
 begin
 //  Assert(False, 'Trace:[GTKAPIWidgetClient_Realize]');
   gtk_widget_set_flags(Widget, GTK_REALIZED);
 
+  {$IFNDEF WinAPIChilds}
   Client := PGTKAPIWidgetClient(Widget);
+  {$ENDIF}
 
   with Attributes do
   begin
@@ -774,6 +777,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.40  2002/12/23 10:12:40  mattias
+  added symlink test and unit types
+
   Revision 1.39  2002/12/22 22:42:55  mattias
   custom controls now support child wincontrols