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