paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 22:36:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

improved phpAddClassName and fixed consistency error in msgview

Browse Source 
git-svn-id: trunk@8817 -
This commit is contained in:
mattias 2006-02-24 15:49:34 +00:00
parent f5b827c8f7
commit 7ce27416cc
4 changed files with 67 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
components/codetools/pascalreadertool.pas
View File

@ -344,20 +344,17 @@ begin
exit;
IsProcType:=(ProcNode.Desc=ctnProcedureType);
if (phpAddClassname in Attr) then begin
TypeDefNode:=ProcNode.Parent;
if TypeDefNode=nil then exit;
TypeDefNode:=TypeDefNode.Parent;
if (TypeDefNode=nil) or (TypeDefNode.Desc<>ctnClass) then exit;
TypeDefNode:=TypeDefNode.Parent;
if TypeDefNode.Desc=ctnGenericType then begin
TypeDefNode:=TypeDefNode.Parent;
if TypeDefNode=nil then exit;
TheClassName:='';
TypeDefNode:=ProcNode.GetNodeOfType(ctnClass);
if TypeDefNode<>nil then begin
TypeDefNode:=TypeDefNode.GetNodeOfType(ctnTypeDefinition);
if TypeDefNode<>nil then begin
MoveCursorToCleanPos(TypeDefNode.StartPos);
ReadNextAtom;
if not AtomIsIdentifier(false) then exit;
TheClassName:=GetAtom;
end;
end;
if TypeDefNode.Desc<>ctnTypeDefinition then exit;
MoveCursorToCleanPos(TypeDefNode.StartPos);
ReadNextAtom;
if not AtomIsIdentifier(false) then exit;
TheClassName:=GetAtom;
end;
InitExtraction;
// reparse the clean source
@ -394,7 +391,7 @@ begin
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
end else begin
// read name
if not (phpAddClassname in Attr) then begin
if (not (phpAddClassname in Attr)) or (TheClassName='') then begin
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
end else begin
// add class name
@ -540,7 +537,7 @@ var CurProcHead: string;
begin
Result:=StartNode;
while (Result<>nil) do begin
//DebugLn('TPascalParserTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"');
//DebugLn('TPascalReaderTool.FindProcNode A "',NodeDescriptionAsString(Result.Desc),'"');
if Result.Desc=ctnProcedure then begin
if (not ((phpIgnoreForwards in Attr)
and ((Result.SubDesc and ctnsForwardDeclaration)>0)))
@ -548,7 +545,7 @@ begin
and (FindProcBody(Result)<>nil))) then
begin
CurProcHead:=ExtractProcHead(Result,Attr);
//DebugLn('TPascalParserTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'"');
//DebugLn('TPascalReaderTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'"');
if (CurProcHead<>'')
and (CompareTextIgnoringSpace(CurProcHead,AProcHead,false)=0) then
exit;
@ -568,7 +565,7 @@ var
begin
Result:=nil;
// get ctnProcedure
//debugln('TPascalReaderTool.FindCorrespondingProcNode A');
//debugln('TPascalReaderTool.FindCorrespondingProcNode Start');
if (ProcNode=nil) then exit;
if ProcNode.Desc=ctnProcedureHead then begin
ProcNode:=ProcNode.Parent;
@ -577,14 +574,14 @@ begin
if ProcNode.Desc<>ctnProcedure then exit;
// check proc kind
//debugln('TPascalReaderTool.FindCorrespondingProcNode B');
//debugln('TPascalReaderTool.FindCorrespondingProcNode Check kind');
ClassNode:=ProcNode.GetNodeOfType(ctnClass);
if ClassNode<>nil then begin
//debugln('TPascalReaderTool.FindCorrespondingProcNode C');
//debugln('TPascalReaderTool.FindCorrespondingProcNode Class');
// in a class definition -> search method body
StartNode:=ClassNode.GetNodeOfType(ctnTypeSection)
end else if NodeIsMethodBody(ProcNode) then begin
//debugln('TPascalReaderTool.FindCorrespondingProcNode D');
//debugln('TPascalReaderTool.FindCorrespondingProcNode Method');
// in a method body -> search class
StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode),true,
false,false,true);
@ -592,16 +589,18 @@ begin
while (StartNode<>nil)
and (StartNode.Desc in [ctnClass,ctnClassInterface]+AllClassSections) do
StartNode:=StartNode.FirstChild;
//debugln('TPascalReaderTool.FindCorrespondingProcNode D2 ',StartNode.DescAsString);
end else
end else begin
//DebugLn('TPascalReaderTool.FindCorrespondingProcNode Normal');
// else: search on same lvl
StartNode:=FindFirstNodeOnSameLvl(ProcNode);
end;
if StartNode=nil then exit;
//debugln('TPascalReaderTool.FindCorrespondingProcNode E');
//debugln('TPascalReaderTool.FindCorrespondingProcNode StartNode=',StartNode.DescAsString);
ProcHead:=ExtractProcHead(ProcNode,Attr);
Result:=FindProcNode(StartNode,ProcHead,Attr);
if Result=ProcNode then begin
// found itself -> search further
StartNode:=FindNextNodeOnSameLvl(Result);
Result:=FindProcNode(StartNode,ProcHead,Attr);
end;

3
ide/msgquickfixes.pas
View File

