Update stumpwm config

stumpwm/.stumpwmrc

@@ -1,8 +1,9 @@
 ;; -*- mode: lisp; -*-
-(require 'cl-ppcre)
 
 (in-package :stumpwm)
 
+(load (merge-pathnames ".stumpwm.d/games.lisp" (user-homedir-pathname)))
+
 (defmacro elisp (&body body)
   "Run BODY through emacsclient."
   `(sb-ext:run-program
@@ -10,30 +11,6 @@
    '("-e" ,(string-downcase (format nil "~S" (cons 'progn body))))
    :wait nil))
 
-;; Naquadah
-(defun colour (key)
-  (let ((colours (list :gray1      #x111111
-                       :gray5      #xc2c2c2
-                       :gray6      #xededed
-                       :blue3      #x152e54
-                       :lwhite     #xa5a5a4 :dwhite     #x222224
-                       :lred       #xbf6d6d :dred       #x744a4a
-                       :lorange    #xbfa47d :dorange    #x73634a
-                       :lyellow    #xb2bf6d :dyellow    #x6b734a
-                       :lgreen     #x8abf6d :dgreen     #x52734a
-                       :lturquoise #x7dbf97 :dturquoise #x4a735b
-                       :lcyan      #x7dbfbf :dcyan      #x4a7373
-                       :lblue      #x6d97bf :dblue      #x4a5b73
-                       :lpurple    #x8a7dbf :dpurple    #x524a73
-                       :lmagenta   #xb27dbf :dmagenta   #x6b4a73
-                       :lpink      #xbf6da4 :dpink      #x734a63)))
-    (getf colours key)))
-
-(setf *app-menu* '(("Editor" . "emacs")
-                   ("Browser" . "conkeror")
-                   ("Terminal" . "urxvt")
-                   ("Office" . "libreoffice")
-                   ("Gimp" . "gimp")))
 (defvar *conkeror-program* "conkeror"
   "The executable to run to start Conkeror.")
 (defvar *emacs-program* "emacsclient -c -a \"\""
@@ -42,12 +19,18 @@
   "The executable to run to start Firefox.")
 (defvar *i3lock-program* "i3lock -c 000000"
   "The executable to run to start i3lock.")
-(defvar *urxvt-program* "urxvt"
+(defvar *urxvt-program* "urxvtc"
   "The executable to run to start URxvt.")
 (defvar *lock-screen-hook* nil
   "Hook run right before the screen gets locked.")
 (defvar *screen-unlocked-hook* nil
   "Hook run right after the screen is unlocked.")
+(defvar *desktop-bindings*
+  (let ((m (make-sparse-keymap)))
+    (define-key m (kbd "s") "save-desktop-configuration")
+    (define-key m (kbd "l") "load-desktop-configuration")
+    m)
+  "Special keymap for desktop management commands.")
 
 (defun get-mail-count (mailbox &optional (inbox "inbox"))
   "Check how many new messages there are in MAILBOX."
@@ -63,6 +46,32 @@
                 (format nil "/home/slash/documents/mail/~A/~A/cur/*.*"
                         mailbox inbox))))))
 
+(defun build-mail-part (&optional accumulator value)
+  (if value
+      (destructuring-bind (name . mailbox) value
+        (let ((number (get-mail-count mailbox)))
+          (if (> (or number 0) 0)
+              (if accumulator
+                  (concatenate 'string accumulator
+                               (format nil " | ~a: ~d" name number))
+                  (format nil "~a: ~d" name number))
+              accumulator)))
+      accumulator))
+
+(defun build-mail-string ()
+  (reduce #'build-mail-part
+          '(("ryu" . "ryuslash.org")
+            ("gmail" . "gmail")
+            ("9f" . "ninthfloor")) :initial-value nil))
+
+(defun dunst-pause ()
+  "Pause dunst"
+  (sb-ext:run-program "/usr/bin/killall" '("-SIGUSR1" "dunst")))
+
+(defun dunst-start ()
+  "Start dunst"
+  (sb-ext:run-program "/usr/bin/killall" '("-SIGUSR2" "dunst")))
+
 (defun mpd-playing-p ()
   "Check if MPD is currently in the playing state."
   (and (cl-ppcre:scan
@@ -88,14 +97,30 @@
 (let (mpd-was-playing)
   (defun mpd-pause ()
     "Pause MPD playback."
-    (when (setf mpd-was-playing-p (mpd-playing-p))
+    (when (setf mpd-was-playing (mpd-playing-p))
       (sb-ext:run-program "/usr/bin/mpc" '("pause") :wait nil)))
 
   (defun mpd-play ()
     "Resume MPD playback."
-    (when mpd-was-playing-p
+    (when mpd-was-playing
       (sb-ext:run-program "/usr/bin/mpc" '("play") :wait nil))))
 
+(defun cleanup-frame (window)
+  (let ((cg (current-group)))
+   (unless (frame-windows cg (tile-group-current-frame cg))
+     (run-commands "remove"))))
+
+(defcommand emacs-move-focus (dir) ((:direction "Direction: "))
+  "Move focus in direction DIR.
+
+If the current window is an Emacs window, let it handle the event
+itself."
+  (let ((cw (current-window)))
+    (if (and cw (string= (window-class cw) "Emacs"))
+        (send-fake-key
+         cw (kbd (format nil "S-~a" (string-capitalize dir))))
+        (move-focus dir))))
+
 (defcommand run-emacs () ()
   "Open Emacs"
   (run-shell-command *emacs-program*))
@@ -128,6 +153,30 @@
   "Open URxvt"
   (run-or-raise *urxvt-program* '(:class "URxvt")))
 
+(defcommand save-desktop-configuration () ()
+  "Save the current desktop configuration."
+  (dump-desktop-to-file "~/.stumpwm.d/desktop.lisp"))
+
+(defcommand load-desktop-configuration () ()
+  "(Re)load the current desktop configuration."
+  (restore-from-file "~/.stumpwm.d/desktop.lisp"))
+
+(defcommand hsplit-and-balance () ()
+  "Run hsplit followed by balance-frames."
+  (run-commands "hsplit" "balance-frames"))
+
+(defcommand vsplit-and-balance () ()
+  "Run vsplit followed by balance-frames."
+  (run-commands "vsplit" "balance-frames"))
+
+(defun split-and-remove (&rest ignored)
+  (run-commands "vsplit" "balance-frames")
+  (remove-hook *new-window-hook* 'split-and-remove))
+
+(defcommand urxvt-split-balance () ()
+  (add-hook *new-window-hook* 'split-and-remove)
+  (run-shell-command *urxvt-program*))
+
 (defun run-stumpwm-hook-on-exit (process)
   "Run `*screen-unlocked-hook*' if PROCESS' status is `:exited'."
   (when (eq (sb-ext:process-status process) :exited)
@@ -143,56 +192,87 @@ Run `*lock-screen-hook*' before locking it and run
    "/usr/bin/i3lock" '("-n" "-c" "000000") :wait nil
    :status-hook #'run-stumpwm-hook-on-exit))
 
-(set-bg-color (colour :dwhite))
+(defgame beatbuddy 231040 :type steam)
-(set-border-color (colour :lwhite))
+(defgame fez 224760 :type steam)
-(set-fg-color (colour :gray5))
+(defgame guacamelee 214770 :type steam)
-(set-float-focus-color (colour :lblue))
+(defgame monaco 113020 :type steam)
-(set-float-unfocus-color (colour :dwhite))
+(defgame portal 400 :type steam)
-(set-focus-color (colour :lblue))
+(defgame swapper 231160 :type steam)
-(set-font "-*-tamsyn-medium-r-normal-*-17-*-*-*-*-0-iso8859-1")
+(defgame dust 236090 :type steam)
-(set-unfocus-color (colour :dwhite))
+(defgame antichamber "Antichamber/Antichamber.sh" :type direct)
-(set-win-bg-color (colour :gray1))
+(defgame biomenace-1 "biomenace/BMENACE1.EXE" :type dos)
+(defgame biomenace-2 "biomenace/BMENACE2.EXE" :type dos)
+(defgame biomenace-3 "biomenace/BMENACE3.EXE" :type dos)
+(defgame command-and-conquer "command_and_conquer/cnc_en.com" :type dos)
+(defgame dune "dune/DUNE.BAT" :type dos)
+(defgame shufflepuck "shufflepuck/SHUFFLE.COM" :type dos)
+(defgame skyroads "skyroads/SKYROADS.EXE" :type dos)
+(defgame theme-park "theme_park/PARK.BAT" :type dos)
+(defgame xcom "UFO/UFO.BAT" :type dos)
+(defgame volfied "Volfied/volfied.exe" :type dos)
 
-(setf *colors* (mapcar #'colour '(:lwhite :lred :lgreen :lyellow :lblue
+(set-bg-color "#111111")
-                                  :lmagenta :lcyan :gray5)))
+(set-border-color "#bfbfbf")
+(set-fg-color "#c2c2c2")
+(set-float-focus-color "#6d97bf")
+(set-float-unfocus-color "#222224")
+(set-focus-color "#6d97bf")
+(set-font "-lispm-*-*-*-*-*-*-*-*-*-*-*-*-*")
+(set-unfocus-color "#222224")
+(set-win-bg-color "#111111")
+
+(setf *colors* '("#a5a5a4" "#bf6d6d" "#8abf6d" "#b2bf6d"
+                 "#6d97bf" "#b27dbf" "#7dbfbf" "#c2c2c2"))
 (setf *input-window-gravity* :center)
 (setf *message-window-gravity* :top-right)
