Init

5 files changed, 345 insertions, 0 deletions

diff --git a/stumpwm/init.lisp b/stumpwm/init.lisp
new file mode 100644
index 0000000..3436f06
--- /dev/null
+++ b/stumpwm/init.lisp
@@ -0,0 +1,236 @@
+;; Time-stamp: <2018-06-24 23:12:19 (tslil)>
+(IN-PACKAGE STUMPWM)
+
+;; Startup stuff
+(SETF *STARTUP-MESSAGE* NIL)
+(RUN-COMMANDS "exec $TERMINAL -e $HOME/bin/tma")
+(SET-PREFIX-KEY (KBD "XF86Launch9"))
+
+;; Window decorations
+(SETF *MESSAGE-WINDOW-GRAVITY* :CENTER
+      *INPUT-WINDOW-GRAVITY* :CENTER)
+(SETF *TIMEOUT-WAIT* 5)
+(SETF *MAXSIZE-BORDER-WIDTH* 1)
+(SETF *NORMAL-BORDER-WIDTH* 1)
+(SETF *TRANSIENT-BORDER-WIDTH* 1)
+(SETF *WINDOW-BORDER-STYLE* :THIN)
+(SET-FRAME-OUTLINE-WIDTH 1)
+(SET-MSG-BORDER-WIDTH 3)
+
+;; Groups
+(GRENAME "def")
+(GNEWBG "one")
+(GNEWBG "two")
+
+(SETF *FRAME-NUMBER-MAP* "neioarst123456789"
+      *FRAME-INDICATOR-TEXT* "  This frame has focus.  ")
+
+;; =============================================================================
+;; Functions
+;; Dropwhile
+(DEFUN DROPWHILE (PREDICATE LIST)
+  (LOOP :WHILE (FUNCALL PREDICATE (CAR LIST))
+     :DO (POP LIST))
+  LIST)
+
+;; Notifications
+(DEFUN MY-MESSAGE (LOCATION STRING)
+  (LET ((OLD-LOCATION *message-window-gravity*))
+    (SETF *message-window-gravity* LOCATION)
+    (ECHO STRING)
+    (SETF *message-window-gravity* OLD-LOCATION)))
+
+;; Volume
+(DEFUN VOLUME-MODIFY (MIXER ACTION)
+  (LET* ((OUTPUT (RUN-PROG-COLLECT-OUTPUT "/usr/bin/amixer" "set"
+                                          MIXER
+                                          (CASE ACTION
+                                            (:INC "2%+")
+                                            (:DEC "2%-")
+                                            (:MUT "toggle"))))
+         (PARSED (DROPWHILE #'(LAMBDA (F)
+                                (NOT (EQ #\: (CHAR F (1- (LENGTH F))))))
+                            (SPLIT-STRING (CAR (LAST (SPLIT-STRING
+                                                      OUTPUT))) "[ \[]+"))))
+    (MY-MESSAGE :TOP-RIGHT
+                (FORMAT NIL "~A: ~A [~A]"
+                        MIXER (NTH 3 PARSED) (NTH 5 PARSED)))))
+
+(DEFUN MAIL-INFO ()
+  (LET ((NUM (PARSE-INTEGER
+              (RUN-PROG-COLLECT-OUTPUT "/usr/bin/notmuch" "count" "tag:unread"))))
+    (IF (>= 0 NUM) "^7no unread emails^n"
+        (FORMAT NIL "~r^7 unread ~[email~:;emails~]^n" NUM (1- NUM)))))
+
+(DEFUN BATTERY-INFO ()
+  (LET* ((RAW (RUN-PROG-COLLECT-OUTPUT "/usr/bin/acpi"))
+         (BAT0 (FIRST (SPLIT-STRING RAW)))
+         (PARSED (CDR (DROPWHILE #'(LAMBDA (F) (NOT (EQ #\: (CHAR F (1- (LENGTH F))))))
+                                 (SPLIT-STRING BAT0 "[ ,]+"))))
+         (STAT (NTH 0 PARSED))
+         (PERC (NTH 1 PARSED))
+         (PNUM (PARSE-INTEGER (SUBSEQ PERC 0 (1- (LENGTH PERC)))))
+         (TIME (NTH 2 PARSED)))
+    (FORMAT NIL "~[^1~;^3~:;^2~]~c ~d%, ~a"
+            (FLOOR (* 4 (/ PNUM 100)))
+            (CHAR STAT 0)
+            PNUM         
+            (OR TIME "not charging"))))
+
+
+;; =============================================================================
+;; Commands
+
+;; Volume
+(DEFCOMMAND VOLUME-INC (MIXER) (:REST) (volume-modify MIXER :INC))
+(DEFCOMMAND VOLUME-DEC (MIXER) (:REST) (volume-modify MIXER :DEC))
+(DEFCOMMAND VOLUME-MUT (MIXER) (:REST) (volume-modify MIXER :MUT))
+
+;; Switch to stuff
+(DEFCOMMAND SELECT-GROUP-FROM-LIST () (:REST)
+  ;; lifted from group.lisp source because there weren't any nice
+  ;; wrappers like in the case of windows (below)
+  (LET* ((GROUPS (SORT-GROUPS (CURRENT-SCREEN)))
+         (NAMES (MAPCAR (LAMBDA (G)
+                          `(,(FORMAT-EXPAND *GROUP-FORMATTERS* "%t" G)
+                             . ,G))
+                        (IF *LIST-HIDDEN-GROUPS*
+                            GROUPS (NON-HIDDEN-GROUPS GROUPS))))
+         (CHOICE (CDR (SELECT-FROM-MENU (CURRENT-SCREEN) NAMES
+                                        "Switch to which group?"))))    
+    (WHEN CHOICE (SWITCH-TO-GROUP CHOICE))))
+
+(DEFCOMMAND MY-PULL-FROM-WINDOWLIST () (:REST) ; I wanted a prompt...
+  (LET ((CHOICE (SELECT-WINDOW-FROM-MENU (ALL-WINDOWS) "%n %t"
+                                         "Pull which window to this frame?")))
+    (WHEN CHOICE (PULL-WINDOW CHOICE))))
+
+;; Email
+(DEFCOMMAND CHECK-NEW-MAIL () (:REST)
+  (MY-MESSAGE :CENTER (MAIL-INFO)))
+;; Battery
+(DEFCOMMAND BATTERY-STATS () (:REST)
+  (MY-MESSAGE :CENTER (BATTERY-INFO)))
+
+;; =============================================================================
+;; Bindings
+
+;; Free stuff -- where are all these other keys being bound?
+(setf *root-map* (make-sparse-keymap))
+
+;; Volume
+(DEFINE-KEY *TOP-MAP* (KBD "XF86AudioRaiseVolume") "volume-inc Master")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86AudioLowerVolume") "volume-dec Master")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86Launch1") "volume-mut Master")
+(DEFINE-KEY *TOP-MAP* (KBD "S-XF86AudioRaiseVolume") "volume-inc Headphone")
+(DEFINE-KEY *TOP-MAP* (KBD "S-XF86AudioLowerVolume") "volume-dec Headphone")
+(DEFINE-KEY *TOP-MAP* (KBD "S-XF86Launch1") "volume-mut Headphone")
+
+;; Misc
+(DEFINE-KEY *TOP-MAP* (KBD "XF86ScreenSaver") "exec lock")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86Battery") "battery-stats")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86WebCam") "check-new-mail")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86MonBrightnessUp") "exec xbacklight -inc 10")
+(DEFINE-KEY *TOP-MAP* (KBD "XF86MonBrightnessDown") "exec xbacklight -dec 10")
+
+;; =============================================================================
+;; Root bindings
+(DEFINE-KEY *ROOT-MAP* (KBD "C-Q") "quit")
+(DEFINE-KEY *ROOT-MAP* (KBD "C-g") "abort")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "g") "gmove")
+(DEFINE-KEY *ROOT-MAP* (KBD "G") "gmerge")
+(DEFINE-KEY *ROOT-MAP* (KBD "TAB") "select-group-from-list")
+(DEFINE-KEY *ROOT-MAP* (KBD "l") "gselect def")
+(DEFINE-KEY *ROOT-MAP* (KBD "u") "gselect one")
+(DEFINE-KEY *ROOT-MAP* (KBD "y") "gselect two")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-l") "gmove def")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-u") "gmove one")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-y") "gmove two")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "s") "exec")
+(DEFINE-KEY *ROOT-MAP* (KBD "S") "swank-toggle")
+(DEFINE-KEY *ROOT-MAP* (KBD "'") "time")
+(DEFINE-KEY *ROOT-MAP* (KBD ";") "eval")
+(DEFINE-KEY *ROOT-MAP* (KBD ":") "colon")
+(DEFINE-KEY *ROOT-MAP* (KBD "K") "delete")
+(DEFINE-KEY *ROOT-MAP* (KBD "C-K") "kill")
+(DEFINE-KEY *ROOT-MAP* (KBD "q") "exec $BROWSER")
+(DEFINE-KEY *ROOT-MAP* (KBD "E") "emacs")
+(DEFINE-KEY *ROOT-MAP* (KBD "c") "exec $TERMINAL -e tmux")
+(DEFINE-KEY *ROOT-MAP* (KBD "C") "exec $TERMINAL")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "h") "hsplit")
+(DEFINE-KEY *ROOT-MAP* (KBD "v") "vsplit")
+(DEFINE-KEY *ROOT-MAP* (KBD "r") "remove")
+(DEFINE-KEY *ROOT-MAP* (KBD "a") "iresize")
+(DEFINE-KEY *ROOT-MAP* (KBD "x") "exchange-direction")
+(DEFINE-KEY *ROOT-MAP* (KBD "b") "banish")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "space") "my-pull-from-windowlist")
+(DEFINE-KEY *ROOT-MAP* (KBD "C-w") "select-window")
+(DEFINE-KEY *ROOT-MAP* (KBD "W") "pull-window-by-number")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "P") "prev-in-frame")
+(DEFINE-KEY *ROOT-MAP* (KBD "N") "next-in-frame")
+(DEFINE-KEY *ROOT-MAP* (KBD "p") "pull-hidden-previous")
+(DEFINE-KEY *ROOT-MAP* (KBD "n") "pull-hidden-next")
+
+(DEFINE-KEY *ROOT-MAP* (KBD "O") "only")
+
+(DEFINE-KEY *ROOT-MAP* (KBD ",") "move-focus left")
+(DEFINE-KEY *ROOT-MAP* (KBD ".") "move-focus right")
+(DEFINE-KEY *ROOT-MAP* (KBD "i") "move-focus up")
+(DEFINE-KEY *ROOT-MAP* (KBD "o") "move-focus down")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-.") "move-window right")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-,") "move-window left")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-i") "move-window up")
+(DEFINE-KEY *ROOT-MAP* (KBD "M-o") "move-window down")
+
+;; =============================================================================
+;; Visual
+
+;; Set the font
+(REQUIRE 'CLX-TRUETYPE)
+(LOAD-MODULE "ttf-fonts")
+(XFT:CACHE-FONTS)
+(SET-FONT (MAKE-INSTANCE 'XFT:FONT :FAMILY "DejaVu Sans Mono" :SUBFAMILY "Book" :SIZE 12))
+
+;; Modeline
+(LOAD-MODULE "fuzzytime")
+(SETF *MODE-LINE-TIMEOUT* 60
+      *SCREEN-MODE-LINE-FORMAT* '("%F ^>" (:EVAL (MAIL-INFO)) "     " (:EVAL (BATTERY-INFO)))
+      *MODE-LINE-FOREGROUND-COLOR* "black"
+      *MODE-LINE-BACKGROUND-COLOR* "#EAFFFF"
+      FUZZYTIME:*MINUTE-GRANULARITY* 5
+      FUZZYTIME:*FUZZYTIME-FORMAT* '(:MINUTES :HOURS "^7 in the ^n" :PERIOD "^7 on ^n" :DOW "^7 the ^n" :DAY))
+(TOGGLE-MODE-LINE (CURRENT-SCREEN) (CURRENT-HEAD))
+
+;; Colours
+;; TODO: Fix colours
+(SET-FOCUS-COLOR "darkred")
+(SET-UNFOCUS-COLOR "#32302f")
+(SET-WIN-BG-COLOR "black")
+(SET-BORDER-COLOR "grey30")
+(SET-FG-COLOR "black")
+(SET-BG-COLOR "#FFFFEA")
+
+;; =============================================================================
+;; Swank
+
+(QL:QUICKLOAD :SWANK)
+(REQUIRE 'SWANK)
+
+(DEFVAR *SWANK-SERVER-RUNNING* NIL)
+
+(DEFCOMMAND SWANK-TOGGLE () ()
+  (IF *SWANK-SERVER-RUNNING*
+      (PROGN
+        (SWANK:STOP-SERVER 4005)
+        (MY-MESSAGE :CENTER "Stopping swank.")
+        (SETF *SWANK-SERVER-RUNNING* NIL))
+      (PROGN
+        (SWANK:CREATE-SERVER :DONT-CLOSE T
+                             :PORT 4005)
+        (MY-MESSAGE :CENTER "Starting swank.")
+        (SETF *SWANK-SERVER-RUNNING* T))))
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))
+