ugenerationmessages.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

   { * * *  ***  * * *  ***   TMessageDescriptions   ***  * * *  ***  * * *  }



{Creates the list of messages and saves their desriptions.
~param Descriptions the list of description of messages to manage
~param Title        a short title/description of the messages; it is also an
                    identification and must not contain white spaces }
constructor TMessageDescriptions.Create(const Descriptions: array of
                                                          TMessageDescription;
                                        const Title: String);
var         i                   :TMessageNumber; //counter through descriptions
begin
 inherited Create;                                   //create the object

 SetLength(FDescriptions, Length(Descriptions));
 for i := Low(Descriptions) to High(Descriptions) do //copy all descriptions
  FDescriptions[i] := Descriptions[i];

 FTitle := Title;                                    //save the title
end;

{Returns the number of messages with this ID.
~result the number of messages }
function TMessageDescriptions.GetCount: TMessageNumber;
begin
 Result := Length(FDescriptions);
end;

{Returns a description of a message.
~param Index the index of the message to return a description about
~result the description of a message with that number }
function TMessageDescriptions.GetDescription(Index: TMessageNumber):
                                                           TMessageDescription;
begin
 assert(Index >= 0);
 assert(Index < Length(FDescriptions));
 Result := FDescriptions[Index];
end;







   { * * *  ***  * * *  ***   TGeneratorMessageList   ***  * * *  ***  * * *  }

//a list of messages

{$INCLUDE ..\..\General\Templates\ListTemplate.inc}














   { * * *  ***  * * *  ***   TMessageFilter   ***  * * *  ***  * * *  }



{Creates the object and the list containing the filter. }
constructor TMessageFilter.Create;
begin
 inherited Create;                        //create object

 FFilter := TStringList.Create;           //create list of sets/groups
 FFilter.Sorted := True;                  //sort for faster access (by title)
 FFilter.Duplicates := dupError;
end;

{Frees the object and the list containing the filter. }
destructor TMessageFilter.Destroy;
var        i             :Integer;        //counter through all sets/groups
begin
 if assigned(FFilter) then                //list of sets/groups exists?
  begin
   for i := 0 to FFilter.Count - 1 do       //free filters for all sets/groups
    FFilter.Objects[i].Free;
   FFilter.Free;                            //free the list
  end;

 inherited Destroy;                       //free the object
end;




{Returns whether all or some of the messages in the list are filtered.
~param Desc the list of all currently possible messages
~result whether some of all of the messages are filtered }
function TMessageFilter.GetDescFiltered(const Desc: TMessageDescriptionsList):
                                                          TMessageFilterStatus;
var      States        :set of TMessageFilterStatus; //states of all sets
         i             :Integer;                     //counter through sets
begin
 States := [];                                       //no set/group tested
 i := Length(Desc) - 1;                              //for each set/group
 while (i >= 1) and
       not (mfsSomeFiltered in States) and            //so long as state not
       ([mfsFiltered, mfsNotFiltered] * States <>     //found
        [mfsFiltered, mfsNotFiltered]) do
  if assigned(Desc[i]) then                            //valid set/group?
   begin
    Include(States, AllFiltered[Desc[i].Title]);         //check set/group
    dec(i);                                              //next set/group
   end;

 if mfsSomeFiltered in States then                   //only some are filtered?
  Result := mfsSomeFiltered                            //so be it
 else
  if mfsFiltered in States then                        //some are filtered?
   if mfsNotFiltered in States then                      //and some aren't?
    Result := mfsSomeFiltered                              //only some
   else
    Result := mfsFiltered                                  //all filtered
  else
   //this is also the case if no messages have been registered!
   Result := mfsNotFiltered;                             //only some filtered
end;

{Sets whether all or none of the messages in the list are filtered.
~param Desc  the list of all currently possible
~param Value whether some of all of the messages are filtered, ignored if
             ~[link mfsSomeFiltered] }
procedure TMessageFilter.SetDescFiltered(const Desc: TMessageDescriptionsList;
                                         Value: TMessageFilterStatus);
var       i             :Integer;        //counter through all sets/groups
begin
 if Value <> mfsSomeFiltered then        //real filter state to set?
  for i := 1 to Length(Desc) - 1 do        //for each set/group
   if assigned(Desc[i]) then                 //if valid
    AllFiltered[Desc[i].Title] := Value;       //set the filter state
end;

{Returns whether all or some of the messages in the group/set are filtered.
~param Name the name of a set/group of messages
~result whether some of all of the messages are filtered }
function TMessageFilter.GetAllFiltered(const Name: String):
                                                          TMessageFilterStatus;
var      Index         :Integer;          //index of the set/group
         Filter        :TBits;            //the filter of the set/group
         Filtered      :set of Boolean;   //filter states of all messages
         i             :Integer;          //counter through filter of set/group
begin
 Result := mfsNotFiltered;                //assume not filtered
 Index := FFilter.IndexOf(Name);
 if Index <> -1 then                      //filter for set/group specified?
  begin
   Filter := TBits(FFilter.Objects[index]); //get the filter
   Filtered := [];                          //no message checked so far
   for i := 0 to Filter.Size - 1 do         //for each message
    Include(Filtered, Filter[i]);             //check whether it is filtered

   if Filtered = [True] then                //all messages are filtered?
    Result := mfsFiltered
   else
    if Filtered = [True, False] then        //some are filtered, some aren't?
     Result := mfsSomeFiltered;
  end;
end;

{Sets whether all or none of the messages in the group/set are filtered.
~param Name the name of a set/group of messages
~param Value whether some of all of the messages are filtered, ignored if
             ~[link mfsSomeFiltered] }
