Skip to content

Commit

Permalink
Merge pull request #243 from MerlijnWajer/LapeFLFix
Browse files Browse the repository at this point in the history 
Simba: CodeInsight and Function List update.
  • Loading branch information
@JohnPeel
JohnPeel committed Sep 27, 2013
2 parents de0b8ba + 00e3424 commit 7899f92
Show file tree
Hide file tree
Showing 6 changed files with 170 additions and 61 deletions.
98 changes: 85 additions & 13 deletions Projects/Simba/framefunctionlist.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -549,18 +549,48 @@ procedure TFunctionListFrame.Terminate;
procedure TFillThread.Update;
procedure AddProcsTree(Node: TTreeNode; Procs: TDeclarationList; Path: string);
procedure ProcessProcedure(Node: TTreeNode; Proc: TciProcedureDeclaration);
function findNodeStartingWith(Node: TTreeNode; x: string): TTreeNode;
var
x_len: LongInt;
begin
x_len := Length(x);

Result := Node.GetFirstChild();
while (Result <> nil) and (Copy(Result.Text, 1, x_len) <> x) do
Result := Result.GetNextSibling();
end;
var
tmpNode: TTreeNode;
Name, FirstLine: string;
Index: LongInt;
ClassName: TDeclaration;
begin
if (Assigned(Proc.Name)) then
begin
Name := Proc.Name.ShortText + '; ';

ClassName := Proc.Items.GetFirstItemOfClass(TciProcedureClassName);
if (Assigned(ClassName)) then
begin
tmpNode := findNodeStartingWith(Node, ClassName.ShortText + ' =');
if (tmpNode = nil) then
tmpNode := findNodeStartingWith(Node, ClassName.ShortText);

if (tmpNode = nil) then
begin
tmpNode := Node.TreeNodes.AddChild(Node, ClassName.CleanText);
tmpNode.ImageIndex := 36;
tmpNode.SelectedIndex := 36;
end;

Node := tmpNode;
end;

