legacy-dotfiles/.stumpwmrc
Tom Willemsen 1847e330d6 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.
2013-03-27 00:42:43 +01:00

222 lines
7.4 KiB
Common Lisp

;; -*- mode: lisp; -*-
(require 'swank)
(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
:aluminium-2 #xd3d7cf
:aluminium-3 #xbabdb6
:aluminium-4 #x888a85
:aluminium-5 #x555753
:aluminium-6 #x2e3436
:butter-1 #xfce94f
:butter-2 #xedd400
:butter-3 #xc4a000
:orange-1 #xfcaf3e
:orange-2 #xf57900
:orange-3 #xce5c00
:chocolate-1 #xe9b96e
:chocolate-2 #xc17d11
:chocolate-3 #x9f5902
:chameleon-1 #x8ae234
:chameleon-2 #x73d216
:chameleon-3 #x4e9a06
:sky-blue-1 #x729fcf
:sky-blue-2 #x3465a4
:sky-blue-3 #x204a87
:plum-1 #xad7fa8
:plum-2 #x75507b
:plum-3 #x5c3566
:scarlet-red-1 #xef2929
:scarlet-red-2 #xcc0000
:scarlet-red-3 #xa40000
:background #x252a2b
:black #x0c191c
:cyan "cyan3")))
(getf colours key)))
(defvar *conkeror-program* "conkeror"
"The executable to run to start Conkeror.")
(defvar *emacs-program* "emacsclient -c -a emacs"
"The executable to run to start Emacs.")
(defvar *firefox-program* "firefox"
"The executable to run to start Firefox.")
(defvar *i3lock-program* "i3lock -c 000000"
"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."
(length
(directory
(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*))
(defcommand raise-emacs () ()
"Open or show Emacs"
(run-or-raise *emacs-program* '(:class "Emacs")))
(defcommand run-firefox () ()
"Open Firefox"
(run-shell-command *firefox-program*))
(defcommand raise-firefox () ()
"Open or show Firefox"
(run-or-raise *firefox-program* '(:class "Firefox")))
(defcommand run-conkeror () ()
"Open Conkeror"
(run-shell-command *conkeror-program*))
(defcommand raise-conkeror () ()
"Open or show Conkeror"
(run-or-raise *conkeror-program* '(:class "Conkeror")))
(defcommand run-urxvt () ()
"Open URxvt"
(run-shell-command *urxvt-program*))
(defcommand raise-urxvt () ()
"Open URxvt"
(run-or-raise *urxvt-program* '(:class "URxvt")))
(defcommand lock-screen () ()
"Lock the screen using i3lock. Run *lock-screen-hook* before locking
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))
(set-fg-color (colour :aluminium-1))
(set-float-focus-color (colour :black))
(set-float-unfocus-color (colour :aluminium-6))
(set-focus-color (colour :black))
(set-font "-*-tamsyn-medium-r-normal-*-17-*-*-*-*-0-iso8859-1")
(set-unfocus-color (colour :aluminium-6))
(set-win-bg-color (colour :background))
(setf *colors* (mapcar #'colour '(:black :scarlet-red-1 :chameleon-1
:butter-1 :sky-blue-1 :plum-1 :cyan
:aluminium-1)))
(setf *input-window-gravity* :bottom-left)
(setf *message-window-gravity* :top-right)
(setf *mode-line-background-color* (colour :background))
(setf *mode-line-border-color* (colour :aluminium-6))
(setf *mode-line-foreground-color* (colour :aluminium-1))
(setf *shell-program* (getenv "SHELL"))
(setf *transient-border-width* 1)
(setf *window-format* "%m%50t")
(setf *window-border-style* :thin)
(setf *screen-mode-line-format*
(list "[%n]"
'(:eval
(format nil " | ryu: ~D | gmail: ~D | aethon: ~D | 9f: ~D | "
(get-mail-count "ryuslash.org")
(get-mail-count "gmail")
(get-mail-count "aethon")
(get-mail-count "ninthfloor")))
'(:eval
(format-expand *window-formatters* *window-format*
(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") "lock-screen")
(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")
(define-key *root-map* (kbd "M-b") "move-window left")
(define-key *root-map* (kbd "M-f") "move-window right")
(define-key *root-map* (kbd "M-n") "move-window down")
(define-key *root-map* (kbd "M-p") "move-window up")
(define-key *root-map* (kbd "b") "move-focus left")
(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")
(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"))
(define-frame-preference "Default"
(0 t nil :class "Emacs")
(1 t nil :class "Firefox")
(1 t nil :class "URxvt")
(1 t nil :class "Conkeror"))
(if (not (head-mode-line (current-head)))
(toggle-mode-line (current-screen) (current-head)))
(swank:create-server)