[STUMP] My .stumpwmrc and a modified display-keybinding

[Luigi Panzeri]

I post my .stumpwmrc including a modeline updater (sbcl only) showing
time, volume and mldonkey stats, a define-group-layout (working but it
s an hack) to force a window matching some query to stay in a
group/frame. Also attach a modified display-keybinding that group the
commands with same action and display them ordered by keys.

I switch from few days to stumpwm. Nice wm, expecially for scripting
and fast hacking, though it was a bit unstable. How do you try new
configuration and develop it avoiding crash or saving backtrace? 


(defun display-keybinding (kmap)
  (echo-string-list (current-screen) 
                    (let ((inv-kmap ; the key of hash table is the
                                    ; command and the values are a
                                    ; list of keys
                           (loop
                              with ret = (make-hash-table :test #'equalp)
                              for key being the hash-key of kmap
                              using (hash-value value)
                              do (progn
                                   (push key (gethash value ret)))
                              finally (return ret)))
                          (values-ordered-by-keys
                           (loop 
                              for key in (sort 
                                          (loop 
                                             for key being the hash-key in kmap 
                                             collecting key) 
                                          #'string-lessp :key #'print-key)
                              collecting (gethash key kmap))))
                      (loop 
                         for command in values-ordered-by-keys
                         collect (format nil "~{~A~^, ~} -> ~A" (mapcar 
#'print-key (gethash command inv-kmap)) command)))))

------------ Stumpwmrc -------------------
;; -*-lisp-*-
(in-package :stumpwm)

;; Swank
(require 'swank)
(swank:create-server :dont-close t)

;; Use the force Luke
(require 'cl-ppcre)

;; prefix key to Menu (rarely used)
(set-prefix-key (kbd "Menu"))

;;   ____                                           _      
;;  / ___| ___  _ __ ___  _ __ ___   __ _ _ __   __| | ___ 
;; | |    / _ \| '_ ` _ \| '_ ` _ \ / _` | '_ \ / _` |/ __|
;; | |___| (_) | | | | | | | | | | | (_| | | | | (_| |\__ \
;;  \____|\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_||___/
                                                        

(define-stumpwm-command "colon1" ((initial :rest nil))
  (let ((cmd (read-one-line (current-screen) ": " initial)))
    (when cmd
      (interactive-command cmd (current-screen)))))

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

(define-stumpwm-command "term" ()
  (run-or-raise "xterm -e screen" :class "XTerm"))

(define-stumpwm-command "google-selection" ()
     (run-shell-command (concatenate 'string "exec surfraw google " 
(get-x-selection))))


;;  _                _     _           _  _                  
;; | | __ ___  _   _| |__ (_)_ __   __| |(_)_ __   __ _  ___ 
;; | |/ // _ \| | | | '_ \| | '_ \ / _` || | '_ \ / _` |/ __|
;; |   <|  __/| |_| | |_) | | | | | (_| || | | | | (_| |\__ \
;; |_|\_\\___| \__, |_.__/|_|_| |_|\__,_||_|_| |_|\__, ||___/
;;             |___/                              |___/      

(define-key *root-map* (kbd "`") '*groups-map*)
(define-key *root-map* (kbd "'") "gnext")
(define-key *root-map* (kbd "d") "exec gv")
(define-key *root-map* (kbd "b") "web")
(define-key *root-map* (kbd "e") "emacs")
(define-key *root-map* (kbd "x") "term")
(define-key *root-map* (kbd "w") "vgroups")
(define-key *root-map* (kbd "C-s") "colon1 exec xterm -e ssh ")
(define-key *root-map* (kbd "C-l") "exec xscreensaver-command -lock")
(define-key *root-map* (kbd "G") "google-selection")
(define-key *root-map* (kbd "Print") "exec import -window root 
png:$HOME/xwd-$(date +%s)$$.png")


(setf *window-format* "%n%s%t(%c)")
(set-font "-xos4-terminus-medium-r-normal--14-140-72-72-c-80-iso8859-15")

;;  __  __           _       _  _            
;; |  \/  | ___   __| | ___ | |(_)_ __   ___ 
;; | |\/| |/ _ \ / _` |/ _ \| || | '_ \ / _ \
;; | |  | | (_) | (_| |  __/| || | | | |  __/
;; |_|  |_|\___/ \__,_|\___||_||_|_| |_|\___|
                                   
(defun update-mode-line ()
  (redraw-mode-line-for 
   (screen-mode-line (current-screen))
   (current-screen))
  (resize-mode-line-for                     
   (screen-mode-line (current-screen))
   (current-screen)))
       
(defparameter *mode-line-timer* (sb-ext:make-timer 
                                 #'update-mode-line 
                                 :name "mode-line-updating"
                                 :thread (car (last 
(sb-thread:list-all-threads)))))

(sb-ext:schedule-timer *mode-line-timer* 5 :repeat-interval 60 :absolute-p nil)
;(sb-ext:unschedule-timer (first (sb-ext:list-all-timers)))
(setf *mode-line-foreground-color* "Red")
(setf *mode-line-background-color* "black")

(defun show-battery-charge ()
  (let ((raw-battery (run-shell-command "acpi | cut -d, -f2" t))) 
    (substitute #\Space #\Newline raw-battery)))

(defun show-time ()
  (let ((time (multiple-value-list (get-decoded-time))))
    (format nil "~2,'0d:~2,'0d " 
            (third time)
            (second time))))

(defun show-mldonkey-stats ()
  (substitute #\Space #\Newline (run-shell-command "mldonkey_command vd | grep 
Down: | cut -d'|' -f1,2" t)))

(setf *screen-mode-line-format*
      (list '(:eval (show-time))    "|"
            '(:eval (show-battery-charge)) "| "
            '(:eval (show-mldonkey-stats)) "| "
            '(:eval (show-audio))))

(run-commands "mode-line")

;;     _              _  _       
;;    / \   _   _  __| |(_) ___  
;;   / _ \ | | | |/ _` || |/ _ \ 
;;  / ___ \| |_| | (_| || | (_) |
;; /_/   \_\\__,_|\__,_||_|\___/ 

(defvar *audio-map* nil)
(setf *audio-map* (make-sparse-keymap))

(define-stumpwm-command "help-audio" ()
  (display-keybinding *audio-map*))

(define-stumpwm-command "increase-volume-pcm" ()
  (run-shell-command "aumix -w+10")
  (sb-ext:schedule-timer *mode-line-timer* 1))
(define-stumpwm-command "increase-volume-vol" ()
  (run-shell-command "aumix -v+10")
  (sb-ext:schedule-timer *mode-line-timer* 1))
(define-stumpwm-command "decrease-volume-pcm" ()
  (run-shell-command "aumix -w-10")
  (sb-ext:schedule-timer *mode-line-timer* 1))
(define-stumpwm-command "decrease-volume-vol" ()
  (run-shell-command "aumix -v-10")
  (sb-ext:schedule-timer *mode-line-timer* 1))

(defun show-audio ()
  (format nil "~a ~a"
          (string-right-trim '(#\Newline) (run-shell-command "aumix -q | grep 
vol | cut -d, -f1" t))
          (string-right-trim '(#\Newline) (run-shell-command "aumix -q | grep 
'pcm ' | cut -d, -f1" t))))

(define-key *root-map* (kbd "A") *audio-map*)
(define-key *audio-map* (kbd "h") "increase-volume-pcm")
(define-key *audio-map* (kbd "H") "increase-volume-vol")
(define-key *audio-map* (kbd "l") "decrease-volume-pcm")
(define-key *audio-map* (kbd "L") "decrease-volume-vol")
(define-key *audio-map* (kbd "?") "help-audio")


;;   ____                             
;;  / ___|_ __  ___  _   _ _ __   ___ 
;; | |  _| '__|/ _ \| | | | '_ \ / __|
;; | |_| | |  | (_) | |_| | |_) |\__ \
;;  \____|_|   \___/ \__,_| .__/ |___/
;;                        |_|         

(setf (group-name (first (screen-groups (current-screen)))) "Emacs")

(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")))))