1 files changed, 84 insertions, 0 deletions
diff --git a/stumpwm/modules/modeline/fuzzytime/fuzzytime.lisp b/stumpwm/modules/modeline/fuzzytime/fuzzytime.lisp
new file mode 100644
index 0000000..9a703a3
--- /dev/null
+++ b/stumpwm/modules/modeline/fuzzytime/fuzzytime.lisp
@@ -0,0 +1,84 @@
+;;;; fuzzytime.lisp
+
+(IN-PACKAGE #:FUZZYTIME)
+
+(EXPORT '(*FUZZYTIME-FORMAT* *MINUTE-GRANULARITY*))
+
+(PUSHNEW '(#\F LOCAL-TIME-TO-FUZZY) *SCREEN-MODE-LINE-FORMATTERS* :TEST 'EQUAL)
+
+(DEFPARAMETER *MINUTE-GRANULARITY* 10
+  "Minutes are rounded to the nearest multiple of *minute-granularity*")
+
+(DEFPARAMETER *FUZZYTIME-FORMAT*
+  '(:MINUTES :HOURS " in the " :PERIOD " on " :DOW
+    " the " :DAY " of " :MONTH)
+  "Format of the output, a list of strings and keywords. Valid keywords are:
+:minutes
+:hours
+:period
+:dow (name of the day of the week)
+:udow (name of the day of the week, capitalised)
+:dn (number of the day of the week)
+:day (day of the month)
+:mnum (number of the month)
+:month (name of the month, capitalised)
+:umonth (name of the month)")
+
+(DEFVAR *MONTH-NAMES*
+  (MAKE-ARRAY '(12) :INITIAL-CONTENTS
+              '("january" "february" "march" "april" "may" "june" "july"
+                "august" "september" "october" "november" "december")))
+
+(DEFVAR *DOW-NAMES*
+  (MAKE-ARRAY '(7) :INITIAL-CONTENTS
+              '("monday" "tuesday" "wednesday"
+                "thursday" "friday" "saturday"
+                "sunday")))
+
+(DEFUN MINUTES-TO-WORDS (MIN)
+  (IF (OR (<= MIN 0) (>= MIN 60)) ""
+      (FLET ((FRAC (M) (COND
+                         ((= M 30) "half")
+                         ((= M 15) "quarter")
+                         (T (FORMAT NIL "~r" M)))))
+        (FORMAT NIL "~a ~a " (FRAC (IF (> MIN 30) (- 60 MIN) MIN))
+                (IF (> MIN 30) "to" "past")))))
+
+(DEFUN HOUR-TO-WORDS (HOUR MIN)
+  (LET ((H (MOD
+            (IF (> MIN 30) (1+ HOUR) HOUR )
+            12)))
+    (FORMAT NIL "~r~a"
+            (IF (= H 0) 12 H)
+            (IF (OR (= MIN 0) (= MIN 60)) " o'clock" ""))))
+
+(DEFUN PERIOD-INDICATOR (HOUR)
+  (IF (< HOUR 12) "morning"
+      (IF (< HOUR 17) "afternoon" "evening")))
+
+(DEFUN LOCAL-TIME-TO-FUZZY (ML)
+  (DECLARE (IGNORE ML))
+  (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOUR DAY MONTH YEAR DOW)
+      (GET-DECODED-TIME)
+    (DECLARE (IGNORE SECONDS) (IGNORE YEAR))
+    (LET* ((MIN (* *MINUTE-GRANULARITY*
+                   (ROUND (/ MINUTES *MINUTE-GRANULARITY*))))
+           (MS (MINUTES-TO-WORDS MIN))
+           (HS (HOUR-TO-WORDS HOUR MIN))
+           (PS (PERIOD-INDICATOR HOUR))
+           (DN (ELT *DOW-NAMES* DOW))
+           (MN (ELT *MONTH-NAMES* (1- MONTH))))
+      (APPLY #'CONCATENATE 'STRING
+             (LOOP FOR E IN *FUZZYTIME-FORMAT* COLLECT
+                  (CASE E
+                    (:MINUTES MS)
+                    (:HOURS HS)
+                    (:PERIOD PS)
+                    (:DOW DN)
+                    (:UDOW (STRING-CAPITALIZE DN))
+                    (:MONTH MN)
+                    (:UMONTH (STRING-CAPITALIZE MN))
+                    (:DNUM (FORMAT NIL "~a" DOW))
+                    (:DAY (FORMAT NIL "~:r" DAY))
+                    (:MNUM (FORMAT NIL "~a" MONTH))
+                    (OTHERWISE E)))))))