-(setf *mode-line-background-color* (colour :blue3))
+(setf *mode-line-background-color* "#111111")
-(setf *mode-line-border-color* (colour :blue3))
+(setf *mode-line-border-width* 0)
-(setf *mode-line-foreground-color* (colour :gray5))
+(setf *mode-line-pad-y* 3)
+(setf *mode-line-foreground-color* "#c2c2c2")
+(setf *mode-line-position* :bottom)
 (setf *shell-program* (getenv "SHELL"))
 (setf *transient-border-width* 1)
 (setf *window-border-style* :thin)
 (setf *screen-mode-line-format*
-      (list "[%n]"
+      (list "[%n] "
             '(:eval
-              (format nil " | ryu: ~D | gmail: ~D | aethon: ~D | 9f: ~D | "
+              (or (ignore-errors (window-title (current-window)))
-               (get-mail-count "ryuslash.org")
+               "Unknown"))
-               (get-mail-count "gmail")
+            "^>"
-               (get-mail-count "aethon")
+            '(:eval (build-mail-string))
-               (get-mail-count "ninthfloor")))))
+            "  "))
 
 (add-hook *lock-screen-hook* 'set-jabber-away)
 (add-hook *lock-screen-hook* 'mpd-pause)
+;; (add-hook *lock-screen-hook* 'dunst-pause)
 (add-hook *screen-unlocked-hook* 'set-jabber-online)
 (add-hook *screen-unlocked-hook* 'mpd-play)
+;; (add-hook *screen-unlocked-hook* 'dunst-start)
+(add-hook *destroy-window-hook* 'cleanup-frame)
 
 (set-prefix-key (kbd "C-z"))
 
 (define-key *top-map* (kbd "C-M-l") "lock-screen")
 (define-key *top-map* (kbd "XF86AudioLowerVolume") "exec mpc volume -5")
-(define-key *top-map* (kbd "XF86AudioMute")
+(define-key *top-map* (kbd "XF86AudioMute") "exec amixer sset Master toggle")
-  "exec amixer sset Master toggle")
 (define-key *top-map* (kbd "XF86AudioNext") "exec mpc next")
 (define-key *top-map* (kbd "XF86AudioPlay") "exec mpc toggle")
 (define-key *top-map* (kbd "XF86AudioPrev") "exec mpc prev")
 (define-key *top-map* (kbd "XF86AudioRaiseVolume") "exec mpc volume +5")
+(define-key *top-map* (kbd "s-R") "remove")
+(define-key *top-map* (kbd "s-S") "hsplit-and-balance")
+(define-key *top-map* (kbd "s-b") "emacs-move-focus left")
+(define-key *top-map* (kbd "s-c") "raise-urxvt")
+(define-key *top-map* (kbd "s-e") "raise-emacs")
+(define-key *top-map* (kbd "s-f") "emacs-move-focus right")
+(define-key *top-map* (kbd "s-n") "emacs-move-focus down")
+(define-key *top-map* (kbd "s-p") "emacs-move-focus up")
+(define-key *top-map* (kbd "s-s") "vsplit-and-balance")
+(define-key *top-map* (kbd "s-w") "raise-conkeror")
+(define-key *top-map* (kbd "s-!") "exec")
 
-(define-key *root-map* (kbd "c") "raise-urxvt")
 (define-key *root-map* (kbd "C") "run-urxvt")
-(define-key *root-map* (kbd "e") "raise-emacs")
 (define-key *root-map* (kbd "E") "run-emacs")
-(define-key *root-map* (kbd "w") "raise-conkeror")
 (define-key *root-map* (kbd "W") "run-conkeror")
 
 (define-key *root-map* (kbd "C-b") "windowlist")
@@ -204,11 +284,18 @@ Run `*lock-screen-hook*' before locking it and run
 (define-key *root-map* (kbd "f") "move-focus right")
 (define-key *root-map* (kbd "n") "move-focus down")
 (define-key *root-map* (kbd "p") "move-focus up")
+(define-key *root-map* (kbd "SPC") "next-in-frame")
+(define-key *root-map* (kbd "C-z") "other-in-frame")
+(define-key *root-map* (kbd "d") '*desktop-bindings*)
 
 (undefine-key *root-map* (kbd "C-a"))
 (undefine-key *root-map* (kbd "C-c"))
 (undefine-key *root-map* (kbd "C-e"))
 (undefine-key *root-map* (kbd "C-m"))
+(undefine-key *root-map* (kbd "S"))
+(undefine-key *root-map* (kbd "s"))
+(undefine-key *root-map* (kbd "e"))
+(undefine-key *root-map* (kbd "c"))
 
 (define-frame-preference "Default"
     (0 t nil :class "Emacs")
@@ -223,5 +310,9 @@ Run `*lock-screen-hook*' before locking it and run
  (concatenate 'string (sb-ext:posix-getenv "HOME")
               "/.stumpwm.d/desktop.lisp"))
 
+(ignore-errors (load-module "stumptray"))
+(load "~/.local/share/quicklisp/local-projects/stumpwm/contrib/util/stumptray/stumptray.lisp")
+(stumptray::stumptray)
+
 (ql:quickload "swank")
 (swank:create-server :dont-close t)