⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umfgeneratemessages_kyl.pas

📁 DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen
💻 PAS
📖 第 1 页 / 共 3 页
字号:
 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 + -