el/dot-emacs.el: Add Discordian date conversion.

Taken from <http://www.davep.org/emacs/discord.el>.

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index f4a33d8..91283d9 100644 (file)
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -270,6 +270,50 @@ function returns non-nil."
        (memq (nth d '(sunday monday tuesday wednesday
                              thursday friday saturday)) l))))
 
+(defun mdw-discordian-date (date)
+  "Return the Discordian calendar date corresponding to DATE.
+
+The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
+
+The original is by David Pearson.  I modified it to produce date components
+as output rather than a string."
+  (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
+               "Prickle-Prickle" "Setting Orange"])
+        (months ["Chaos" "Discord" "Confusion"
+                 "Bureaucracy" "Aftermath"])
+        (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
+        (year (- (extract-calendar-year date) 1900))
+        (month (1- (extract-calendar-month date)))
+        (day (1- (extract-calendar-day date)))
+        (julian (+ (aref day-count month) day))
+        (dyear (+ year 3066)))
+    (if (and (= month 1) (= day 28))
+       (cons dyear 'st-tibs-day)
+      (list dyear
+           (aref months (floor (/ julian 73)))
+           (1+ (mod julian 73))
+           (aref days (mod julian 5))))))
+
+(defun mdw-diary-discordian-date ()
+  "Convert the date in `date' to a string giving the Discordian date."
+  (let* ((ddate (mdw-discordian-date date))
+        (tail (format "in the YOLD %d" (car ddate))))
+    (if (eq (cdr ddate) 'st-tibs-day)
+       (format "St Tib's Day %s" tail)
+      (let ((season (cadr ddate))
+           (daynum (caddr ddate))
+           (dayname (cadddr ddate)))
+      (format "%s, the %d%s day of %s %s"
+             dayname
+             daynum
+             (let ((ldig (mod daynum 10)))
+               (cond ((= ldig 1) "st")
+                     ((= ldig 2) "nd")
+                     ((= ldig 3) "rd")
+                     (t "th")))
+             season
+             tail)))))
+
 (defun mdw-todo (&optional when)
   "Return non-nil today, or on WHEN, whichever is later."
   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))