Back to...

   1  ------------------------------------------------------------------------------
   2  --  File:            Dual_IO.ads
   3  --  Description:     Dual_IO : clones the Text_IO I/O functions towards
   4  --                   Standard I/O but also outputs these I/O to a log file.
   5  --
   6  --  NB:  1) Use Create_Log and Close_Log to create and close a log file.
   7  --       2) Generic Integer_IO, Float_IO, ... are of course also present.
   8  --       3) Only procedures for I/O to Standard device are kept, use the
   9  --          genuine Text_IO for Files and String I/O.
  10  --
  11  --
  12  --  Date/version:    7-Apr-2023; 2-Mar-2013; 2-Feb-2011; 4-Jul-2001
  13  --  Author:          G. de Montmollin
  14  --                   http://gautiersblog.blogspot.com/
  15  ------------------------------------------------------------------------------
  16  
  17  with Ada.IO_Exceptions, Ada.Text_IO;
  18  
  19  package Dual_IO is
  20  
  21     subtype Count is Ada.Text_IO.Count;
  22  
  23     subtype Positive_Count is Ada.Text_IO.Positive_Count;
  24  
  25     Unbounded : constant Count := Ada.Text_IO.Unbounded;
  26  
  27     subtype Field is Ada.Text_IO.Field;
  28  
  29     subtype Number_Base is Ada.Text_IO.Number_Base;
  30  
  31     subtype Type_Set is Ada.Text_IO.Type_Set;
  32  
  33     -------------------------
  34     -- Log file Management --
  35     -------------------------
  36  
  37     procedure Create_Log (Name : in String);
  38     procedure Append_Log (Name : in String);
  39     procedure Close_Log;
  40     function Is_Log_Open return Boolean;
  41  
  42     --  Close and reopen: have an up to date copy on file system
  43     procedure Close_and_Append_Log;
  44  
  45     --  Buffer control
  46     procedure Flush;
  47  
  48     --------------------------------------------
  49     -- Specification of line and page lengths --
  50     --------------------------------------------
  51  
  52     procedure Set_Line_Length (To : in Count) renames Ada.Text_IO.Set_Line_Length;
  53     procedure Set_Page_Length (To : in Count) renames Ada.Text_IO.Set_Page_Length;
  54     function Line_Length return Count renames Ada.Text_IO.Line_Length;
  55     function Page_Length return Count renames Ada.Text_IO.Page_Length;
  56  
  57     ------------------------------------
  58     -- Column, Line, and Page Control --
  59     ------------------------------------
  60  
  61     procedure New_Line (Spacing : in Positive_Count := 1);
  62     procedure Skip_Line (Spacing : in Positive_Count := 1);
  63     function End_Of_Line return Boolean renames Ada.Text_IO.End_Of_Line;
  64     procedure New_Page;
  65     procedure Skip_Page;
  66     function End_Of_Page return Boolean         renames Ada.Text_IO.End_Of_Page;
  67     function End_Of_File return Boolean         renames Ada.Text_IO.End_Of_File;
  68     procedure Set_Col (To : in Positive_Count)  renames Ada.Text_IO.Set_Col;
  69     procedure Set_Line (To : in Positive_Count) renames Ada.Text_IO.Set_Line;
  70     function Col return Positive_Count          renames Ada.Text_IO.Col;
  71     function Line return Positive_Count         renames Ada.Text_IO.Line;
  72     function Page return Positive_Count         renames Ada.Text_IO.Page;
  73  
  74     -----------------------------
  75     -- Characters Input-Output --
  76     -----------------------------
  77  
  78     procedure Get (Item : out Character);
  79     procedure Put (Item : in Character);
  80  
  81     procedure Look_Ahead (Item           : out Character;
  82                           Is_End_Of_Line : out Boolean)
  83        renames Ada.Text_IO.Look_Ahead;
  84  
  85     --  No echo -> not logged -> renames suffices
  86  
  87     procedure Get_Immediate (Item      : out Character)
  88        renames Ada.Text_IO.Get_Immediate;
  89  
  90     procedure Get_Immediate (Item      : out Character;
  91                              Available : out Boolean)
  92        renames Ada.Text_IO.Get_Immediate;
  93  
  94     --------------------------
  95     -- Strings Input-Output --
  96     --------------------------
  97  
  98     procedure Get (Item : out String);
  99     procedure Put (Item : in String);
 100  
 101     procedure Get_Line
 102       (Item : out String;
 103        Last : out Natural);
 104  
 105     procedure Put_Line
 106       (Item : in String);
 107  
 108     --  Generic package for Input-Output of Integer Types
 109  
 110     generic
 111        type Num is range <>;
 112     package Integer_IO is
 113  
 114        Default_Width : Field := Num'Width;
 115        Default_Base  : Number_Base := 10;
 116  
 117        procedure Get (Item  : out Num;
 118                       Width : in  Field := 0);
 119  
 120        procedure Put (Item  : in Num;
 121                       Width : in Field       := Default_Width;
 122                       Base  : in Number_Base := Default_Base);
 123  
 124     end Integer_IO;
 125  
 126     --  Generic package for Input-Output of Real Types
 127  
 128     generic
 129        type Num is digits <>;
 130     package Float_IO is
 131  
 132        Default_Fore : Field := 2;
 133        Default_Aft  : Field := Num'Digits - 1;
 134        Default_Exp  : Field := 3;
 135  
 136        procedure Get (Item  : out Num;
 137                       Width : in  Field := 0);
 138  
 139        procedure Put (Item : in Num;
 140                       Fore : in Field := Default_Fore;
 141                       Aft  : in Field := Default_Aft;
 142                       Exp  : in Field := Default_Exp);
 143     end Float_IO;
 144  
 145     generic
 146        type Num is delta <>;
 147     package Fixed_IO is
 148  
 149        Default_Fore : Field := Num'Fore;
 150        Default_Aft  : Field := Num'Aft;
 151        Default_Exp  : Field := 0;
 152  
 153        procedure Get (Item  : out Num;
 154                       Width : in  Field := 0);
 155  
 156        procedure Put (Item : in Num;
 157                       Fore : in Field := Default_Fore;
 158                       Aft  : in Field := Default_Aft;
 159                       Exp  : in Field := Default_Exp);
 160     end Fixed_IO;
 161  
 162     --  Generic package for Input-Output of Decimal Types
 163  
 164     generic
 165        type Num is delta <> digits <>;
 166  
 167     package Decimal_IO is
 168  
 169        Default_Fore : Field := Num'Fore;
 170        Default_Aft  : Field := Num'Aft;
 171        Default_Exp  : Field := 0;
 172  
 173        procedure Get
 174          (Item  : out Num;
 175           Width : in Field := 0);
 176  
 177        procedure Put
 178          (Item : in Num;
 179           Fore : in Field := Default_Fore;
 180           Aft  : in Field := Default_Aft;
 181           Exp  : in Field := Default_Exp);
 182  
 183     end Decimal_IO;
 184  
 185     --  Generic package for Input-Output of Modular Types
 186  
 187     generic
 188        type Num is mod <>;
 189  
 190     package Modular_IO is
 191  
 192        Default_Width : Field := Num'Width;
 193        Default_Base  : Number_Base := 10;
 194  
 195        procedure Get
 196          (Item  : out Num;
 197           Width : in Field := 0);
 198  
 199        procedure Put
 200          (Item  : in Num;
 201           Width : in Field       := Default_Width;
 202           Base  : in Number_Base := Default_Base);
 203  
 204     end Modular_IO;
 205     --  Generic package for Input-Output of Enumeration Types
 206  
 207     generic
 208        type Enum is (<>);
 209     package Enumeration_IO is
 210  
 211        Default_Width   : Field := 0;
 212        Default_Setting : Type_Set := Ada.Text_IO.Upper_Case;
 213  
 214        procedure Get (Item : out Enum);
 215  
 216        procedure Put (Item  : in Enum;
 217                       Width : in Field    := Default_Width;
 218                       Set   : in Type_Set := Default_Setting);
 219     end Enumeration_IO;
 220  
 221     --  Exceptions
 222  
 223     Status_Error : exception renames Ada.IO_Exceptions.Status_Error;
 224     Mode_Error   : exception renames Ada.IO_Exceptions.Mode_Error;
 225     Name_Error   : exception renames Ada.IO_Exceptions.Name_Error;
 226     Use_Error    : exception renames Ada.IO_Exceptions.Use_Error;
 227     Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
 228     End_Error    : exception renames Ada.IO_Exceptions.End_Error;
 229     Data_Error   : exception renames Ada.IO_Exceptions.Data_Error;
 230     Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error;
 231  
 232     Log_not_open     : exception;
 233     Log_already_open : exception;
 234  
 235  end Dual_IO;