MG: added TListView notification from Vincent

git-svn-id: trunk@3340 -

components/codetools/customcodetool.pas

@@ -156,6 +156,8 @@ type
         const AnAtom: shortstring): boolean; // 0=current, 1=prior current, ...
     function GetAtom: string;
     function GetUpAtom: string;
+    function GetAtom(Atom: TAtomPosition): string;
+    function GetUpAtom(Atom: TAtomPosition): string;
     function CompareNodeIdentChars(ANode: TCodeTreeNode;
         const AnUpperIdent: string): integer;
     function CompareSrcIdentifiers(
@@ -598,6 +600,16 @@ begin
   Result:=copy(UpperSrc,CurPos.StartPos,CurPos.EndPos-CurPos.StartPos);
 end;
 
+function TCustomCodeTool.GetAtom(Atom: TAtomPosition): string;
+begin
+  Result:=copy(Src,Atom.StartPos,Atom.EndPos-Atom.StartPos);
+end;
+
+function TCustomCodeTool.GetUpAtom(Atom: TAtomPosition): string;
+begin
+  Result:=copy(UpperSrc,Atom.StartPos,Atom.EndPos-Atom.StartPos);
+end;
+
 procedure TCustomCodeTool.ReadNextAtom;
 var c1, c2: char;
   CommentLvl: integer;

components/codetools/finddeclarationtool.pas

@@ -2527,31 +2527,15 @@ function TFindDeclarationTool.FindIdentifierInUsesSection(
    search backwards through the uses section
    compare first the unit name, then load the unit and search there
 }
-var InAtom, UnitNameAtom: TAtomPosition;
+var
+  InAtom, UnitNameAtom: TAtomPosition;
   NewCodeTool: TFindDeclarationTool;
   OldInput: TFindDeclarationInput;
 begin
   Result:=false;
-  if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then
+  MoveCursorToUsesEnd(UsesNode);
-    RaiseException('[TFindDeclarationTool.FindIdentifierInUsesSection] '
-      +'internal error: invalid UsesNode');
-  // search backwards through the uses section
-  MoveCursorToCleanPos(UsesNode.EndPos);
-  ReadPriorAtom; // read ';'
-  if not AtomIsChar(';') then
-    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
   repeat
-    ReadPriorAtom; // read unitname
+    ReadPriorUsedUnit(UnitNameAtom, InAtom);
-    if AtomIsStringConstant then begin
-      InAtom:=CurPos;
-      ReadPriorAtom; // read 'in'
-      if not UpAtomIs('IN') then
-        RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsKeywordIn,GetAtom]);
-      ReadPriorAtom; // read unitname
-    end else
-      InAtom.StartPos:=-1;
-    AtomIsIdentifier(true);
-    UnitNameAtom:=CurPos;
     if (fdfIgnoreUsedUnits in Params.Flags) then begin
       if CompareSrcIdentifiers(UnitNameAtom.StartPos,Params.Identifier) then
       begin
@@ -2568,12 +2552,10 @@ begin
       NewCodeTool:=FindCodeToolForUsedUnit(UnitNameAtom,InAtom,false);
       if NewCodeTool=nil then begin
         MoveCursorToCleanPos(UnitNameAtom.StartPos);
-        RaiseExceptionFmt(ctsUnitNotFound,[copy(Src,UnitNameAtom.StartPos,
+        RaiseExceptionFmt(ctsUnitNotFound,[GetAtom(UnitNameAtom)]);
-           UnitNameAtom.EndPos-UnitNameAtom.StartPos)]);
       end else if NewCodeTool=Self then begin
         MoveCursorToCleanPos(UnitNameAtom.StartPos);
-        RaiseExceptionFmt(ctsIllegalCircleInUsedUnits,[copy(Src,
+        RaiseExceptionFmt(ctsIllegalCircleInUsedUnits,[GetAtom(UnitNameAtom)]);
-           UnitNameAtom.StartPos,UnitNameAtom.EndPos-UnitNameAtom.StartPos)]);
       end;
       // search the identifier in the interface of the used unit
       Params.Save(OldInput);

