Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Merge pull request #5 from felideon/iso-week-date

Implement support for ISO week dates
  • Loading branch information...
commit 2da3c6fb4d5fbd60c5a2c8c4dcfba8426d5e62e8 2 parents b86691d + 4fa10e5
Daniel Lowe authored November 21, 2012
13  doc/local-time.texinfo
@@ -545,6 +545,13 @@ The constant @var{+rfc-1123-format+} is bound to a description of the format def
545 545
 
546 546
 @end defvr
547 547
 
  548
+@itindex +iso-week-date-format+
  549
+@defvr Constant +iso-week-date-format+
  550
+
  551
+The constant @var{+iso-week-date-format+} is bound to a description of the ISO 8601 Week Date format.  An output with this format will look like this: @samp{2009-W53-5}.
  552
+
  553
+@end defvr
  554
+
548 555
 @itindex parse-timestring
549 556
 @defun parse-timestring timestring &key (start 0) end (fail-on-error t) (offset 0)
550 557
 
@@ -587,6 +594,12 @@ FORMAT is a list containing one or more of strings, characters, and keywords.  S
587 594
 *microseconds
588 595
 @item :nsec
589 596
 *nanoseconds
  597
+@item :iso-week-year
  598
+*year for ISO week date (can be different from regular calendar year)
  599
+@item :iso-week-number
  600
+*ISO week number (i.e. 1 through 53)
  601
+@item :iso-week-day
  602
+*ISO compatible weekday number (i.e. monday=1, sunday=7)
590 603
 @item :ordinal-day
591 604
 day of month as an ordinal (e.g. 1st, 23rd)
592 605
 @item :long-weekday
147  src/local-time.lisp
@@ -154,6 +154,9 @@
154 154
   '(:short-weekday ", " (:day 2) #\space :short-month #\space (:year 4) #\space
155 155
     (:hour 2) #\: (:min 2) #\: (:sec 2) #\space :timezone)
156 156
   "Please note that you should use the +GMT-ZONE+ timezone to format a proper RFC 1123 timestring. See the RFC for the details about the possible values of the timezone field.")
  157
+(defparameter +iso-week-date-format+
  158
+  ;; 2009-W53-5
  159
+  '((:iso-week-year 4) #\- #\W (:iso-week-number 2) #\- (:iso-week-day 1)))
157 160
 
158 161
 (eval-when (:compile-toplevel :load-toplevel :execute)
159 162
   (defparameter +rotated-month-days-without-leap-day+
@@ -1108,6 +1111,18 @@ elements."
1108 1111
        1-based-month
1109 1112
        1-based-day))))
1110 1113
 
  1114
+(defun %timestamp-decode-iso-week (timestamp)
  1115
+  "Returns the year, week number, and day of week components of an ISO week date."
  1116
+  ;; Algorithm from http://en.wikipedia.org/wiki/Talk:ISO_week_date#Algorithms
  1117
+  (let* ((dn (timestamp-day-of-week timestamp))
  1118
+         (day-of-week (if (zerop dn) 7 dn)) ; ISO weekdays are Monday=1 and Sunday=7
  1119
+         (nearest-thursday (timestamp+ timestamp (- 4 day-of-week) :day))
  1120
+         (base-year (encode-timestamp 0 0 0 0 1 1 (timestamp-year nearest-thursday)))
  1121
+         (ordinal-day (- (day-of nearest-thursday) (day-of base-year))))
  1122
+    (values (timestamp-year base-year)
  1123
+            (nth-value 0 (floor (1+ (/ ordinal-day 7))))
  1124
+            day-of-week)))
  1125
