legacy-dotfiles/.stumpwmrc

;; -*- 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)