components/codetools/pascalparsertool.pas

@@ -171,6 +171,7 @@ type
 
     function CleanPosIsInComment(CleanPos, CleanCodePosInFront: integer;
         var CommentStart, CommentEnd: integer): boolean;
+        
     procedure BuildTree(OnlyInterfaceNeeded: boolean); virtual;
     procedure BuildTreeAndGetCleanPos(TreeRange: TTreeRange;
         CursorPos: TCodeXYPosition; var CleanCursorPos: integer);
@@ -179,7 +180,9 @@ type
     procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual;
     procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode;
         var FunctionResult: TCodeTreeNode);
+        
     function DoAtom: boolean; override;
+    
     function ExtractPropName(PropNode: TCodeTreeNode;
         InUpperCase: boolean): string;
     function ExtractPropType(PropNode: TCodeTreeNode;
@@ -194,35 +197,43 @@ type
     function FindProcNode(StartNode: TCodeTreeNode; const AProcHead: string;
         Attr: TProcHeadAttributes): TCodeTreeNode;
     function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
+    procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
+    function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
+        ProcSpec: TProcedureSpecifier): boolean;
+    function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
+        ProcSpec: TProcedureSpecifier): boolean;
+
     function FindVarNode(StartNode: TCodeTreeNode;
         const UpperVarName: string): TCodeTreeNode;
+    function FindTypeNodeOfDefinition(
+        DefinitionNode: TCodeTreeNode): TCodeTreeNode;
+
     function FindFirstNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode;
     function FindNextNodeOnSameLvl(StartNode: TCodeTreeNode): TCodeTreeNode;
+    
     function FindClassNode(StartNode: TCodeTreeNode;
         const UpperClassName: string;
         IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
     function FindClassNodeInInterface(const UpperClassName: string;
         IgnoreForwards, IgnoreNonForwards: boolean): TCodeTreeNode;
     function FindFirstIdentNodeInClass(ClassNode: TCodeTreeNode): TCodeTreeNode;
+    function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
+
+    function GetSourceType: TCodeTreeNodeDesc;
     function FindInterfaceNode: TCodeTreeNode;
     function FindImplementationNode: TCodeTreeNode;
     function FindInitializationNode: TCodeTreeNode;
     function FindMainBeginEndNode: TCodeTreeNode;
-    function FindTypeNodeOfDefinition(
+    
-        DefinitionNode: TCodeTreeNode): TCodeTreeNode;
-    function GetSourceType: TCodeTreeNodeDesc;
     function NodeHasParentOfType(ANode: TCodeTreeNode;
         NodeDesc: TCodeTreeNodeDesc): boolean;
     function NodeIsInAMethod(Node: TCodeTreeNode): boolean;
     function NodeIsFunction(ProcNode: TCodeTreeNode): boolean;
     function NodeIsPartOfTypeDefinition(ANode: TCodeTreeNode): boolean;
     function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
-    procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
+    
-    function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
+    procedure MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
-        ProcSpec: TProcedureSpecifier): boolean;
+    procedure ReadPriorUsedUnit(var UnitNameAtom, InAtom: TAtomPosition);
-    function ProcNodeHasSpecifier(ProcNode: TCodeTreeNode;
-        ProcSpec: TProcedureSpecifier): boolean;
-    function ClassSectionNodeStartsWithWord(ANode: TCodeTreeNode): boolean;
 
     constructor Create;
     destructor Destroy; override;
@@ -492,21 +503,39 @@ end;
 
 procedure TPascalParserTool.BuildSubTreeForClass(ClassNode: TCodeTreeNode);
 // reparse a quick parsed class and build the child nodes