+
1111 1126
 (defun %timestamp-decode-time (seconds)
1112 1127
   "Returns the hours, minutes, and seconds, given the number of seconds since midnight."
1113 1128
   (declare (type integer seconds))
@@ -1452,68 +1467,73 @@ elements."
1452 1467
   (multiple-value-bind (nsec sec minute hour day month year weekday daylight-p offset abbrev)
1453 1468
       (decode-timestamp timestamp :timezone timezone)
1454 1469
     (declare (ignore daylight-p))
1455  
-    (let ((*print-pretty* nil)
1456  
-          (*print-circle* nil))
1457  
-      (with-output-to-string (result nil :element-type 'base-char)
1458  
-        (dolist (fmt format)
1459  
-          (cond
1460  
-            ((or (eql fmt :gmt-offset)
1461  
-                 (eql fmt :gmt-offset-or-z))
1462  
-             (multiple-value-bind (offset-hours offset-secs)
1463  
-                 (floor offset +seconds-per-hour+)
1464  
-               (declare (fixnum offset-hours offset-secs))
1465  
-               (if (and (eql fmt :gmt-offset-or-z) (zerop offset))
1466  
-                   (princ #\Z result)
1467  
-                   (format result "~c~2,'0d:~2,'0d"
1468  
-                           (if (minusp offset-hours) #\- #\+)
1469  
-                           (abs offset-hours)
1470  
-                           (truncate (abs offset-secs)
1471  
-                                     +seconds-per-minute+)))))
1472  
-            ((eql fmt :short-year)
1473  
-             (princ (mod year 100) result))
1474  
-            ((eql fmt :long-month)
1475  
-             (princ (aref +month-names+ month) result))
1476  
-            ((eql fmt :short-month)
1477  
-             (princ (aref +short-month-names+ month) result))
1478  
-            ((eql fmt :long-weekday)
1479  
-             (princ (aref +day-names+ weekday) result))
1480  
-            ((eql fmt :short-weekday)
1481  
-             (princ (aref +short-day-names+ weekday) result))
1482  
-            ((eql fmt :timezone)
1483  
-             (princ abbrev result))
1484  
-            ((eql fmt :hour12)
1485  
-             (princ (1+ (mod (1- hour) 12)) result))
1486  
-            ((eql fmt :ampm)
1487  
-             (princ (if (< hour 12) "am" "pm") result))
1488  
-            ((eql fmt :ordinal-day)
1489  
-             (princ (ordinalize day) result))
1490  
-            ((or (stringp fmt) (characterp fmt))
1491  
-             (princ fmt result))
1492  
-            (t
1493  
-             (let ((val (ecase (if (consp fmt) (car fmt) fmt)
1494  
-                          (:nsec nsec)
1495  
-                          (:usec (floor nsec 1000))
1496  
-                          (:msec (floor nsec 1000000))
1497  
-                          (:sec sec)
1498  
-                          (:min minute)
1499  
-                          (:hour hour)
1500  
-                          (:day day)
1501  
-                          (:weekday weekday)
1502  
-                          (:month month)
1503  
-                          (:year year))))
1504  
-               (cond
1505  
-                 ((atom fmt)
1506  
-                  (princ val result))
1507  
-                 ((minusp val)
1508  
-                  (format result "-~v,vd"
1509  
-                          (second fmt)
1510  
-                          (or (third fmt) #\0)
1511  
-                          (abs val)))
1512  
-                 (t
1513  
-                  (format result "~v,vd"
1514  
-                          (second fmt)
1515  
-                          (or (third fmt) #\0)
1516  
-                          val)))))))))))
  1470
+    (multiple-value-bind (iso-year iso-week iso-weekday)
  1471
+        (%timestamp-decode-iso-week timestamp)
  1472
+      (let ((*print-pretty* nil)
  1473
+            (*print-circle* nil))
  1474
+        (with-output-to-string (result nil :element-type 'base-char)
  1475
+          (dolist (fmt format)
  1476
+            (cond
  1477
+              ((or (eql fmt :gmt-offset)
  1478
+                   (eql fmt :gmt-offset-or-z))
  1479
+               (multiple-value-bind (offset-hours offset-secs)
  1480
+                   (floor offset +seconds-per-hour+)
  1481
+                 (declare (fixnum offset-hours offset-secs))
  1482
+                 (if (and (eql fmt :gmt-offset-or-z) (zerop offset))
  1483
+                     (princ #\Z result)
  1484
+                     (format result "~c~2,'0d:~2,'0d"
  1485
+                             (if (minusp offset-hours) #\- #\+)
  1486
+                             (abs offset-hours)
  1487
+                             (truncate (abs offset-secs)
  1488
+                                       +seconds-per-minute+)))))
  1489
+              ((eql fmt :short-year)
  1490
+               (princ (mod year 100) result))
  1491
+              ((eql fmt :long-month)
  1492
+               (princ (aref +month-names+ month) result))
  1493
+              ((eql fmt :short-month)
  1494
+               (princ (aref +short-month-names+ month) result))
  1495
+              ((eql fmt :long-weekday)
  1496
+               (princ (aref +day-names+ weekday) result))
  1497
+              ((eql fmt :short-weekday)
  1498
+               (princ (aref +short-day-names+ weekday) result))
  1499
+              ((eql fmt :timezone)
  1500
+               (princ abbrev result))
  1501
+              ((eql fmt :hour12)
  1502
+               (princ (1+ (mod (1- hour) 12)) result))
  1503
+              ((eql fmt :ampm)
  1504
+               (princ (if (< hour 12) "am" "pm") result))
  1505
+              ((eql fmt :ordinal-day)
  1506
+               (princ (ordinalize day) result))
  1507
+              ((or (stringp fmt) (characterp fmt))
  1508
+               (princ fmt result))
  1509
+              (t
  1510
+               (let ((val (ecase (if (consp fmt) (car fmt) fmt)
  1511
+                            (:nsec nsec)
  1512
+                            (:usec (floor nsec 1000))
  1513
+                            (:msec (floor nsec 1000000))
  1514
+                            (:sec sec)
  1515
+                            (:min minute)
  1516
+                            (:hour hour)
  1517
+                            (:day day)
  1518
+                            (:weekday weekday)
  1519
+                            (:month month)
  1520
+                            (:year year)
  1521
+                            (:iso-week-year iso-year)
  1522
+                            (:iso-week-number iso-week)
  1523
+                            (:iso-week-day iso-weekday))))
  1524
+                 (cond
  1525
+                   ((atom fmt)
  1526
+                    (princ val result))
  1527
+                   ((minusp val)
  1528
+                    (format result "-~v,vd"
  1529
+                            (second fmt)
  1530
+                            (or (third fmt) #\0)
  1531
+                            (abs val)))
  1532
+                   (t
  1533
+                    (format result "~v,vd"
  1534
+                            (second fmt)
  1535
+                            (or (third fmt) #\0)
  1536
+                            val))))))))))))
1517 1537
 
1518 1538
 (defun format-timestring (destination timestamp &key
1519 1539
                           (format +iso-8601-format+)
@@ -1532,6 +1552,9 @@ FORMAT is a list containing one or more of strings, characters, and keywords. St
1532 1552
   :MSEC              *milliseconds
1533 1553
   :USEC              *microseconds
1534 1554
   :NSEC              *nanoseconds
  1555
+  :ISO-WEEK-YEAR     *year for ISO week date (can be different from regular calendar year)
  1556
+  :ISO-WEEK-NUMBER   *ISO week number (i.e. 1 through 53)
  1557
+  :ISO-WEEK-DAY      *ISO compatible weekday number (monday=1, sunday=7)
1535 1558
   :LONG-WEEKDAY      long form of weekday (e.g. Sunday, Monday)
1536 1559
   :SHORT-WEEKDAY     short form of weekday (e.g. Sun, Mon)
1537 1560
   :LONG-MONTH        long form of month (e.g. January, February)
3  src/package.lisp
@@ -77,6 +77,7 @@
77 77
            #:+rfc3339-format/date-only+
78 78
            #:+asctime-format+
79 79
            #:+rfc-1123-format+
  80
+           #:+iso-week-date-format+
80 81
            #:astronomical-julian-date
81 82
            #:modified-julian-date
82  
-           #:astronomical-modified-julian-date))
  83
+           #:astronomical-modified-julian-date))
34  test/formatting.lisp
@@ -40,7 +40,39 @@
40 40
 
41 41
        "5th"
42 42
        (format-timestring nil test-timestamp
43  
-                          :format '(:ordinal-day))))))
  43
+                          :format '(:ordinal-day))
  44
+
  45
+       "2004-W53-6"
  46
+       (format-timestring nil (encode-timestamp 0 0 0 0 1 1 2005)
  47
+                          :format +iso-week-date-format+)
  48
+
  49
+       "2004-W53-7"
  50
+       (format-timestring nil (encode-timestamp 0 0 0 0 2 1 2005)
  51
+                          :format +iso-week-date-format+)
  52
+
  53
+       "2005-W52-6"
  54
+       (format-timestring nil (encode-timestamp 0 0 0 0 31 12 2005)
  55
+                          :format +iso-week-date-format+)
  56
+
  57
+       "2007-W01-1"
  58
+       (format-timestring nil (encode-timestamp 0 0 0 0 1 1 2007)
  59
+                          :format +iso-week-date-format+)
  60
+
  61
+       "2007-W52-7"
  62
+       (format-timestring nil (encode-timestamp 0 0 0 0 30 12 2007)
  63
+                          :format +iso-week-date-format+)
  64
+
  65
+       "2008-W01-1"
  66
+       (format-timestring nil (encode-timestamp 0 0 0 0 31 12 2007)
  67
+                          :format +iso-week-date-format+)
  68
+
  69
+       "2009-W53-5"
  70
+       (format-timestring nil (encode-timestamp 0 0 0 0 1 1 2010)
  71
+                          :format +iso-week-date-format+)
  72
+
  73
+       "2009-W01-3"
  74
+       (format-timestring nil (encode-timestamp 0 0 0 0 31 12 2008)
  75
+                          :format +iso-week-date-format+)))))
44 76
 
45 77
 (deftest test/formatting/format-timestring/2 ()
46 78
   (with-output-to-string (*standard-output*)

0 notes on commit 2da3c6f

Please sign in to comment.
Something went wrong with that request. Please try again.