stumpwm: Add hooks for (un)locking the screen

When locked, these hooks set my jabber presence to "away" and pause
MPD if it's playing. When unlocked they set my jabber presence to
"online" and resume MPD if it was playing before.

.stumpwmrc

@@ -3,6 +3,16 @@
 
 (in-package :stumpwm)
 
+(require 'cl-ppcre)
+
+(defmacro elisp (&body body)
+  "Run BODY through emacsclient."
+  `(sb-ext:run-program
+   "/usr/bin/emacsclient"
+   '("-e"
+     ,(string-downcase (format nil "~S" (cons 'progn body))))
+   :wait nil))
+
 ;; Naquadah
 (defun colour (key)
   (let ((colours (list :aluminium-1 #xeeeeec
@@ -47,6 +57,12 @@
   "The executable to run to start i3lock.")
 (defvar *urxvt-program* "urxvt"
   "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 *mpd-was-playing-p* nil
+  "Indicator of whether or not MPD was playing when it was paused.")
 
 (defun get-mail-count (mailbox &optional (inbox "inbox"))
   "Check how many new messages there are in MAILBOX."
@@ -55,6 +71,38 @@
     (format nil "/home/slash/documents/mail/~A/~A/new/*.*"
             mailbox inbox))))
 
+(defun mpd-playing-p ()
+  "Check if MPD is currently in the playing state."
+  (and (cl-ppcre:scan
+        "\\n\\[playing\\]"
+        (with-output-to-string (status)
+          (sb-ext:run-program "/usr/bin/mpc" '() :output status)))
+       t))
+
+(defun set-jabber-away ()
+  "Tell emacs to set jabber to away presence."
+  (elisp
+    (when (and (fboundp 'jabber-send-away-presence)
+               *jabber-connected*)
+      (jabber-send-away-presence))))
+
+(defun set-jabber-online ()
+  "Tel emacs to set jabber to online presence."
+  (elisp
+    (when (and (fboundp 'jabber-send-default-presence)
+               *jabber-connected*)
+      (jabber-send-default-presence))))
+
+(defun mpd-pause ()
+  "Pause MPD playback."
+  (when (setf *mpd-was-playing-p* (mpd-playing-p))
+    (sb-ext:run-program "/usr/bin/mpc" '("pause") :wait nil)))
+
+(defun mpd-play ()
+  "Resume MPD playback."
+  (when *mpd-was-playing-p*
+    (sb-ext:run-program "/usr/bin/mpc" '("play") :wait nil)))
+
 (defcommand run-emacs () ()
   "Open Emacs"
   (run-shell-command *emacs-program*))
@@ -87,9 +135,15 @@
   "Open URxvt"
   (run-or-raise *urxvt-program* '(:class "URxvt")))
 
-(defcommand run-i3lock () ()
+(defcommand lock-screen () ()
-  "Lock screen"
+  "Lock the screen using i3lock. Run *lock-screen-hook* before locking
-  (run-shell-command *i3lock-program*))
+it and run *screen-unlocked-hook* after it has been unlocked."
+  (run-hook *lock-screen-hook*)
+  (sb-ext:run-program
+   "/usr/bin/i3lock" '("-n" "-c" "000000") :wait nil
+   :status-hook (lambda (p)
+                  (when (eq (sb-ext:process-status p) :exited)
+                    (run-hook *screen-unlocked-hook*)))))
 
 (set-bg-color (colour :background))
 (set-border-color (colour :aluminium-6))
@@ -123,11 +177,16 @@
                (get-mail-count "ninthfloor")))
             '(:eval
               (format-expand *window-formatters* *window-format*
-                                   (current-window)))))
+               (current-window)))))
+
+(add-hook *lock-screen-hook* 'set-jabber-away)
+(add-hook *lock-screen-hook* 'mpd-pause)
+(add-hook *screen-unlocked-hook* 'set-jabber-online)
+(add-hook *screen-unlocked-hook* 'mpd-play)
 
 (set-prefix-key (kbd "C-z"))
 
-(define-key *top-map* (kbd "C-M-l") "run-i3lock")
+(define-key *top-map* (kbd "C-M-l") "lock-screen")
 
 (define-key *root-map* (kbd "c") "raise-urxvt")
 (define-key *root-map* (kbd "C") "run-urxvt")