FirstLine := Lowercase(Proc.CleanText);
if (Pos(#10, FirstLine) > 0) then
FirstLine := Copy(FirstLine, 1, Pos(#10, FirstLine) - 1);

Index := Pos(#13, FirstLine);
if (Index > 0) then
FirstLine := Copy(FirstLine, 1, Index - 1);

Index := Node.IndexOfText(Trim(Name));
if (Index = -1) then
Expand Down Expand Up @@ -594,27 +624,68 @@ procedure TFillThread.Update;
end;
end;
procedure ProcessDecl(Node: TTreeNode; Decl: TDeclaration);
function getVarName(Decl: TDeclaration): string;
begin
case Decl.ClassName of
'TciVarDeclaration': Result := Decl.Items.GetFirstItemOfClass(TciVarName).ShortText;
'TciConstantDeclaration': Result := Decl.Items.GetFirstItemOfClass(TciConstantName).ShortText;
'TciClassField': Result := Decl.Items.GetFirstItemOfClass(TciFieldName).ShortText;
end;
end;
var
tmpNode: TTreeNode;
begin
tmpNode := Node.TreeNodes.AddChild(Node, Decl.CleanText);
tmpNode := Node.TreeNodes.AddChild(Node, Trim(Decl.CleanText));
tmpNode.Data := GetMem(SizeOf(TMethodInfo));

if (Decl is TciConstantDeclaration) then tmpNode.ImageIndex := 33;
if (Decl is TciTypeDeclaration) then tmpNode.ImageIndex := 36;
if (Decl is TciVarDeclaration) then tmpNode.ImageIndex := 37;
if (Decl is TciVarDeclaration) or (Decl is TciClassField) then tmpNode.ImageIndex := 37;
tmpNode.SelectedIndex := tmpNode.ImageIndex;

FillChar(PMethodInfo(tmpNode.Data)^, SizeOf(TMethodInfo), 0);

with PMethodInfo(tmpNode.Data)^ do
begin
MethodStr := strnew(Pchar(Decl.CleanText));
Filename := strnew(pchar(Path));
BeginPos := Decl.StartPos;
EndPos := Decl.StartPos + Length(TrimRight(Decl.RawText));
end;
with PMethodInfo(tmpNode.Data)^ do
begin
MethodStr := strnew(Pchar(getVarName(Decl)));
Filename := strnew(pchar(Path));
BeginPos := Decl.StartPos;
EndPos := Decl.StartPos + Length(TrimRight(Decl.RawText));
end;
end;
procedure ProcessType(Node: TTreeNode; Decl: TciTypeDeclaration);
var
tmpNode: TTreeNode;
TypeKind: TciTypeKind;
TypeName: TciTypeName;
Index: LongInt;
begin
TypeKind := TciTypeKind(Decl.Items.GetFirstItemOfClass(TciTypeKind));
TypeName := TciTypeName(Decl.Items.GetFirstItemOfClass(TciTypeName));

case TypeKind.ShortText of
'record', 'union': tmpNode := Node.TreeNodes.AddChild(Node, Trim(TypeName.CleanText) + ' = ' + TypeKind.GetRealType.ShortText);
else
tmpNode := Node.TreeNodes.AddChild(Node, Trim(Decl.CleanText));
end;

tmpNode.ImageIndex := 36;
tmpNode.SelectedIndex := 36;
tmpNode.Data := GetMem(SizeOf(TMethodInfo));
FillChar(PMethodInfo(tmpNode.Data)^, SizeOf(TMethodInfo), 0);

with PMethodInfo(tmpNode.Data)^ do
begin
MethodStr := strnew(Pchar(Decl.CleanText));
Filename := strnew(pchar(Path));
BeginPos := Decl.StartPos;
EndPos := Decl.StartPos + Length(TrimRight(Decl.RawText));
end;

if (TypeKind.ShortText = 'record') or (TypeKind.ShortText = 'union') then
for Index := 0 to TypeKind.GetRealType.Items.Count - 1 do
ProcessDecl(tmpNode, TypeKind.GetRealType.Items[Index]);
end;

var
I: integer;
begin;
Expand All @@ -625,7 +696,8 @@ procedure TFillThread.Update;
if (Assigned(Procs[I])) then
case Procs[I].ClassName of
'TciProcedureDeclaration': ProcessProcedure(Node, Procs[I] as TciProcedureDeclaration);
'TciVarDeclaration', 'TciTypeDeclaration', 'TciConstantDeclaration': ProcessDecl(Node, Procs[I] as TDeclaration);
'TciVarDeclaration', 'TciConstantDeclaration': ProcessDecl(Node, Procs[I] as TDeclaration);
'TciTypeDeclaration': ProcessType(Node, Procs[I] as TciTypeDeclaration);
'TciJunk', 'TciInclude', 'TciCompoundStatement': ;
else
WriteLn('Unknown Class: ', Procs[I].ClassName);
Expand Down
4 changes: 2 additions & 2 deletions Projects/Simba/simbaunit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3131,7 +3131,7 @@ function GetMethodName(Decl: string; PlusNextChar: boolean) : string;
for Index := I to Length(decl) do
case Decl[Index] of
'(', ';', ':': begin
if (PlusNextChar) then
if (PlusNextChar) and (I > 1) then
begin
Result += '(';
if (Decl[Index] = ';') or (Decl[Index] = ':') then //There are no parameters..
Expand All @@ -3145,7 +3145,7 @@ function GetMethodName(Decl: string; PlusNextChar: boolean) : string;
Result += Decl[Index];
end;

if (PlusNextChar) then
if (PlusNextChar) and (I > 1) then
Result += '(';
end;

Expand Down
1 change: 1 addition & 0 deletions Units/Misc/CastaliaPasLex.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1015,6 +1015,7 @@ function TmwBasePasLex.Func73: TptTokenKind;
begin
Result := tokIdentifier;
if KeyComp('Except') then Result := tokExcept;
if KeyComp('Union') then Result := tokUnion;
end;

function TmwBasePasLex.Func75: TptTokenKind;
Expand Down
1 change: 1 addition & 0 deletions Units/Misc/CastaliaPasLexTypes.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -200,6 +200,7 @@ interface
tokReal,
tokReal48,
tokRecord,
tokUnion,
{$IFDEF D12_NEWER}
tokReference, //JThurman 2008-25-07 (anonymous methods)
{$ENDIF}
Expand Down
72 changes: 36 additions & 36 deletions Units/Misc/CastaliaSimplePasPar.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -391,6 +391,7 @@ TmwSimplePasPar = class(TObject)
procedure RecordConstant; virtual;
procedure RecordFieldConstant; virtual;
procedure RecordType; virtual;
procedure UnionType; virtual;
procedure RecordVariant; virtual;
procedure RelativeOperator; virtual;
procedure RepeatStatement; virtual;
Expand Down Expand Up @@ -452,6 +453,7 @@ TmwSimplePasPar = class(TObject)
procedure UsesClause; virtual;
procedure VarAbsolute; virtual;
procedure VarEqual; virtual;
procedure VarAssign; virtual;
procedure VarDeclaration; virtual;
procedure Variable; virtual;
procedure VariableList; virtual;
Expand Down Expand Up @@ -1606,10 +1608,10 @@ procedure TmwSimplePasPar.ResolutionInterfaceName;

procedure TmwSimplePasPar.Constraint;
begin
while TokenId in [tokConstructor, tokRecord, tokClass, tokIdentifier] do
while TokenId in [tokConstructor, tokRecord, tokUnion, tokClass, tokIdentifier] do
begin
case TokenId of
tokConstructor, tokRecord, tokClass: NextToken;
tokConstructor, tokRecord, tokUnion, tokClass: NextToken;
tokIdentifier: TypeId;
end;
if TokenId = tokComma then
Expand Down Expand Up @@ -2777,7 +2779,7 @@ procedure TmwSimplePasPar.QualifiedIdentifier;
tokImplementation, tokIn, tokInherited, tokInitialization, tokInline,
tokInterface, tokIs, tokLabel, tokLibrary, tokMod, tokNil, tokNot, tokObject,
tokOf, tokOr, tokOut, tokPacked, tokProcedure, tokProgram, tokProperty,
tokRaise, tokRecord, tokRepeat, tokResourceString, tokSealed, tokSet,
tokRaise, tokRecord, tokUnion, tokRepeat, tokResourceString, tokSealed, tokSet,
tokShl, tokShr, tokStatic, tokString, tokThen, tokThreadVar, tokTo, tokTry,
tokType, tokUnit, tokUnsafe, tokUntil, tokUses, tokVar, tokWhile, tokWith,
tokXor] then
Expand Down Expand Up @@ -3114,14 +3116,9 @@ procedure TmwSimplePasPar.VarDeclaration;
tokPlatform: DirectivePlatform;
end;
case GenID of
tokAbsolute:
begin
VarAbsolute;
end;
tokEqual:
begin
VarEqual;
end;
tokAbsolute: VarAbsolute;
tokEqual: VarEqual;
tokAssign: VarAssign;
end;
while ExID in [tokDeprecated, tokLibrary, tokPlatform] do // DR 2001-10-20
case ExID of
Expand All @@ -3143,6 +3140,12 @@ procedure TmwSimplePasPar.VarEqual;
ConstantValueTyped;
end;

procedure TmwSimplePasPar.VarAssign;
begin
Expected(tokAssign);
ConstantValueTyped;
end;

procedure TmwSimplePasPar.VarNameList;
begin
VarName;
Expand Down Expand Up @@ -3289,19 +3292,30 @@ procedure TmwSimplePasPar.FieldNameList;
procedure TmwSimplePasPar.RecordType;
begin
Expected(tokRecord);

if TokenID = tokSemicolon then
Exit;
{$IFDEF D8_NEWER1}

if TokenID = tokRoundOpen then
begin
ClassHeritage;
if TokenID = tokSemicolon then
Exit;
end;
ClassMemberList;
{$ELSE}

Expected(tokEnd);
end;

procedure TmwSimplePasPar.UnionType;
begin
Expected(tokUnion);

if TokenID = tokSemicolon then
Exit;

FieldList;
{$ENDIF}

Expected(tokEnd);
end;

Expand Down Expand Up @@ -4313,30 +4327,16 @@ procedure TmwSimplePasPar.PointerType;
procedure TmwSimplePasPar.StructuredType;
begin
if TokenID = tokPacked then
begin
NextToken;
end;

case TokenID of
tokArray:
begin
ArrayType;
end;
tokFile:
begin
FileType;
end;
tokRecord:
begin
RecordType;
end;
tokSet:
begin
SetType;
end;
tokArray: ArrayType;
tokFile: FileType;
tokRecord: RecordType;
tokUnion: UnionType;
tokSet: SetType;
else
begin
SynError(InvalidStructuredType);
end;
SynError(InvalidStructuredType);
end;
end;

Expand Down Expand Up @@ -4560,7 +4560,7 @@ procedure TmwSimplePasPar.TypeKind;
begin
SimpleType;
end;
tokArray, tokFile, tokPacked, tokRecord, tokSet:
tokArray, tokFile, tokPacked, tokRecord, tokUnion, tokSet:
begin
StructuredType;
end;
Expand Down
Loading

0 comments on commit 7899f92

Please sign in to comment.