From ac1a4884d03fc0495c773500d8a13f84b695fa43 Mon Sep 17 00:00:00 2001
From: tslil clingman <>
Date: Wed, 11 Sep 2019 19:18:14 -0400
Subject: Init

---
 stumpwm/modules/modeline/fuzzytime/README.org     |  9 +++
 stumpwm/modules/modeline/fuzzytime/fuzzytime.asd  | 11 +++
 stumpwm/modules/modeline/fuzzytime/fuzzytime.lisp | 84 +++++++++++++++++++++++
 stumpwm/modules/modeline/fuzzytime/package.lisp   |  5 ++
 4 files changed, 109 insertions(+)
 create mode 100644 stumpwm/modules/modeline/fuzzytime/README.org
 create mode 100644 stumpwm/modules/modeline/fuzzytime/fuzzytime.asd
 create mode 100644 stumpwm/modules/modeline/fuzzytime/fuzzytime.lisp
 create mode 100644 stumpwm/modules/modeline/fuzzytime/package.lisp

(limited to 'stumpwm/modules')

diff --git a/stumpwm/modules/modeline/fuzzytime/README.org b/stumpwm/modules/modeline/fuzzytime/README.org
new file mode 100644
index 0000000..fbfc14f
--- /dev/null
+++ b/stumpwm/modules/modeline/fuzzytime/README.org
@@ -0,0 +1,9 @@
+** Usage
+Put:
+#+BEGIN_SRC lisp
+(load-module "fuzzytime")
+#+END_SRC
+in =~/.stumpwmrc= and then use =%F= in the mode-line format string.
+
+The output format and granularity may be customised by changing
+~*fuzzytime-format*~ and ~*minute-granularity*~ respectively.
diff --git a/stumpwm/modules/modeline/fuzzytime/fuzzytime.asd b/stumpwm/modules/modeline/fuzzytime/fuzzytime.asd
new file mode 100644
index 0000000..82a630b
--- /dev/null
+++ b/stumpwm/modules/modeline/fuzzytime/fuzzytime.asd
@@ -0,0 +1,11 @@
+;;;; fuzzytime.asd
+
+(asdf:defsystem #:fuzzytime
+  :description "A module to display a fuzzy date and time in the modeline of StumpWM"
+  :author "Tslil Clingman <tslil@posteo.de>"
+  :license "GPLv3"
+  :depends-on (#:stumpwm)
+  :serial t
+  :components ((:file "package")
+               (:file "fuzzytime")))
+
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)))))))
diff --git a/stumpwm/modules/modeline/fuzzytime/package.lisp b/stumpwm/modules/modeline/fuzzytime/package.lisp
new file mode 100644
index 0000000..944e195
--- /dev/null
+++ b/stumpwm/modules/modeline/fuzzytime/package.lisp
@@ -0,0 +1,5 @@
+;;;; package.lisp
+
+(defpackage #:fuzzytime
+  (:use #:cl :stumpwm))
+
-- 
cgit v1.2.3