legacy-dotfiles/.stumpwmrc
2013-05-15 17:35:51 +02:00

193 lines
6.8 KiB
Common Lisp

;; -*- mode: lisp; -*-
; (require 'swank)
(require 'cl-ppcre)
(in-package :stumpwm)
;; (load "/usr/share/stumpwm/contrib/app-menu.lisp")
(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 :lblack #xeeeeec :dblack #x111113
;; :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 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
(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 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))))
(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")))
(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))
;; (set-bg-color (colour :dwhite))
;; (set-border-color (colour :lwhite))
;; (set-fg-color (colour :lblack))
;; (set-float-focus-color (colour :lblue))
;; (set-float-unfocus-color (colour :dwhite))
;; (set-focus-color (colour :lblue))
;; (set-font "-*-tamsyn-medium-r-normal-*-17-*-*-*-*-0-iso8859-1")
;; (set-unfocus-color (colour :dwhite))
;; (set-win-bg-color (colour :dblack))
;; (setf *colors* (mapcar #'colour '(:lwhite :lred :lgreen :lyellow :lblue
;; :lmagenta :lcyan :lblack)))
(setf *input-window-gravity* :bottom-left)
(setf *message-window-gravity* :top-right)
;; (setf *mode-line-background-color* (colour :dwhite))
;; (setf *mode-line-border-color* (colour :dwhite))
;; (setf *mode-line-foreground-color* (colour :lblack))
(setf *shell-program* (getenv "SHELL"))
(setf *transient-border-width* 1)
(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")))))
(add-hook *lock-screen-hook* 'set-jabber-away)
(add-hook *screen-unlocked-hook* 'set-jabber-online)
(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")
(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)))
; (swank:create-server)