+
+  procedure RaiseClassNodeNil;
+  begin
+    SaveRaiseException(
+       'TPascalParserTool.BuildSubTreeForClass: Classnode=nil');
+  end;
+  
+  procedure RaiseClassDescInvalid;
+  begin
+    SaveRaiseException('[TPascalParserTool.BuildSubTreeForClass] ClassNode.Desc='
+                   +ClassNode.DescAsString);
+  end;
+
+  procedure RaiseClassKeyWordExpected;
+  begin
+    SaveRaiseException(
+        'TPascalParserTool.BuildSubTreeForClass:'
+       +' class/object keyword expected, but '+GetAtom+' found');
+  end;
+
 var OldPhase: integer;
 begin
   OldPhase:=CurrentPhase;
   CurrentPhase:=CodeToolPhaseParse;
   try
     if ClassNode=nil then
-      SaveRaiseException(
+      RaiseClassNodeNil;
-         'TPascalParserTool.BuildSubTreeForClass: Classnode=nil');
     if (ClassNode.FirstChild<>nil)
     or ((ClassNode.SubDesc and ctnsNeedJITParsing)=0) then
       // class already parsed
       exit;
     if ClassNode.Desc<>ctnClass then
-      SaveRaiseException('[TPascalParserTool.BuildSubTreeForClass] ClassNode.Desc='
+      RaiseClassDescInvalid;
-                     +ClassNode.DescAsString);
     // set CursorPos after class head
     MoveCursorToNodeStart(ClassNode);
     // parse
@@ -519,9 +548,7 @@ begin
     ReadNextAtom;
     if UpAtomIs('PACKED') then ReadNextAtom;
     if (not UpAtomIs('CLASS')) and (not UpAtomIs('OBJECT')) then
-      SaveRaiseException(
+      RaiseClassKeyWordExpected;
-          'TPascalParserTool.BuildSubTreeForClass:'
-         +' class/object keyword expected, but '+GetAtom+' found');
     ReadNextAtom;
     if CurPos.Flag=cafRoundBracketOpen then
       // read inheritage
@@ -3660,6 +3687,34 @@ begin
   Result:=UpAtomIs('DEFAULT');
 end;
 
+procedure TPascalParserTool.MoveCursorToUsesEnd(UsesNode: TCodeTreeNode);
+begin
+  if (UsesNode=nil) or (UsesNode.Desc<>ctnUsesSection) then
+    RaiseException('[TPascalParserTool.MoveCursorToUsesEnd] '
+      +'internal error: invalid UsesNode');
+  // search backwards through the uses section
+  MoveCursorToCleanPos(UsesNode.EndPos);
+  ReadPriorAtom; // read ';'
+  if not AtomIsChar(';') then
+    RaiseExceptionFmt(ctsStrExpectedButAtomFound,[';',GetAtom]);
+end;
+
+procedure TPascalParserTool.ReadPriorUsedUnit(var UnitNameAtom,
+  InAtom: TAtomPosition);
+begin
+  ReadPriorAtom; // read unitname
+  if AtomIsStringConstant then begin
+    InAtom:=CurPos;
+    ReadPriorAtom; // read 'in'
+    if not UpAtomIs('IN') then
+      RaiseExceptionFmt(ctsStrExpectedButAtomFound,[ctsKeywordIn,GetAtom]);
+    ReadPriorAtom; // read unitname
+  end else
+    InAtom.StartPos:=-1;
+  AtomIsIdentifier(true);
+  UnitNameAtom:=CurPos;
+end;
+
 procedure TPascalParserTool.MoveCursorToFirstProcSpecifier(
   ProcNode: TCodeTreeNode);
 // After the call,

components/codetools/stdcodetools.pas

@@ -89,6 +89,7 @@ type
           SourceChangeCache: TSourceChangeCache): boolean;
     function FindUsedUnits(var MainUsesSection,
           ImplementationUsesSection: TStrings): boolean;
+    function UsesSectionToFilenames(UsesNode: TCodeTreeNode): TStrings;
 
     // lazarus resources
     function FindNextIncludeInInitialization(
@@ -521,27 +522,71 @@ end;
 
 function TStandardCodeTool.FindUsedUnits(var MainUsesSection,
   ImplementationUsesSection: TStrings): boolean;
-
-  function UsesSectionToStrings(ANode: TCodeTreeNode): TStrings;
-  begin
-    Result:=TStringList.Create;
-    if ANode=nil then exit;
-
-  end;
-
 var
   MainUsesNode, ImplementatioUsesNode: TCodeTreeNode;
 begin
+  MainUsesSection:=nil;
+  ImplementationUsesSection:=nil;
   // find the uses sections
   BuildTree(false);
   MainUsesNode:=FindMainUsesSection;
   ImplementatioUsesNode:=FindImplementationUsesSection;
   // create lists
-  MainUsesSection:=UsesSectionToStrings(MainUsesNode);
+  try
-  ImplementationUsesSection:=UsesSectionToStrings(ImplementatioUsesNode);
+    MainUsesSection:=UsesSectionToFilenames(MainUsesNode);
+    ImplementationUsesSection:=UsesSectionToFilenames(ImplementatioUsesNode);
+  finally
+    FreeAndNil(MainUsesSection);
+    FreeAndNil(ImplementationUsesSection);
+  end;
   Result:=true;
 end;
 
+{------------------------------------------------------------------------------
+  function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode
+    ): TStrings;
+
+  Reads the uses section backwards and tries to find each unit file
+  The associated objects in the list will be the found codebuffers.
+  If no codebuffer was found/created then the filename will be the unit name
+  plus the 'in' extension.
+------------------------------------------------------------------------------}
+function TStandardCodeTool.UsesSectionToFilenames(UsesNode: TCodeTreeNode
+  ): TStrings;
+var
+  InAtom, UnitNameAtom: TAtomPosition;
+  AnUnitName, AnUnitInFilename: string;
+  NewCode: TCodeBuffer;
+  UnitFilename: string;
+begin
+  MoveCursorToUsesEnd(UsesNode);
+  Result:=TStringList.Create;
+  repeat
+    // read prior unit name
+    ReadPriorUsedUnit(UnitNameAtom, InAtom);
+    AnUnitName:=GetAtom(UnitNameAtom);
+    if InAtom.StartPos>0 then
+      AnUnitInFilename:=GetAtom(InAtom)
+    else
+      AnUnitInFilename:='';
+    // find unit file
+    NewCode:=FindUnitSource(AnUnitName,AnUnitInFilename);
+    if (NewCode=nil) then begin
+      // no source found
+      UnitFilename:=AnUnitName;
+      if AnUnitInFilename<>'' then
+        UnitFilename:=UnitFilename+' in '+AnUnitInFilename;
+    end else begin
+      // source found
+      UnitFilename:=NewCode.Filename;
+    end;
+    // add filename to list
+    Result.AddObject(UnitFilename,NewCode);
+    // read keyword 'uses' or comma
+    ReadPriorAtom;
+  until not AtomIsChar(',');
+end;
+
 function TStandardCodeTool.FindNextIncludeInInitialization(
   var LinkIndex: integer): TCodeBuffer;
 // LinkIndex < 0  ->  search first

ide/unitdependencies.pas

@@ -297,7 +297,7 @@ procedure TUnitNode.CreateChilds;
 //var
 //  UsedInterfaceFilenames, UsedImplementation: TStrings;
 begin
-
+  //CodeToolBoss.FindUsedUnits();
 end;
 
 end.

lcl/comctrls.pp

@@ -121,6 +121,7 @@ type
     property Visible;
   end;
 
+
  { Custom draw }
 
   TCustomDrawTarget = (dtControl, dtItem, dtSubItem);
@@ -130,7 +131,8 @@ type
   TCustomDrawState = set of TCustomDrawStateFlag;
 
 
-{TListView}
+  { TListView }
+  
   TListItems = class;  //forward declaration!
   TCustomListView = class;  //forward declaration!
   TSortType = (stNone, stData, stText, stBoth);
