1------------------------------------------------------------------------------ 2-- -- 3-- Matreshka Project -- 4-- -- 5-- Localization, Internationalization, Globalization for Ada -- 6-- -- 7-- Runtime Library Component -- 8-- -- 9------------------------------------------------------------------------------ 10-- -- 11-- Copyright © 2011-2014, Vadim Godunko <vgodunko@gmail.com> -- 12-- All rights reserved. -- 13-- -- 14-- Redistribution and use in source and binary forms, with or without -- 15-- modification, are permitted provided that the following conditions -- 16-- are met: -- 17-- -- 18-- * Redistributions of source code must retain the above copyright -- 19-- notice, this list of conditions and the following disclaimer. -- 20-- -- 21-- * Redistributions in binary form must reproduce the above copyright -- 22-- notice, this list of conditions and the following disclaimer in the -- 23-- documentation and/or other materials provided with the distribution. -- 24-- -- 25-- * Neither the name of the Vadim Godunko, IE nor the names of its -- 26-- contributors may be used to endorse or promote products derived from -- 27-- this software without specific prior written permission. -- 28-- -- 29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- 30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- 31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- 32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- 33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- 34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- 35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- 36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- 37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- 38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- 39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- 40-- -- 41------------------------------------------------------------------------------ 42-- $Revision: 4979 $ $Date: 2014-11-03 22:58:37 +0300 (Mon, 03 Nov 2014) $ 43------------------------------------------------------------------------------ 44with League.Characters; 45with Matreshka.Internals.Calendars.Times; 46 47package body Matreshka.Internals.Calendars.Formatting is 48 49 ----------- 50 -- Image -- 51 ----------- 52 53 function Image 54 (Pattern : League.Strings.Universal_String; 55 Printer : Abstract_Printer'Class; 56 Time_Printer : Abstract_Time_Printer'Class; 57 Stamp : Absolute_Time; 58 Zone : not null Time_Zone_Access) 59 return League.Strings.Universal_String 60 is 61 use type League.Characters.Universal_Character; 62 63 procedure Parse_Field 64 (Max_Length : Positive; 65 Index : in out Positive; 66 Count : out Positive); 67 68 procedure Parse_Field 69 (Index : in out Positive; 70 Count : out Positive); 71 72 ----------------- 73 -- Parse_Field -- 74 ----------------- 75 76 procedure Parse_Field 77 (Index : in out Positive; 78 Count : out Positive) 79 is 80 Delimiter : constant League.Characters.Universal_Character 81 := Pattern.Element (Index); 82 83 begin 84 Count := 1; 85 Index := Index + 1; 86 87 while Index <= Pattern.Length loop 88 exit when Pattern.Element (Index) /= Delimiter; 89 90 Count := Count + 1; 91 Index := Index + 1; 92 end loop; 93 94 Index := Index - 1; 95 end Parse_Field; 96 97 ----------------- 98 -- Parse_Field -- 99 ----------------- 100 101 procedure Parse_Field 102 (Max_Length : Positive; 103 Index : in out Positive; 104 Count : out Positive) 105 is 106 Delimiter : constant League.Characters.Universal_Character 107 := Pattern.Element (Index); 108 109 begin 110 Count := 1; 111 Index := Index + 1; 112 113 while Index <= Pattern.Length and Count < Max_Length loop 114 exit when Pattern.Element (Index) /= Delimiter; 115 116 Count := Count + 1; 117 Index := Index + 1; 118 end loop; 119 120 Index := Index - 1; 121 end Parse_Field; 122 123 Index : Positive := 1; 124 Count : Positive; 125 Result : League.Strings.Universal_String; 126 Date : Julian_Day_Number; 127 Time : Relative_Time; 128 Leap : Relative_Time; 129 130 begin 131 Times.Split (Zone, Stamp, Date, Time, Leap); 132 133 while Index <= Pattern.Length loop 134 case Pattern.Element (Index).To_Wide_Wide_Character is 135 when 'G' => 136 -- G 1..3 137 -- G 4 138 -- G 5 139 -- 140 -- Era - Replaced with the Era string for the current date. One 141 -- to three letters for the abbreviated form, four letters for 142 -- the long form, five for the narrow form. 143 144 Parse_Field (5, Index, Count); 145 146 case Count is 147 when 1 .. 3 => 148 Printer.Append_Abbreviated_Era (Result, Date, Count); 149 150 when 4 => 151 Printer.Append_Long_Era (Result, Date); 152 153 when 5 => 154 Printer.Append_Narrow_Era (Result, Date); 155 156 when others => 157 -- Must never be happen. 158 159 raise Program_Error; 160 end case; 161 162 when 'y' => 163 -- y 1..n 164 -- 165 -- Year. Normally the length specifies the padding, but for two 166 -- letters it also specifies the maximum length. 167 168 Parse_Field (Index, Count); 169 Printer.Append_Year (Result, Date, Count); 170 171 when 'Y' => 172 -- Y 1..n 173 -- 174 -- Year (in "Week of Year" based calendars). This year 175 -- designation is used in ISO year-week calendar as defined by 176 -- ISO 8601, but can be used in non-Gregorian based calendar 177 -- systems where week date processing is desired. May not 178 -- always be the same value as calendar year. 179 180 Parse_Field (Index, Count); 181 Printer.Append_Year_Week (Result, Date, Count); 182 183 when 'u' => 184 -- u 1..n 185 -- 186 -- Extended year. This is a single number designating the year 187 -- of this calendar system, encompassing all supra-year fields. 188 -- For example, for the Julian calendar system, year numbers 189 -- are positive, with an era of BCE or CE. An extended year 190 -- value for the Julian calendar system assigns positive values 191 -- to CE years and negative values to BCE years, with 1 BCE 192 -- being year 0. 193 194 Parse_Field (Index, Count); 195 Printer.Append_Extended_Year (Result, Date, Count); 196 197 when 'Q' => 198 -- Q 1..2 199 -- Q 3 200 -- Q 4 201 -- 202 -- Quarter - Use one or two for the numerical quarter, three 203 -- for the abbreviation, or four for the full name. 204 205 Parse_Field (4, Index, Count); 206 207 case Count is 208 when 1 .. 2 => 209 Printer.Append_Numerical_Quarter 210 (Result, Date, Count, False); 211 212 when 3 => 213 Printer.Append_Abbreviated_Quarter (Result, Date, False); 214 215 when 4 => 216 Printer.Append_Full_Quarter (Result, Date, False); 217 218 when others => 219 -- Must never be happen. 220 221 raise Program_Error; 222 end case; 223 224 when 'q' => 225 -- q 1..2 226 -- q 3 227 -- q 4 228 -- 229 -- Stand-Alone Quarter - Use one or two for the numerical 230 -- quarter, three for the abbreviation, or four for the full 231 -- name. 232 233 Parse_Field (4, Index, Count); 234 235 case Count is 236 when 1 .. 2 => 237 Printer.Append_Numerical_Quarter 238 (Result, Date, Count, True); 239 240 when 3 => 241 Printer.Append_Abbreviated_Quarter (Result, Date, True); 242 243 when 4 => 244 Printer.Append_Full_Quarter (Result, Date, True); 245 246 when others => 247 -- Must never be happen. 248 249 raise Program_Error; 250 end case; 251 252 when 'M' => 253 -- M 1..2 254 -- M 3 255 -- M 4 256 -- M 5 257 -- 258 -- Month - Use one or two for the numerical month, three for 259 -- the abbreviation, or four for the full name, or five for the 260 -- narrow name. 261 262 Parse_Field (5, Index, Count); 263 264 case Count is 265 when 1 .. 2 => 266 Printer.Append_Numerical_Month 267 (Result, Date, Count, False); 268 269 when 3 => 270 Printer.Append_Abbreviated_Month (Result, Date, False); 271 272 when 4 => 273 Printer.Append_Full_Month (Result, Date, False); 274 275 when 5 => 276 Printer.Append_Narrow_Month (Result, Date, False); 277 278 when others => 279 -- Must never be happen. 280 281 raise Program_Error; 282 end case; 283 284 when 'L' => 285 -- L 1..2 286 -- L 3 287 -- L 4 288 -- L 5 289 -- 290 -- Stand-Alone Month - Use one or two for the numerical month, 291 -- three for the abbreviation, or four for the full name, or 5 292 -- for the narrow name. 293 294 Parse_Field (5, Index, Count); 295 296 case Count is 297 when 1 .. 2 => 298 Printer.Append_Numerical_Month 299 (Result, Date, Count, True); 300 301 when 3 => 302 Printer.Append_Abbreviated_Month (Result, Date, True); 303 304 when 4 => 305 Printer.Append_Full_Month (Result, Date, True); 306 307 when 5 => 308 Printer.Append_Narrow_Month (Result, Date, True); 309 310 when others => 311 -- Must never be happen. 312 313 raise Program_Error; 314 end case; 315 316 when 'l' => 317 -- l 1 318 -- 319 -- Special symbol for Chinese leap month, used in combination 320 -- with M. Only used with the Chinese calendar. 321 322 Printer.Append_Chinese_Leap_Month (Result, Date); 323 324 when 'w' => 325 -- w 1..2 326 -- 327 -- Week of Year. 328 329 Parse_Field (2, Index, Count); 330 Printer.Append_Week_Of_Year (Result, Date, Count); 331 332 when 'W' => 333 -- W 1 334 -- 335 -- Week of Month. 336 337 Printer.Append_Week_Of_Month (Result, Date); 338 339 when 'd' => 340 -- d 1..2 341 -- 342 -- Date - Day of the month. 343 344 Parse_Field (2, Index, Count); 345 Printer.Append_Day_Of_Month (Result, Date, Count); 346 347 when 'D' => 348 -- D 1..3 349 -- 350 -- Day of year. 351 352 Parse_Field (3, Index, Count); 353 Printer.Append_Day_Of_Year (Result, Date, Count); 354 355 when 'F' => 356 -- F 1 357 -- 358 -- Day of Week in Month. 359 360 Printer.Append_Day_Of_Week_In_Month (Result, Date); 361 362 when 'g' => 363 -- g 1..n 364 -- 365 -- Modified Julian day. This is different from the conventional 366 -- Julian day number in two regards. First, it demarcates days 367 -- at local zone midnight, rather than noon GMT. Second, it is 368 -- a local number; that is, it depends on the local time zone. 369 -- It can be thought of as a single number that encompasses all 370 -- the date-related fields. 371 372 Parse_Field (Index, Count); 373 Printer.Append_Julian_Day (Result, Date, Count); 374 375 when 'E' => 376 -- E 1..3 377 -- E 4 378 -- E 5 379 -- 380 -- Day of week - Use one through three letters for the short 381 -- day, or four for the full name, or five for the narrow name. 382 383 Parse_Field (5, Index, Count); 384 385 case Count is 386 when 1 .. 3 => 387 Printer.Append_Short_Day_Of_Week 388 (Result, Date, Count, False); 389 390 when 4 => 391 Printer.Append_Full_Day_Of_Week (Result, Date, False); 392 393 when 5 => 394 Printer.Append_Narrow_Day_Of_Week (Result, Date, False); 395 396 when others => 397 -- Must never be happen. 398 399 raise Program_Error; 400 end case; 401 402 when 'e' => 403 -- e 1..2 404 -- e 3 405 -- e 4 406 -- e 5 407 -- 408 -- Local day of week. Same as E except adds a numeric value 409 -- that will depend on the local starting day of the week, 410 -- using one or two letters. 411 412 Parse_Field (5, Index, Count); 413 414 case Count is 415 when 1 .. 2 => 416 Printer.Append_Numerical_Day_Of_Week 417 (Result, Date, Count, False); 418 419 when 3 => 420 Printer.Append_Short_Day_Of_Week (Result, Date, 3, False); 421 422 when 4 => 423 Printer.Append_Full_Day_Of_Week (Result, Date, False); 424 425 when 5 => 426 Printer.Append_Narrow_Day_Of_Week (Result, Date, False); 427 428 when others => 429 -- Must never be happen. 430 431 raise Program_Error; 432 end case; 433 434 when 'c' => 435 -- c 1 436 -- c 3 437 -- c 4 438 -- c 5 439 -- 440 -- Stand-Alone local day of week - Use one letter for the local 441 -- numeric value (same as 'e'), three for the short day, or 442 -- four for the full name, or five for the narrow name. 443 444 Parse_Field (5, Index, Count); 445 446 case Count is 447 when 1 => 448 Printer.Append_Numerical_Day_Of_Week 449 (Result, Date, Count, True); 450 451 when 3 => 452 Printer.Append_Short_Day_Of_Week (Result, Date, 3, True); 453 454 when 4 => 455 Printer.Append_Full_Day_Of_Week (Result, Date, True); 456 457 when 5 => 458 Printer.Append_Narrow_Day_Of_Week (Result, Date, True); 459 460 when others => 461 -- Must never be happen. 462 463 raise Program_Error; 464 end case; 465 466 when 'a' => 467 -- a 1 468 -- 469 -- AM or PM 470 471 Time_Printer.Append_Period (Result, Time); 472 473 when 'h' => 474 -- h 1..2 475 -- 476 -- Hour [1-12]. 477 478 Parse_Field (2, Index, Count); 479 Time_Printer.Append_Half_Day_Hour (Result, Time, Count, False); 480 481 when 'H' => 482 -- H 1..2 483 -- 484 -- Hour [0-23]. 485 486 Parse_Field (2, Index, Count); 487 Time_Printer.Append_Full_Day_Hour (Result, Time, Count, True); 488 489 when 'K' => 490 -- K 1..2 491 -- 492 -- Hour [0-11]. 493 494 Parse_Field (2, Index, Count); 495 Time_Printer.Append_Half_Day_Hour (Result, Time, Count, True); 496 497 when 'k' => 498 -- k 1..2 499 -- 500 -- Hour [1-24]. 501 502 Parse_Field (2, Index, Count); 503 Time_Printer.Append_Full_Day_Hour (Result, Time, Count, False); 504 505 when 'j' => 506 -- j 1..2 507 -- 508 -- This is a special-purpose symbol. It must not occur in 509 -- pattern or skeleton data. Instead, it is reserved for use in 510 -- APIs doing flexible date pattern generation. In such a 511 -- context, it requests the preferred format (12 versus 24 512 -- hour) for the language in question, as determined by whether 513 -- h, H, K, or k is used in the standard short time format for 514 -- the locale, and should be replaced by h, H, K, or k before 515 -- beginning a match against availableFormats data. 516 517 Parse_Field (2, Index, Count); 518 -- XXX Not supported. 519 520 when 'm' => 521 -- m 1..2 522 -- 523 -- Minute. Use one or two for zero padding. 524 525 Parse_Field (2, Index, Count); 526 Time_Printer.Append_Minute (Result, Time, Count); 527 528 when 's' => 529 -- s 1..2 530 -- 531 -- Second. Use one or two for zero padding. 532 533 Parse_Field (2, Index, Count); 534 Time_Printer.Append_Second (Result, Time, Leap, Count); 535 536 when 'S' => 537 -- S 1..n 538 -- 539 -- Fractional Second - truncates (like other time fields) to 540 -- the count of letters. 541 542 Parse_Field (7, Index, Count); 543 Time_Printer.Append_Fractional_Second 544 (Result, Time, Leap, Count); 545 546 when 'A' => 547 -- A 1..n 548 -- 549 -- Milliseconds in day. This field behaves exactly like a 550 -- composite of all time-related fields, not including the zone 551 -- fields. As such, it also reflects discontinuities of those 552 -- fields on DST transition days. On a day of DST onset, it 553 -- will jump forward. On a day of DST cessation, it will jump 554 -- backward. This reflects the fact that is must be combined 555 -- with the offset field to obtain a unique local time value. 556 557 Parse_Field (Index, Count); 558 Time_Printer.Append_Milliseconds_In_Day 559 (Result, Time, Leap, Count); 560 561 when 'z' => 562 null; 563 564 when 'Z' => 565 null; 566 567 when 'v' => 568 null; 569 570 when 'V' => 571 null; 572 573 when ''' => 574 null; 575 576 when others => 577 Result.Append (Pattern.Element (Index)); 578 end case; 579 580 Index := Index + 1; 581 end loop; 582 583 return Result; 584 end Image; 585 586end Matreshka.Internals.Calendars.Formatting; 587