📄 umfgeneratemessages_kyl.pas
字号:
freed).
~param NewFrameClass the class of the frame that should replace this one
~param IsNext if the next frame should be shown (instead of the previous
one) in some kind of an order }
procedure TMFGenerateMessagesKylix.SelectNextFrame(
var NewFrameClass: TMainFormFrameClass; IsNext: Boolean);
begin
//if the previous page should be shown and the status text is empty
if not IsNext and (State.Generate.GetGenerateStatusText = '') then
NewFrameClass := TMFGenerate; //skip that page
end;
{Called when the generator changes.
~param State the state that has been changed }
procedure TMFGenerateMessagesKylix.StateGeneratorChanged(State: TJADDState);
begin
ShowMessages; //show the messages
end;
{Shows the messages filtered and sorted as specified in the GUI. }
procedure TMFGenerateMessagesKylix.ShowMessages;
//how to sort the list of messages
var SortOrder: TMessageSortOrder;
type THeapDataItem = record //data in the tree
Message: TGeneratorMessage; //message to be sorted
Index: Integer; //index of message
end;
PSortTree = ^TSortTree; //the tree of the items of the list
//an item in the tree
TSortTree = record
Left: PSortTree; //one side of the tree
Right: PSortTree; //the other side of the tree
Data: THeapDataItem; //the data of the node
end;
//Compares to items of the heap.
function Compare(const M1, M2: THeapDataItem): Integer; forward;
//Merges/Joins two parts of a heap/one element with the heap recursively.
function MergeHeaps(H1, H2: PSortTree): PSortTree; forward;
//Inserts an element into the heap.
function InsertElem(const Message: TGeneratorMessage; Index: Integer;
Heap: PSortTree): PSortTree; forward;
//Returns the minimum item from the tree and removes it from it.
function GetDeleteMinElem(Heap: PSortTree;
var Data: THeapDataItem): PSortTree; forward;
//Returns the caption of a message to be added to the list.
function GetMessageCaption(const Message: TGeneratorMessage): String; forward;
{Compares to items of the heap.
~param M1, M2 the items to be compares
~result the relation between the items, either equal zero, or less or more }
function Compare(const M1, M2: THeapDataItem): Integer;
{Compares the position of the two items.
~result the relation between the items, either equal zero, or less or more }
function ComparePos(const P1, P2: TDocumentationPosition): Integer;
{Compares two identifiers, making sure they are on the same level.
~param Ident1, Ident2 the identifiers to compare
~param ToIdent1, ToIdent2 the most top-level identifiers already compared
~result the relation between the identifiers, either equal zero, or less or
more }
function CompareMembers(Ident1, Ident2: TIdentifier;
ToIdent1, ToIdent2: TIdentifier): Integer;
var I1, I2 :TIdentifier; //the members to compare
begin
I1 := Ident1;
while I1.MemberOf <> ToIdent1 do //get the next-level member
I1 := I1.MemberOf;
I2 := Ident2;
while I2.MemberOf <> ToIdent2 do //get the next-level member
I2 := I2.MemberOf;
Result := CompareText(I1.Name, I2.Name); //compare them
if Result = 0 then //same?
begin
Result := Ord(I1 = Ident1) - Ord(I2 = Ident2); //are members?
if (Result = 0) and (I1 <> Ident1) then //both members?
Result := CompareMembers(Ident1, Ident2, I1, I2); //compare members
end;
end;
var F1, F2 :TPascalFile; //the file the messages was generated in
begin
Result := Ord(assigned(P2.TheFile) or assigned(P2.Identifier)) -
Ord(assigned(P1.TheFile) or assigned(P1.Identifier));
//both messages are in source files?
if (Result = 0) and (assigned(P1.TheFile) or assigned(P1.Identifier)) then
begin
if assigned(P1.Identifier) then //get the first file
F1 := P1.Identifier.InFile
else
F1 := P1.TheFile;
if assigned(P2.Identifier) then //and the second file
F2 := P2.Identifier.InFile
else
F2 := P2.TheFile;
Result := CompareText(F1.InternalFileName, F2.InternalFileName);
if Result = 0 then //files with the same name?
if F1 <> F2 then //same name but different files?
Result := CompareText(F1.FilePath, F2.FilePath) //compare paths
else
begin
//message is for identifiers?
Result := Ord(assigned(P1.Identifier)) - Ord(assigned(P2.Identifier));
if Result = 0 then
if assigned(P1.Identifier) then //both messages for identifiers?
begin //compare them
Result := CompareMembers(P1.Identifier, P2.Identifier, nil, nil);
if Result = 0 then //both are the same?
Result := P1.Identifier.InternalNameIndex - //check for overloaded
P2.Identifier.InternalNameIndex; //functions
end
else
begin //compare position line
Result := P1.Position.Row - P2.Position.Row;
if Result = 0 then //both are in the same line?
Result := P1.Position.Column - P2.Position.Column; //check columns
end;
end;
end;
if Result = 0 then //not in source files?
begin //maybe in user documentation?
Result := Ord(P2.UserDocFile <> '') - Ord(P1.UserDocFile <> '');
if (Result = 0) and (P1.UserDocFile <> '') then //in user documentation?
begin
Result := CompareText(P1.UserDocFile, P2.UserDocFile); //compare files
if Result = 0 then //same files?
Result := CompareText(P1.UserDocPage, P2.UserDocPage); //then pages
end;
end;
if Result = 0 then //should be in help of GUI
begin //maybe in help for GUI?
Result := Ord(P2.GUIPageFile <> '') - Ord(P1.GUIPageFile <> '');
if (Result = 0) and (P1.GUIPageFile <> '') then //in help of GUI?
begin
Result := CompareText(P1.GUIPageFile, P2.GUIPageFile); //compare forms
if Result = 0 then //same forms?
Result := CompareText(P1.GUIPageTopic, P2.GUIPageTopic); //components!
end;
end;
end;
{Compares the message kinds of the two items.
~result the relation between the items, either equal zero, or less or more }
function CompareMsg: Integer;
begin
Result := M1.Message.MessageID - M2.Message.MessageID; //compare set
if Result = 0 then //both are from the same set of messages?
//compare the number of the messages in the set
Result := M1.Message.MessageNumber - M2.Message.MessageNumber;
end;
begin
case SortOrder of //compare depending on sort order
msoIndex: begin //show in the same order as generated
Result := M1.Index - M2.Index;
end;
msoPosition: begin //order by their positions
Result := ComparePos(M1.Message.Position, //compare
M2.Message.Position); //positions
if Result = 0 then //same position?
begin
Result := CompareMsg; //compare messages
if Result = 0 then //same message?
Result := M1.Index - M2.Index; //use generation order
end;
end;
msoMessageNumber: begin //order by their kinds
Result := CompareMsg; //compare messages
if Result = 0 then //same message?
begin //compare positions
Result := ComparePos(M1.Message.Position,
M2.Message.Position);
if Result = 0 then //same position?
Result := M1.Index - M2.Index; //use generation order
end;
end;
else
assert(False);
Result := 0;
end;
end;
{Merges/Joins two parts of a heap/one element with the heap recursively.
~param H1, H2 the two heaps to merge
~result the resulting merged heap }
function MergeHeaps(H1, H2: PSortTree): PSortTree;
{Merges/Joins two parts of a heap/one element with the heap recursively.
~param H1, H2 the two heaps to join (both non nil and H1 smaller than H2)
~result the resulting merged heap }
function JoinHeaps(H1, H2: PSortTree): PSortTree;
var Temp :PSortTree; //one part of the heap
begin
Temp := H1.Right;
H1.Right := MergeHeaps(H1.Left, H2); //merge bigger heap with left part
H1.Left := Temp; //swap both sides, so next times it
Result := H1; //will be merged with right part
end;
begin
if assigned(H1) then //if one of the heaps is nil, just
if assigned(H2) then //return the other one
if Compare(H1.Data, H2.Data) <= 0 then //else
Result := JoinHeaps(H1, H2) //join both parts, the bigger
else
Result := JoinHeaps(H2, H1) //heap below the smaller one
else
Result := H1
else
Result := H2;
end;
{Inserts an element into the heap.
~param Message the message to be inserted
~param Index the index of the message
~param Heap the heap to insert the item into
~result the heap with the new item }
function InsertElem(const Message: TGeneratorMessage; Index: Integer;
Heap: PSortTree): PSortTree;
begin
New(Result); //create new item
Result.Left := nil; //only one item in this "heap"
Result.Right := nil;
Result.Data.Message := Message; //save data of item
Result.Data.Index := Index;
Result := MergeHeaps(Result, Heap); //now "merge" with the heap
end;
{Returns the minimum item from the tree and removes it from it.
~param Heap the heap to return and remove the minimum item from
~param Data out: the data of the minimum item
~result the resulting heap without the minimum item }
function GetDeleteMinElem(Heap: PSortTree;
var Data: THeapDataItem): PSortTree;
begin
Result := MergeHeaps(Heap.Left, Heap.Right); //remove minimum item from heap
Data := Heap.Data; //return its data
Dispose(Heap); //and free item
end;
{Returns the caption of a message to be added to the list.
~param Message the message to add to the list
~param Seriousness the seriousness of the message
~result the caption of the message for the list }
function GetMessageCaption(const Message: TGeneratorMessage): String;
var HasPos :Boolean; //if position of the message is known
begin
Result := MessageSeriousnesses[State.GenerationMessageDescriptions[
Message.MessageID][Message.MessageNumber].Seriousness] +
Format(': %d:%d: ', [Message.MessageID, Message.MessageNumber]);
HasPos := True; //assume position of message is known
if assigned(Message.Position.Identifier) then
begin
Result := Result +
Message.Position.Identifier.InFile.InternalFileName + '.';
if assigned(Message.Position.Identifier.MemberOf) then
Result := Result + Message.Position.Identifier.MemberOf.Name + '.';
Result := Result + Message.Position.Identifier.Name;
end
else
if assigned(Message.Position.TheFile) then
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -