legacy-dotfiles/stumpwm/.stumpwmrc

;; -*- mode: lisp; -*-

(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
   "/usr/bin/emacsclient"
   '("-e" ,(string-downcase (format nil "~S" (cons 'progn body))))
   :wait nil))

(defvar *conkeror-program* "conkeror"
  "The executable to run to start Conkeror.")
(defvar *emacs-program* "emacsclient -c -a \"\""
  "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* "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."
  (length
   (append
    (directory
     (format nil "/home/slash/documents/mail/~A/~A/new/*.*"
             mailbox inbox))
    (remove-if (lambda (d)
                 (let ((dir (namestring d)))
                   (string= dir "S" :start1 (1- (length dir)))))
               (directory
                (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")
            ("pfx" . "picturefix")) :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
        "\\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))))

(let (mpd-was-playing)
  (defun mpd-pause ()
    "Pause MPD playback."
    (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
      (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*))

(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 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)
    (run-hook *screen-unlocked-hook*)))

(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 #'run-stumpwm-hook-on-exit))

(defgame beatbuddy 231040 :type steam)
(defgame fez 224760 :type steam)
(defgame guacamelee 214770 :type steam)
(defgame monaco 113020 :type steam)
(defgame portal 400 :type steam)
(defgame swapper 231160 :type steam)
(defgame dust 236090 :type steam)
(defgame antichamber "Antichamber/Antichamber.sh" :type direct)
(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)

(set-bg-color "#111111")
(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* "#111111")
(setf *mode-line-border-width* 0)
(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] "
            '(:eval
              (or (ignore-errors (window-title (current-window)))
               "Unknown"))
            "^>"
            '(:eval (build-mail-string))
            "  "))

(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") "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") "run-urxvt")
(define-key *root-map* (kbd "E") "run-emacs")
(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")
(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")
  (2 t nil :class "Firefox")
  (1 t nil :class "URxvt")
  (2 t nil :class "Conkeror"))

(if (not (head-mode-line (current-head)))
    (toggle-mode-line (current-screen) (current-head)))

(restore-from-file
 (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")
(ql:quickload "stumptray")
(stumptray:stumptray)

(ql:quickload "swank")
(swank:create-server :dont-close t)