Init

1 files changed, 236 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))))