procedure TMessageFilter.SetAllFiltered(const Name: String;
                                        Value: TMessageFilterStatus);
var       Index         :Integer;       //index of the set/group
          Filter        :TBits;         //the filter of the set/group
          Filtered      :Boolean;       //filter state to be set
          i             :Integer;       //counter through filter of set/group
begin
 if Value <> mfsSomeFiltered then       //real filter state to set?
  begin
   Index := FFilter.IndexOf(Name);        //search the filter
   if Index <> -1 then                    //filter already specified?
    Filter := TBits(FFilter.Objects[Index]) //get the filter
   else
    begin
     Filter := TBits.Create;                //create a new filter
     try
      FFilter.AddObject(Name, Filter);      //and register it
     except
      Filter.Free;
      raise;
     end;
    end;

   Filtered := Value = mfsFiltered;       //filter or not
   for i := 0 to Filter.Size - 1 do       //for each messages
    Filter[i] := Filtered;                  //set whether it is filtered
  end;
end;

{Returns whether the specified message is filtered.
~param Name the name of a set/group of messages
~param ID   index of the messages in the set/group
~result whether the message is filtered }
function TMessageFilter.GetIsFiltered(const Name: String;
                                      ID: Integer): Boolean;
var      Index         :Integer;           //index of the set/group of messages
         Filter        :TBits;             //the filter for the set/group
begin
 Index := FFilter.IndexOf(Name);           //search the set/group
 if Index <> -1 then                       //filter already created?
  begin
   Filter := TBits(FFilter.Objects[Index]);  //get the filter
   if ID >= Filter.Size then                 //message not yet in filter?
    Filter.Size := ID + 1;                     //expand it (and don't filter)
   Result := Filter[ID];                     //return whether it is filtered
  end
 else
  Result := False;                           //message not filtered
end;

{Sets whether the specified message is filtered.
~param Name  the name of a set/group of messages
~param ID    index of the messages in the set/group
~param Value whether the message is filtered }
procedure TMessageFilter.SetIsFiltered(const Name: String; ID: Integer;
                                       Value: Boolean);
var      Index         :Integer;        //index of the set/group of messages
         Filter        :TBits;          //the filter for the set/group
begin
 Index := FFilter.IndexOf(Name);        //search the set/group of messages
 if Index <> -1 then                    //filter already specified?
  Filter := TBits(FFilter.Objects[Index]) //get the filter
 else
  begin
   Filter := TBits.Create;                //create a new filter
   try
    FFilter.AddObject(Name, Filter);      //and register it
   except
    Filter.Free;
    raise;
   end;
  end;

 if ID >= Filter.Size then              //message not yet in filter?
  Filter.Size := ID + 1;                  //expand filter (and don't filter)
 Filter[ID] := Value;                   //set whether the message is filtered
end;



{Loads the filter from the ini file.
~param Ini the ini file to load the filter from }
procedure TMessageFilter.LoadFromIni(Ini: TCustomIniFile);
var       Groups        :TStringList;       //list of all sets/groups to read
          i             :Integer;           //counter through all sets/groups
          Group         :String;            //name of each set/group
begin
 assert(FFilter.Count = 0);

 Groups := TStringList.Create;              //create list of sets/groups
 try
   Ini.ReadSection(ClassName, Groups);      //read the list of all sets//groups

   for i := 0 to Groups.Count - 1 do        //for each set/group
    begin
     Group := Groups[i];                    //get name of the set/group
     //and string of bit values and assign it to the filter
     SetFilterForGroup(Group, Ini.ReadString(ClassName, Group, ''));
    end;
 finally
  Groups.Free;                              //free the list
 end;
end;

{Saves the filter to the ini file.
~param Ini the ini file to save the filter to }
procedure TMessageFilter.SaveToIni(Ini: TCustomIniFile);
var       i             :Integer;           //counter through all sets/groups
          Filter        :TBits;             //the filter for the set/group
          Value         :String;            //the value to save
          j             :Integer;           //counter through message IDs
begin
 Ini.EraseSection(ClassName);               //delete old filter

 for i := 0 to FFilter.Count - 1 do         //for each set/group
  begin
   Filter := TBits(FFilter.Objects[i]);       //get the filter

   SetLength(Value, Filter.Size);
   for j := 0 to Filter.Size - 1 do           //get string of boolean values
    Value[1 + j] := Char(ord('0') + ord(Filter[j]));

   Ini.WriteString(ClassName, FFilter[i], Value);  //save bit-stream as string
  end;
end;

{Sets the filter for a group by a bitmask in a string ('0' or '1').
~param Group   the name of a set/group of messages
~param BitMask a string of characters for each messages,
               1 = filtered, everything else not }
procedure TMessageFilter.SetFilterForGroup(const Group, BitMask: String);
var       i             :Integer;               //counter through message IDs
begin
 for i := 1 to Length(BitMask) do               //for the whole bit-stream
  IsFiltered[Group, i - 1] := BitMask[i] = '1';   //assign whether filtered
end;


{Clears the whole filter. The difference between this and
 ~[code ~[link DescFiltered][..] := mfsNotFiltered;] is that the whole filter
 is reset, clearing the filter even for messages that are currently not used. }
procedure TMessageFilter.ClearFilter;
var       i             :Integer;     //counter through sets/groups of messages
begin
 for i := 0 to FFilter.Count - 1 do   //free filter for all sets/groups
  FFilter.Objects[i].Free;
 FFilter.Clear;                       //and clear the list
end;


end.