206 lines
6.9 KiB
Common Lisp
206 lines
6.9 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 :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)))
|
|
|
|
(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")))
|
|
|
|
(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 :dblack))
|
|
(set-float-unfocus-color (colour :dwhite))
|
|
(set-focus-color (colour :dblack))
|
|
(set-font "-*-tamsyn-medium-r-normal-*-17-*-*-*-*-0-iso8859-1")
|
|
(set-unfocus-color (colour :dwhite))
|
|
(set-win-bg-color (colour :dwhite))
|
|
|
|
(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-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)
|