gcc/ada/g-catiio.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                G N A T . C A L E N D A R . T I M E _ I O                 --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --            Copyright (C) 1999-2001 Ada Core Technologies, Inc.           --
  10 --                                                                          --
  11 -- This specification is derived from the Ada Reference Manual for use with --
  12 -- GNAT. The copyright notice above, and the license provisions that follow --
  13 -- apply solely to the  contents of the part following the private keyword. --
  14 --                                                                          --
  15 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  16 -- terms of the  GNU General Public License as published  by the Free Soft- --
  17 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  18 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  19 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  20 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  21 -- for  more details.  You should have  received  a copy of the GNU General --
  22 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  23 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  24 -- MA 02111-1307, USA.                                                      --
  25 --                                                                          --
  26 -- As a special exception,  if other files  instantiate  generics from this --
  27 -- unit, or you link  this unit with other files  to produce an executable, --
  28 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  29 -- covered  by the  GNU  General  Public  License.  This exception does not --
  30 -- however invalidate  any other reasons why  the executable file  might be --
  31 -- covered by the  GNU Public License.                                      --
  32 --                                                                          --
  33 -- GNAT was originally developed  by the GNAT team at  New York University. --
  34 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  35 --                                                                          --
  36 ------------------------------------------------------------------------------
  37
  38 with Ada.Calendar;            use Ada.Calendar;
  39 with Ada.Characters.Handling;
  40 with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
  41 with Ada.Text_IO;
  42
  43 package body GNAT.Calendar.Time_IO is
  44
  45    type Month_Name is
  46      (January,
  47       Febuary,
  48       March,
  49       April,
  50       May,
  51       June,
  52       July,
  53       August,
  54       September,
  55       October,
  56       November,
  57       December);
  58
  59    type Padding_Mode is (None, Zero, Space);
  60
  61    -----------------------
  62    -- Local Subprograms --
  63    -----------------------
  64
  65    function Am_Pm (H : Natural) return String;
  66    --  return AM or PM depending on the hour H
  67
  68    function Hour_12 (H : Natural) return Positive;
  69    --  Convert a 1-24h format to a 0-12 hour format.
  70
  71    function Image (Str : String; Length : Natural := 0) return String;
  72    --  Return Str capitalized and cut to length number of characters. If
  73    --  length is set to 0 it does not cut it.
  74
  75    function Image
  76      (N       : Long_Integer;
  77       Padding : Padding_Mode := Zero;
  78       Length  : Natural := 0)
  79       return    String;
  80    --  Return image of N. This number is eventually padded with zeros or
  81    --  spaces depending of the length required. If length is 0 then no padding
  82    --  occurs.
  83
  84    function Image
  85      (N       : Integer;
  86       Padding : Padding_Mode := Zero;
  87       Length  : Natural := 0)
  88       return    String;
  89    --  As above with N provided in Integer format.
  90
  91    -----------
  92    -- Am_Pm --
  93    -----------
  94
  95    function Am_Pm (H : Natural) return String is
  96    begin
  97       if H = 0 or else H > 12 then
  98          return "PM";
  99       else
 100          return "AM";
 101       end if;
 102    end Am_Pm;
 103
 104    -------------
 105    -- Hour_12 --
 106    -------------
 107
 108    function Hour_12 (H : Natural) return Positive is
 109    begin
 110       if H = 0 then
 111          return 12;
 112       elsif H <= 12 then
 113          return H;
 114       else --  H > 12
 115          return H - 12;
 116       end if;
 117    end Hour_12;
 118
 119    -----------
 120    -- Image --
 121    -----------
 122
 123    function Image
 124      (Str    : String;
 125       Length : Natural := 0)
 126       return   String
 127    is
 128       use Ada.Characters.Handling;
 129       Local : String := To_Upper (Str (1)) & To_Lower (Str (2 .. Str'Last));
 130
 131    begin
 132       if Length = 0 then
 133          return Local;
 134       else
 135          return Local (1 .. Length);
 136       end if;
 137    end Image;
 138
 139    -----------
 140    -- Image --
 141    -----------
 142
 143    function Image
 144      (N       : Integer;
 145       Padding : Padding_Mode := Zero;
 146       Length  : Natural := 0)
 147       return    String
 148    is
 149    begin
 150       return Image (Long_Integer (N), Padding, Length);
 151    end Image;
 152
 153    function Image
 154      (N       : Long_Integer;
 155       Padding : Padding_Mode := Zero;
 156       Length  : Natural := 0)
 157       return    String
 158    is
 159       function Pad_Char return String;
 160
 161       function Pad_Char return String is
 162       begin
 163          case Padding is
 164             when None  => return "";
 165             when Zero  => return "00";
 166             when Space => return "  ";
 167          end case;
 168       end Pad_Char;
 169
 170       NI  : constant String := Long_Integer'Image (N);
 171       NIP : constant String := Pad_Char & NI (2 .. NI'Last);
 172
 173    --  Start of processing for Image
 174
 175    begin
 176       if Length = 0 or else Padding = None then
 177          return NI (2 .. NI'Last);
 178
 179       else
 180          return NIP (NIP'Last - Length + 1 .. NIP'Last);
 181       end if;
 182    end Image;
 183
 184    -----------
 185    -- Image --
 186    -----------
 187
 188    function Image
 189      (Date    : Ada.Calendar.Time;
 190       Picture : Picture_String)
 191       return    String
 192    is
 193       Padding    : Padding_Mode := Zero;
 194       --  Padding is set for one directive
 195
 196       Result     : Unbounded_String;
 197
 198       Year       : Year_Number;
 199       Month      : Month_Number;
 200       Day        : Day_Number;
 201       Hour       : Hour_Number;
 202       Minute     : Minute_Number;
 203       Second     : Second_Number;
 204       Sub_Second : Second_Duration;
 205
 206       P : Positive := Picture'First;
 207
 208    begin
 209       Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second);
 210
 211       loop
 212          --  A directive has the following format "%[-_]."
 213
 214          if Picture (P) = '%' then
 215
 216             Padding := Zero;
 217
 218             if P = Picture'Last then
 219                raise Picture_Error;
 220             end if;
 221
 222             --  Check for GNU extension to change the padding
 223
 224             if Picture (P + 1) = '-' then
 225                Padding := None;
 226                P := P + 1;
 227             elsif Picture (P + 1) = '_' then
 228                Padding := Space;
 229                P := P + 1;
 230             end if;
 231
 232             if P = Picture'Last then
 233                raise Picture_Error;
 234             end if;
 235
 236             case Picture (P + 1) is
 237
 238                --  Literal %
 239
 240                when '%' =>
 241                   Result := Result & '%';
 242
 243                --  A newline
 244
 245                when 'n' =>
 246                   Result := Result & ASCII.LF;
 247
 248                --  A horizontal tab
 249
 250                when 't' =>
 251                   Result := Result & ASCII.HT;
 252
 253                --  Hour (00..23)
 254
 255                when 'H' =>
 256                   Result := Result & Image (Hour, Padding, 2);
 257
 258                --  Hour (01..12)
 259
 260                when 'I' =>
 261                   Result := Result & Image (Hour_12 (Hour), Padding, 2);
 262
 263                --  Hour ( 0..23)
 264
 265                when 'k' =>
 266                   Result := Result & Image (Hour, Space, 2);
 267
 268                --  Hour ( 1..12)
 269
 270                when 'l' =>
 271                   Result := Result & Image (Hour_12 (Hour), Space, 2);
 272
 273                --  Minute (00..59)
 274
 275                when 'M' =>
 276                   Result := Result & Image (Minute, Padding, 2);
 277
 278                --  AM/PM
 279
 280                when 'p' =>
 281                   Result := Result & Am_Pm (Hour);
 282
 283                --  Time, 12-hour (hh:mm:ss [AP]M)
 284
 285                when 'r' =>
 286                   Result := Result &
 287                     Image (Hour_12 (Hour), Padding, Length => 2) & ':' &
 288                     Image (Minute, Padding, Length => 2) & ':' &
 289                     Image (Second, Padding, Length => 2) & ' ' &
 290                     Am_Pm (Hour);
 291
 292                --   Seconds  since 1970-01-01  00:00:00 UTC
 293                --   (a nonstandard extension)
 294
 295                when 's' =>
 296                   declare
 297                      Sec : constant Long_Integer :=
 298                              Long_Integer
 299                                ((Julian_Day (Year, Month, Day) -
 300                                   Julian_Day (1970, 1, 1)) * 86_400 +
 301                                 Hour * 3_600 + Minute * 60 + Second);
 302
 303                   begin
 304                      Result := Result & Image (Sec, None);
 305                   end;
 306
 307                --  Second (00..59)
 308
 309                when 'S' =>
 310                   Result := Result & Image (Second, Padding, Length => 2);
 311
 312                --  Time, 24-hour (hh:mm:ss)
 313
 314                when 'T' =>
 315                   Result := Result &
 316                     Image (Hour, Padding, Length => 2) & ':' &
 317                     Image (Minute, Padding, Length => 2) & ':' &
 318                     Image (Second, Padding, Length => 2);
 319
 320                --  Locale's abbreviated weekday name (Sun..Sat)
 321
 322                when 'a' =>
 323                   Result := Result &
 324                     Image (Day_Name'Image (Day_Of_Week (Date)), 3);
 325
 326                --  Locale's full weekday name, variable length
 327                --  (Sunday..Saturday)
 328
 329                when 'A' =>
 330                   Result := Result &
 331                     Image (Day_Name'Image (Day_Of_Week (Date)));
 332
 333                --  Locale's abbreviated month name (Jan..Dec)
 334
 335                when 'b' | 'h' =>
 336                   Result := Result &
 337                     Image (Month_Name'Image (Month_Name'Val (Month - 1)), 3);
 338
 339                --  Locale's full month name, variable length
 340                --  (January..December)
 341
 342                when 'B' =>
 343                   Result := Result &
 344                     Image (Month_Name'Image (Month_Name'Val (Month - 1)));
 345
 346                --  Locale's date and time (Sat Nov 04 12:02:33 EST 1989)
 347
 348                when 'c' =>
 349                   case Padding is
 350                      when Zero =>
 351                         Result := Result & Image (Date, "%a %b %d %T %Y");
 352                      when Space =>
 353                         Result := Result & Image (Date, "%a %b %_d %_T %Y");
 354                      when None =>
 355                         Result := Result & Image (Date, "%a %b %-d %-T %Y");
 356                   end case;
 357
 358                --   Day of month (01..31)
 359
 360                when 'd' =>
 361                   Result := Result & Image (Day, Padding, 2);
 362
 363                --  Date (mm/dd/yy)
 364
 365                when 'D' | 'x' =>
 366                   Result := Result &
 367                     Image (Month, Padding, 2) & '/' &
 368                     Image (Day, Padding, 2) & '/' &
 369                     Image (Year, Padding, 2);
 370
 371                --  Day of year (001..366)
 372
 373                when 'j' =>
 374                   Result := Result & Image (Day_In_Year (Date), Padding, 3);
 375
 376                --  Month (01..12)
 377
 378                when 'm' =>
 379                   Result := Result & Image (Month, Padding, 2);
 380
 381                --  Week number of year with Sunday as first day of week
 382                --  (00..53)
 383
 384                when 'U' =>
 385                   declare
 386                      Offset : constant Natural :=
 387                                 (Julian_Day (Year, 1, 1) + 1) mod 7;
 388
 389                      Week : constant Natural :=
 390                               1 + ((Day_In_Year (Date) - 1) + Offset) / 7;
 391
 392                   begin
 393                      Result := Result & Image (Week, Padding, 2);
 394                   end;
 395
 396                --  Day of week (0..6) with 0 corresponding to Sunday
 397
 398                when 'w' =>
 399                   declare
 400                      DOW : Natural range 0 .. 6;
 401
 402                   begin
 403                      if Day_Of_Week (Date) = Sunday then
 404                         DOW := 0;
 405                      else
 406                         DOW := Day_Name'Pos (Day_Of_Week (Date));
 407                      end if;
 408
 409                      Result := Result & Image (DOW, Length => 1);
 410                   end;
 411
 412                --  Week number of year with Monday as first day of week
 413                --  (00..53)
 414
 415                when 'W' =>
 416                   Result := Result & Image (Week_In_Year (Date), Padding, 2);
 417
 418                --  Last two digits of year (00..99)
 419
 420                when 'y' =>
 421                   declare
 422                      Y : constant Natural := Year - (Year / 100) * 100;
 423
 424                   begin
 425                      Result := Result & Image (Y, Padding, 2);
 426                   end;
 427
 428                --   Year (1970...)
 429
 430                when 'Y' =>
 431                   Result := Result & Image (Year, None, 4);
 432
 433                when others =>
 434                   raise Picture_Error;
 435             end case;
 436
 437             P := P + 2;
 438
 439          else
 440             Result := Result & Picture (P);
 441             P := P + 1;
 442          end if;
 443
 444          exit when P > Picture'Last;
 445
 446       end loop;
 447
 448       return To_String (Result);
 449    end Image;
 450
 451    --------------
 452    -- Put_Time --
 453    --------------
 454
 455    procedure Put_Time
 456      (Date    : Ada.Calendar.Time;
 457       Picture : Picture_String)
 458    is
 459    begin
 460       Ada.Text_IO.Put (Image (Date, Picture));
 461    end Put_Time;
 462
 463 end GNAT.Calendar.Time_IO;