User:Gwern/.stumpwmrc

From Wikipedia, the free encyclopedia

Please note that I do not use Stumpwm and have not for years since the early alphas of Xmonad began development; this .stumpwmrc is almost certainly broken & outdated. You may find my xmonad.hs of interest.

;; -*-lisp-*-
;;.stumpwmrc --- my own Stumpwm customizations
;;Copyright (C) 2006 by gwern
;;Author: gwern <gwern0@gmail.com>
;;License: public domain
;;Where: <http:en.wikipedia.org/wiki/User:Gwern/.stumpwmrc>
;;When:  Time-stamp: "2007-01-28 22:04:22 gwern"
;;Keywords: local,customization,Stumpwm
;;Commentary: Modifies visual appearance of mode-line, input box, X windows; adds numerous key bindings
;;and heavily integrates Surfraw shortcuts. Includes some helper/utility functions.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;Global variables;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Declare our default programs for certain things, and how visually things will look,
;;;for the mode line, the input box, etc.

;;Declare what this file is for.
(in-package :stumpwm)

;;Stumpwm crashes or freezes too much. If we set the debug up to ludicoursly high levels, maybe we'll learn something.
(setf stumpwm::*debug-level* 10)

;Variables
;;Terminals are important.(
(defparameter X-TERM "exec aterm -fn '-lispm-fixed-medium-r-normal-*-13-*-*-*-*-*-*-*' -sh 15 -tr -trsb -cr yellow -pr green -bl +vb -ut +sr -sl 1000 +rv -fade 50 -fg white -bgtype scale -txttype true -bd black +sb -tint purple "
  "What shall be the command run when we want an X terminal?")

;;I don't really want to be constantly typing "concatenate 'string" - this simplifies things.
;;Thanks to sabetts of #stumpwm
(defun cat (&rest strings) "Concatenates strings, like the Unix command 'cat'. A shortcut for (concatenate 'string foo bar)."
       (apply 'concatenate 'string strings))

;;Text browsers are good, too.
(defparameter X-TERM-BROWSER (cat X-TERM  " -e elinks")
  "We will want to open up our chosen CLI web browser in our chosen X terminal. What is it?")

;;Yay for GUI web browsing!
(defparameter X-WWW-BROWSER "exec firefox "
  "What GUI WWW browser shall we use?")

;;Image viewers can be useful.
(defparameter X-IMAGE-VIEWER "exec gqview "
  "Sometimes I like to look at images. We need some sort of client for that.")

;;Set the default shell
(setf *shell-program* (stumpwm::getenv "SHELL")) ;getenv is not exported

;;Window border colors
(setf *focus-color* "green")
(setf *unfocus-color* "black")

;;Set the font for the input box. I have a nifty Lisp machine font.
(set-font "-lispm-fixed-medium-r-normal-*-13-*-*-*-*-*-*-*")

;;Set the message and input box to the bottom right. This way it overlaps with mode-line.
(setf *message-window-gravity* :bottom-right)
(setf *input-window-gravity* :bottom-right)

;;Colors for the input box; these should fairly self-explanatory. 'set-fg-color' will change the color
;;of the font in the echo area, for example, and the background will be green,
;;and the rectangle's lines will be a thin yellow, of course.
(set-bg-color "black")
(set-fg-color "lightgreen")
(set-border-color "yellow")

;;Specifically, I want mode line to display the result of having the shell create a string
;;of the concatenation of a space and the output of the 'date' program.
(setf stumpwm:*screen-mode-line-format*
      (list "%w|%g|"
	    '(:eval (stumpwm:run-shell-command "date +%_I:%M:%S%p--%e-%a|tr -d [:cntrl:]" t))))

(defun update-mode-line () "Update the mode-line sooner than usual."
  (let ((screen (current-screen)))
    (when (screen-mode-line screen)
      (redraw-mode-line-for (screen-mode-line screen) screen))))

;;SBCL-specific; only runs if SBCL is running
;;Call update-mode-line in such and such a way. Borrowed from Luigi Panzeri.
#+sbcl (defparameter *mode-line-timer* (sb-ext:make-timer
				 #'update-mode-line
				 :name "mode-line-updating"
				 :thread (car (last (sb-thread:list-all-threads)))))
;;Call a function given by the parameter every 30 seconds. This will increment the stuff in the mode-line.
#+sbcl (sb-ext:schedule-timer *mode-line-timer* 5 :repeat-interval 60 :absolute-p nil)

;;I just don't like zero indexing frames/windows. 0 is not next to 1
;;on the keyboard!  See
;;<http://lists.gnu.org/archive/html/stumpwm-devel/2006-08/msg00002.html>
(setf *frame-number-map* "1234567890") ;doesn't seem to work right now

;; Colors for the mode-line. Should be fairly self-explanatory.
;;"Where should the mode line be displayed? :top or :bottom."
(setf *mode-line-screen-position* :bottom)

;;"Where should the mode line be displayed? :top or :bottom."
(setf *mode-line-frame-position* :bottom)

;;"How thick shall the mode line border be?"
(setf *mode-line-border-width* 0)

;;"How much padding should be between the mode line text and the sides?"
(setf *mode-line-pad-x* 6)

;;"Define mode line background color."
(setf *mode-line-background-color* "black")

;;"Define mode line foreground color."
(setf *mode-line-foreground-color* "lightgreen")

;;"Define mode line border color."
(setf *mode-line-border-color* "lightyellow")

;;Call our first group Firefox, since that's what I usually use in it.
(setf (group-name (first (screen-groups (current-screen)))) "Firefox")
(stumpwm::run-commands "gkill Emacs"
		       "gnewbg Emacs") ;Remember, only one group exists by default

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;Functions, aliases, macros;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Useful things. Usually defining new Stumpwm commands.

(defun shell-command (command) "Run a shell command and display output to screen.
This must be used in a functional side-effects-free style! If a program does not
exit of its own accord, Stumpwm might hang!"
       (check-type command string)
       (echo-string (current-screen) (run-shell-command command t)))

(define-stumpwm-command "shell-command" ((command :string "sh: " :string))
  (check-type command string)
  (shell-command command))

;;Leaving open the option to use Conkeror, a skin over Firefox.
;;Wish I could get sane tabbed browsing in it...
(define-stumpwm-command "conkeror" ()
  (run-or-raise "firefox -chrome chrome://conkeror/content"
                :class "Firefox-bin"))

;;Query ACPI and show the battery's status.
(define-stumpwm-command "show-battery" ()
  (echo-string (current-screen) (run-shell-command "acpi" t)))

;;Briefly display a single frame from the top command and bind to a key.
;;Inspiration: <http://hocwp.free.fr/temp/stumpwmrc>
(define-stumpwm-command "run-top" ()
  (shell-command "top -b -n 1 -c -d 1"))

(define-stumpwm-command "emacs" ()
  (run-or-raise "emacs -T EMACS" :title "EMACS"))

(define-stumpwm-command "firefox" ()
  (run-or-raise "firefox" :class "Firefox-bin"))

(define-stumpwm-command "image-viewer" ()
  (run-or-raise X-IMAGE-VIEWER :class "Image-viewer"))

;;;;Automatically dump a core file when we quit. .xinitrc will try to exec ~/bin/sbcl-stumpwm-core
(define-stumpwm-command "quit" ()
  (sb-ext:save-lisp-and-die "/home/gwern/bin/sbcl-stumpwm-core" :executable t :toplevel #'stumpwm:stumpwm))

;;;Web browsing commands
;;Get the X selection and order the GUI browser to open it. Presumably it is a HTTP address.
(define-stumpwm-command "open-selection-browser" ()
  (run-shell-command (cat X-WWW-BROWSER (get-x-selection))))

;;Ask user for a search string and search Wikipedia for it.
(define-stumpwm-command "wikipedia" ((search-string :string "wikipedia " :string))
  (check-type search-string string)
  (run-shell-command (cat "surfraw wikipedia " search-string)))

;;Get the X selection and search for it in Wikipedia.
(define-stumpwm-command "wikipedia-selection" ()
  (run-shell-command (cat "exec surfraw wikipedia " (get-x-selection))))

;;Ask user for a search string and search Google for it.
(define-stumpwm-command "google" ((search-string :string "google " :string))
  (check-type search-string string)
  (run-shell-command (cat "surfraw google " search-string)))

;;Get the X selection and search for it through Google.
(define-stumpwm-command "google-selection" ()
  (run-shell-command (cat "exec surfraw google " (get-x-selection))))

;;Ask user for a search string and search the Internet Archive/Wayback Machine for it.
(define-stumpwm-command "wayback" ((search-string :string "wayback " :string))
  (check-type search-string string)
  (run-shell-command (cat "surfraw wayback " search-string)))

;;Get the X selection (an HTTP address) and search for it in the Internet Archive.
(define-stumpwm-command "wayback-selection" ()
  (run-shell-command (cat "exec surfraw wayback " (get-x-selection))))

;;Ask user for a search string and look for a Debian package of the same name.
(define-stumpwm-command "debpackages" ((search-string :string "debpackages " :string))
  (check-type search-string string)
  (run-shell-command (cat "surfraw debpackages " search-string)))

;;Ask user for a search string and search the Debian BTS for a package of that name.
(define-stumpwm-command "debbugs" ((search-string :string "debbugs " :string))
  (check-type search-string string)
  (run-shell-command (cat "surfraw debbugs " search-string)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;Startup programs;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;What programs do we run on startup?

;;Great! Let's start mode-line for all screens!
(screen-mode-line-mode (current-screen) t)

;;Do some key re-mapping; it is crucial that this get run first, because otherwise
;;the remapping later on of Insert and less to the prefix key simply will not work.
(run-shell-command "xmodmap -quiet ~/.Xmodmap")

;;Apparently modifies some low-level GUI bits of X.
(run-shell-command "xrdb -load ~/.Xresources -quiet")

;;Change the background and pointer in X
(run-shell-command "xsetroot -cursor_name left_ptr -gray -fg darkgreen -bg black -name root-window")

;;Always good to have a shell
(run-shell-command X-TERM)

;;Have a nice, randomly selected image from my ~/pics directory made the root window background.
;;This is actually a shell script command; one needs the #!/bin/bash shebang in the shell script
;;or an explicit invocation of the shell, like "bash ~/bin/random-picture.sh".
(run-shell-command "random-picture")
;;(run-shell-command "bash xsetbg -border black -fork -type png -fit -onroot -fullscreen
;;~/pics/`w=(*.png); n=${#w[@]}; echo ${w[RANDOM%n]}`") ;full version

;;;This is an alternative- setting Electric Sheep as the background.
;;(run-shell-command "killall electricsheep 2>/dev/null; electricsheep --root 1 --nick gwern --zoom 1 --mplayer 1 --history 50")

;;Run unclutter so the mouse hangs around no longer than needed.
(run-shell-command "unclutter -idle 1 -jitter 2 -root")

;;I use Xscreensaver as a screensaver. The first line makes sure any running Xscreensaver is killed.
;;The second run regardless of the success of the first & starts a background Xscreensaver daemon
(run-shell-command "xscreensaver-command -exit; killall xscreensaver 2>/dev/null; xscreensaver")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;Key binding;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Make the bindings more comfortable.

;;Set the *prefix-key*. The main feature of note is the changing of
;;the escape sequence from 2 keys, C-t, to a single key,
;;and the mirroring of less with another key, so there are actually 2 equivalent escape keys.
(set-prefix-key (kbd "<"))

;;When not in Stumpwm mode, we want Insert to be bound to enter Stumpwm mode
(define-key *top-map* (kbd "Insert") '*root-map*)
(define-key *root-map* (kbd "Insert") "next") ;;When in Stumpwm mode, act like hitting the prefix again would.

;;You remember what run-top did, don't you? Defined in the functions section.
(define-key *root-map* (kbd "&") "run-top")

;;Ditto for show-battery.
(define-key *root-map* (kbd "*") "show-battery")

;;Allow short displays of shell output. Don't run GUI programs through this! Overrides default.
(define-key *root-map* (kbd "!") "shell-command")

;;Browse somewhere with the GUI WWW browser.
(define-key *root-map* (kbd "b") (cat "colon " X-WWW-BROWSER " http://www."))
(define-key *root-map* (kbd "B") "open-selection-browser")

;;SSH somewhere in the default terminal.
(define-key *root-map* (kbd "C-s") (cat "colon " X-TERM " -e ssh "))

;;More SSH.
(define-key *root-map* (kbd "X")  (cat X-TERM "-e ssh -X root@127.0.0.1 aterm"))

;;Terminals. S-c does a regular terminal, and S-C allows a single command.
(define-key *root-map* (kbd "c") X-TERM)

;;S-C is supposed to ask for a command to run in a new terminal. So, we need the colon command,
;;combined with our default X terminal, and since that is Aterm, the option to run a command is '-e', so we need that as well.
(define-key *root-map* (kbd "C") (cat "colon " X-TERM " -e "))

;;Firefox binding.
(define-key *root-map* (kbd "d") "firefox") ;"firefox" is defined in functions

;;Bindings for minimalistic CLI/GUI web browsers.
(define-key *root-map* (kbd "D") X-TERM-BROWSER)

;;Shortcut for Emacs. Emacsclient is called, but it expects a filename.
;;This can be circumvented by instructing it to instead evaluate a Emacslisp expression -
;;the current one - says "open up a new frame on the current display device".
;;It has to be quoted or else sh will try to open up the lisp expression in a sub-shell
;;as a shell command. Neatly, if an Emacs isn't already running, then Emacsclient runs
;;$EDITOR, which points back to regular Emacs!
(define-key *root-map* (kbd "E") "exec emacsclient -a emacs -t EMACS")
(define-key *root-map* (kbd "e") "emacs") ;"emacs" is defined in functions.

;;Shortcut for Nano
(define-key *root-map* (kbd "M-E") (cat "colon " X-TERM " -e nano"))

;;Image viewer
(define-key *root-map* (kbd "v") "image-viewer") ;;"image-viewer" is defined in functions.

;;Apparently stump's default does something weird on my latop's screen. This should fix it.
(define-key *root-map* (kbd "s") "vsplit")
(define-key *root-map* (kbd "S") "hsplit")

;;Binding for Xpdf
(define-key *root-map* (kbd "x") "exec xpdf")

;;Make prtscreen work, as long as in command mode. "import" is an Imagemagick command.
(define-key *root-map* (kbd "Print") "exec import -window root png:$HOME/xwd-$(date +%s)$$.png")

;;'Swounds, I'm gonna need a separate section just for Surfraw shortcuts.
;;Anyway, the model for these (thanks to aon) is to bind a key to "colon exec surfraw wikipedia "
;;(or whatever the site is) note the space. If the space isn't there, then the user will need to
;;manually add a space, which is not good. In the shell, one can omit the surfraw command, but
;;not in stumpwm, as stumpwm's PATH currently does not seem to include the directory with the elvi in it.
;;List of useful surfraw elvi follows:
;;amazon bbcnews cia cite cnn debbugs debcontents deblists deblogs debpackages debpts deja dmoz ebay etym
;;freshmeat google imdb rfc rhyme slashdot sourceforgen translate

;;Surfraw keybindings.
(define-key *root-map* (kbd "t") "wikipedia")
(define-key *root-map* (kbd "T") "wikipedia-selection")

(define-key *root-map* (kbd "g") "google ")
(define-key *root-map* (kbd "G") "google-selection")

(define-key *root-map* (kbd "y") "wayback ")
(define-key *root-map* (kbd "Y") "wayback-selection")

(define-key *root-map* (kbd "u") "debbugs ")
(define-key *root-map* (kbd "U") "debpackages ")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;Groups;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Change various group things.

;;Refer to user.lisp
;;Currently, when one hits S-g, one enters group-mode, wherein the keys
;;are rebound to serve as group movement commands. I might want to change this.
;;(define-key (kbd "`") '*groups-map*)

;;Two quick and easy shortcuts - one to switch rapidly between groups and another to list them.
;;Anything more elaborate can be done by going through group-mode.
(define-key *root-map* (kbd "~") "vgroups")
(define-key *root-map* (kbd "quoteleft") "gprev")


;;If the current window is Emacs, let's ban it to the Emacs group. This loses a bit of flexibility,
;;but it means startups will be more pleasant. The remove-hook should mean Emacs gets moved only once.
;;And yes, you do actually need a defun and a add-hook to guarantee sticking an application into a particular group.
;;TODO: generalize this
(defun move-emacs (window)  "Move emacs to the Emacs group."
       (if (string= (window-class window) "Emacs")
	   (stumpwm::run-commands "gmove Emacs"))
       (remove-hook stumpwm::*map-window-hook* 'move-emacs)
       )
(stumpwm:add-hook *map-window-hook* 'move-emacs)

;;Automatically open up another virtual desktop; in a surprising show of originality, I will name it Emacs,
;;since that's what I usually use in it.
(stumpwm::run-commands
 "gselect Emacs"
 "emacs") ;;Because of the previous defun and hook, the emacs will be moved to the right group automatically

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;Pasting;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Loads in some functions to allow multiple registers (think Emacs-style). Binds to numerical keys.
;;See <http://stumpwm.elektrubadur.se/cgi-bin/wiki/paste.lisp>
(load "/home/gwern/bin/paste.lisp")


;;;;I don't quite understand this stuff yet. It's ripped from Luigi Panzeri's .stumpwmrc, and he's doing some interesting stuff
;;;;which seems powerful but which I haven't yet figured out what it is doing, much less why.
;;   ____
;;  / ___|_ __  ___  _   _ _ __   ___
;; | |  _| '__|/ _ \| | | | '_ \ / __|
;; | |_| | |  | (_) | |_| | |_) |\__ \
;;  \____|_|   \___/ \__,_| .__/ |___/
;;                        |_|

(defun find-group-by-name (name)
 (find name (screen-groups (current-screen)) :test #'string-equal :key #'group-name))

(defun place-windows-on-group (group &key class)
 (lambda (win)
   (when (string-equal (window-class win) class)
     (move-window-to-group win group))))

(defun place-windows-on-frame (group frame &key class)
 (lambda (win)
   (when (string-equal (window-class win) class)
     (move-window-to-group win group)
     (setf (window-frame win) frame)
;      (sync-frame-windows group frame)
     (echo-string (current-screen) (format nil "Window ~a placed in group ~a" (window-name win) (group-name group))))))

(defun horiz-split-frame-and-resize (group fraction)
 (horiz-split-frame group)
 (let ((frame (tile-group-current-frame group)))
   (resize-frame group
                 frame
                 (truncate (* (- (* 2 fraction) 1) (frame-width frame)))
                 'width)))

(defun vert-split-frame-and-resize (group fraction)
 (vert-split-frame group)
 (let ((frame (tile-group-current-frame group)))
   (resize-frame group
                 frame
                 (truncate (* (- (* 2 fraction) 1) (frame-height frame)))
                 'height)))

(defmacro horizontally (&rest frame-specs)
 `(let ((accum 1)
        (frame-specs (sort ',frame-specs (lambda (el1 el2)
                                              (cond
                                                ((not (numberp el1)) nil)
                                                ((not (numberp el2)) t))))))
    (dolist (frame-spec (butlast frame-specs))
      (destructuring-bind (fraction window-queries) frame-spec
        (when (numberp fraction)
          (decf accum fraction))
        (horiz-split-frame-and-resize group (if (numberp fraction) fraction accum))
        (dolist (window-query window-queries)
          (ecase (car window-query)
            (:class (add-hook *map-window-hook*
                              (place-windows-on-frame group (tile-group-current-frame group) :class (cadr window-query)))))))
        (focus-frame-sibling group))
    (destructuring-bind (fraction window-queries) (car (last frame-specs))
      (declare (ignore fraction))
      (dolist (window-query window-queries)
        (ecase (car window-query)
          (:class (add-hook *map-window-hook* (place-windows-on-frame group
                                                                      (tile-group-current-frame group)
                                                                      :class (cadr window-query)))))))))

(defmacro define-group-layout (group-name layout-spec)
 `(let* ((group (or (find-group-by-name ,group-name)
                    (add-group (current-screen) ,group-name))))

    ,layout-spec))

;(define-group-layout "Chat"
 ;  (horizontally
  ;     (1/4 ((:class "Amsn")))
   ;  (:fill ((:class "Chatwindow")))))
;;EOF