@ -84,6 +84,9 @@ begin
then begin
LazarusIDE.DoJumpToCodeToolBossError;
end;
// message fixed
Msg.Msg:='';
end;
function GetMsgLineFilename(Msg: TIDEMessageLine; out CodeBuf: TCodeBuffer

44
ide/msgview.pp
View File

@ -119,6 +119,7 @@ type
function FindNextItem(const Filename: string;
FirstLine, LineCount: integer): TAVLTreeNode;
procedure UpdateMsgSrcPos(Line: TLazMessageLine);
procedure ConsistencyCheck;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -348,6 +349,7 @@ begin
if Line.VisiblePosition > VisibleIndex then
Line.VisiblePosition:=Line.VisiblePosition-1;
end;
//ConsistencyCheck;
end;
{------------------------------------------------------------------------------
@ -375,7 +377,7 @@ begin
NewMsg.Msg := Msg;
NewMsg.Directory := CurDir;
NewMsg.Position := FItems.Count;
NewMsg.Position := FItems.Count-1;
NewMsg.OriginalIndex := OriginalIndex;
//DebugLn('TMessagesView.Add FItems.Count=',dbgs(FItems.Count),' OriginalIndex=',dbgs(OriginalIndex));
@ -397,6 +399,7 @@ begin
FLastLineIsProgress := ProgressLine;
MessageListBox.TopIndex := MessageListBox.Items.Count - 1;
end;
//ConsistencyCheck;
end;
procedure TMessagesView.AddMsg(const Msg, CurDir: string; OriginalIndex: integer);
@ -795,7 +798,7 @@ begin
end;
procedure TMessagesView.MessageViewDrawItem(Control: TWinControl;
Index: Integer; ARect: TRect; State: TOwnerDrawState);
Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
TheText: string;
cl: TColor;
@ -809,6 +812,7 @@ const
cLeftSpacer = 3;
begin
MessageListBox.Canvas.FillRect(ARect);
//DebugLn('TMessagesView.MessageViewDrawItem Index=',dbgs(Index),' Count=',dbgs(MessageListBox.Items.Count));
TheText := MessageListBox.Items[Index];
cl := MessageListBox.Canvas.Font.Color; // save original color
@ -863,9 +867,18 @@ begin
QuickFixItem:=TIDEMsgQuickFixItem(FQuickFixItems[i]);
if (QuickFixItem.Caption=(Sender as TIDEMenuItem).Caption)
and (imqfoMenuItem in QuickFixItem.Steps) then begin
//ConsistencyCheck;
DebugLn('TMessagesView.OnQuickFixClick ',Msg.Msg,' ',dbgs(Msg.VisiblePosition),' ',dbgs(Msg.Position),' ',Items[Msg.Position].Msg);
QuickFixItem.Execute(Msg,imqfoMenuItem);
UpdateMsgSrcPos(Msg);
UpdateMsgLineInListBox(Msg);
if Msg.Msg='' then begin
// messages fixed -> delete
DebugLn('TMessagesView.OnQuickFixClick ',dbgs(Msg.VisiblePosition),' ',dbgs(Msg.Position));
DeleteLine(Msg.Position);
end else begin
UpdateMsgSrcPos(Msg);
UpdateMsgLineInListBox(Msg);
end;
//ConsistencyCheck;
end;
end;
end;
@ -939,6 +952,29 @@ begin
Line.Node:=FSrcPositions.Add(Line);
end;
procedure TMessagesView.ConsistencyCheck;
var
i: Integer;
Line: TLazMessageLine;
begin
if FSrcPositions.ConsistencyCheck<>0 then
RaiseGDBException('TMessagesView.ConsistencyCheck FSrcPositions.ConsistencyCheck');
for i:=0 to FItems.Count-1 do begin
Line:=Items[i];
if Line.Position<>i then
RaiseGDBException('TMessagesView.ConsistencyCheck i='+dbgs(i)+' "'+Line.Msg+'" Position='+dbgs(Line.Position));
if (Line.VisiblePosition>=0) and (VisibleItems[Line.VisiblePosition]<>Line) then
RaiseGDBException('TMessagesView.ConsistencyCheck i='+dbgs(i)+' "'+Line.Msg+'" VisiblePosition='+dbgs(Line.VisiblePosition)+' '+VisibleItems[Line.VisiblePosition].Msg);
if (Line.VisiblePosition>=0) and (MessageListBox.Items[Line.VisiblePosition]<>Line.Msg) then
RaiseGDBException('TMessagesView.ConsistencyCheck i='+dbgs(i)+' "'+Line.Msg+'" VisiblePosition='+dbgs(Line.VisiblePosition)+' Listbox="'+MessageListBox.Items[Line.VisiblePosition]+'"');
end;
for i:=0 to FVisibleItems.Count-1 do begin
Line:=VisibleItems[i];
if (Line.VisiblePosition<>i) then
RaiseGDBException('TMessagesView.ConsistencyCheck Visible i='+dbgs(i)+' "'+Line.Msg+'" VisiblePosition='+dbgs(Line.VisiblePosition));
end;
end;
function TMessagesView.FindNextItem(const Filename: string; FirstLine,
LineCount: integer): TAVLTreeNode;
var

4
ide/newdialog.pas
View File

@ -142,8 +142,8 @@ type
TNewOtherDialog = class(TForm)
DescriptionGroupBox: TGroupBox;
DescriptionLabel: TLabel;
OkButton: TButton;
CancelButton: TButton;
OkButton: TButton;
CancelButton: TButton;
ItemsTreeView: TTreeView;
procedure ItemsTreeViewClick(Sender: TObject);
procedure ItemsTreeViewSelectionChanged(Sender: TObject);