@@ -171,7 +173,7 @@ type
     property ImageIndex : Integer read FImageIndex write SetImageIndex default -1;
   end;
 
- TListItems = class(TPersistent)
+  TListItems = class(TPersistent)
   private
     FOwner : TCustomListView;
     FItems : TList;
@@ -272,7 +274,7 @@ type
     FScrollBars: TScrollStyle;
     FScrolledLeft: integer; // horizontal scrolled pixels (hidden pixels at top)
     FScrolledTop: integer;  // vertical scrolled pixels (hidden pixels at top)
-    FSelected: TListItem; // temp copy of the selected item
+    FSelected: TListItem;   // temp copy of the selected item
     FLastHorzScrollInfo: TScrollInfo;
     FLastVertScrollInfo: TScrollInfo;
     FUpdateCount: integer;
@@ -1598,6 +1600,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.46  2002/09/14 08:38:05  lazarus
+  MG: added TListView notification from Vincent
+
   Revision 1.45  2002/09/13 16:07:20  lazarus
   Reverting statusbar changes.
 

lcl/include/listitems.inc

@@ -80,7 +80,10 @@ var
 begin
   idx := FItems.Remove(AItem);
   if (idx >= 0) and (FOwner <> nil)
-  then FOwner.ItemDeleted(idx);
+  then begin
+    if FOwner.FSelected=AItem then FOwner.FSelected:=nil;
+    FOwner.ItemDeleted(idx);
+  end;
 end;
 
 {------------------------------------------------------------------------------}
@@ -134,6 +137,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.12  2002/09/14 08:38:06  lazarus
+  MG: added TListView notification from Vincent
+
   Revision 1.11  2002/05/10 06:05:53  lazarus
   MG: changed license to LGPL
 

lcl/interfaces/gtk/gtklistviewcallback.inc

@@ -73,7 +73,7 @@ var
   NM: TNMListView;
 begin
   EventTrace('click-column', Adata);
-  msg.Msg := LM_NOTIFY;
+  msg.Msg := CN_NOTIFY;
 
   FillChar(NM, SizeOf(NM), 0);
   NM.hdr.hwndfrom := longint(AList);
@@ -96,7 +96,7 @@ begin
   // Simulate move by remove and insert
 
   EventTrace('row-move', Adata);
-  msg.Msg := LM_NOTIFY;
+  msg.Msg := CN_NOTIFY;
 
   FillChar(NM, SizeOf(NM), 0);
   NM.hdr.hwndfrom := longint(AList);
@@ -119,7 +119,7 @@ var
   NM: TNMListView;
 begin
   EventTrace('select-row', Adata);
-  msg.Msg := LM_NOTIFY;
+  msg.Msg := CN_NOTIFY;
 
   FillChar(NM, SizeOf(NM), 0);
   NM.hdr.hwndfrom := longint(AList);
@@ -138,7 +138,7 @@ var
   NM: TNMListView;
 begin
   EventTrace('unselect-row', Adata);
-  msg.Msg := LM_NOTIFY;
+  msg.Msg := CN_NOTIFY;
 
   FillChar(NM, SizeOf(NM), 0);
   NM.hdr.hwndfrom := longint(AList);
@@ -157,7 +157,7 @@ function gtkLVToggleFocusRow(AList: PGTKCList; AData: gPointer): GBoolean; cdecl
   //NM: TNMListView;
 begin
   EventTrace('toggle-focus-row', Adata);
-  //msg.Msg := LM_NOTIFY;
+  //msg.Msg := CN_NOTIFY;
 (*
   TODO:
   Do we need this?
@@ -173,8 +173,8 @@ var
   n: Integer;
 begin
   EventTrace('select-all', Adata);
-  msg.Msg := LM_NOTIFY;
+  msg.Msg := CN_NOTIFY;
-  
+
   ListView := TObject(AData) as TListView;
 
   FillChar(NM, SizeOf(NM), 0);