stumpwm: useful modules

stumpwm/amixer.lisp

@@ -0,0 +1,83 @@
+;;; Amixer module for StumpWM.
+;;;
+;;; Copyright 2007 Amy Templeton, Jonathan Moore Liles, Ivy Foster.
+;;;
+;;; Maintainer: Ivy Foster
+;;;
+;;; This module is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This module is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+;;;
+
+;;; USAGE:
+;;;
+;;; Make sure you have your media keys (or whatever) mapped to the appropriate
+;;; keysyms (using xmodmap), then put:
+;;;
+;;;     (load "/path/to/amixer.lisp")
+;;;
+;;; ...in your ~/.stumpwmrc, followed by some keybindings (according
+;;; to your preference)
+
+;;; TODO:
+;;;
+;;; Make the `defvolcontrol' macro create all the necessary commands at once.
+;;;
+;;;   - Should it just create, say, amixer-pcm, which would be passed an
+;;;     argument? i.e., (define-key *this-map* (kbd "e") "amixer-pcm 1-")
+;;;
+;;;   - Else, figure out how to make the macro not error when converting a
+;;;     string to a symbol for the name of the command
+
+;;; Code:
+
+(in-package :stumpwm)
+
+(defun volcontrol (channel amount)
+  (let ((percent (parse-integer
+		  (run-shell-command
+		   (concat "amixer sset " channel " " (or amount "toggle")
+			   "| tail -1"
+			   "| sed 's/^.*\\[\\([[:digit:]]\\+\\)%\\].*$/\\1/'")
+		   t))))
+    (message
+     (concat "Mixer: " channel " " (or amount "toggled")
+	     (format nil "~C^B~A%" #\Newline percent) "^b [^[^7*"
+             (bar percent 50 #\# #\:) "^]]"))))
+
+(defmacro defvolcontrol (name channel valence)
+  `(defcommand ,name () ()
+     (volcontrol ,channel ,valence)))
+
+(defvolcontrol amixer-PCM-1- "PCM" "1-")
+(defvolcontrol amixer-PCM-1+ "PCM" "1+")
+(defvolcontrol amixer-PCM-toggle "PCM" "toggle")
+
+(defvolcontrol amixer-Front-1- "Front" "1-")
+(defvolcontrol amixer-Front-1+ "Front" "1+")
+(defvolcontrol amixer-Front-toggle "Front" "toggle")
+
+(defvolcontrol amixer-Master-1- "Master" "1-")
+(defvolcontrol amixer-Master-1+ "Master" "1+")
+(defvolcontrol amixer-Master-toggle "Master" "toggle")
+
+(defvolcontrol amixer-Headphone-1- "Headphone" "1-")
+(defvolcontrol amixer-Headphone-1+ "Headphone" "1+")
+(defvolcontrol amixer-Headphone-toggle "Headphone" "toggle")
+
+(defcommand amixer-sense-toggle () ()
+  (message
+   (concat "Headphone Jack Sense toggled"
+           (run-shell-command "amixer sset 'Headphone Jack Sense' toggle" t))))
+
+;;; End of file

stumpwm/app-menu.lisp

@@ -0,0 +1,28 @@
+(in-package :stumpwm)
+
+(export '(show-menu load-menu-file))
+
+(defvar *app-menu* nil "Where the menu structure is held")
+
+(defun load-menu-file (file-name &key (strip 0))
+  (with-open-file (file file-name)
+    (when (char= #\# (peek-char nil file)) (read-line file))  ; Hack around the "autogenerated file" comment
+    (let* ((*read-eval* nil)
+           (list (list (read file))))
+      (dotimes (i strip) (setf list (mapcan #'cdr list)))
+      (setf *app-menu* (nconc *app-menu* list)))))
+
+(defcommand show-menu () ()
+  "Show the application menu"
+  (let ((stack (list *app-menu*)))
+    (loop
+       (let ((choice
+              (cdr (select-from-menu (current-screen)
+                                     (append (first stack)
+                                             (list (cons "Up a level" :up)))))))
+         (cond
+           ((not choice) (return))
+           ((eq choice :up) (pop stack) (unless stack (return)))
+           ((stringp choice) (run-shell-command choice) (return))
+           (t (push choice stack)))))))
+

stumpwm/aumix.lisp

@@ -0,0 +1,100 @@
+;;; Aumix front end module for stumpwm
+;;;
+;;; Copyright (C) 2008 Fredrik Tolf
+;;;
+;;; Maintainer: Fredrik Tolf
+;;;
+;;; This module is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2, or (at your option)
+;;; any later version.
+;;;
+;;; This module is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this software; see the file COPYING.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+;;;
+
+;;; USAGE:
+;;;
+;;; Put:
+;;;
+;;;     (load-module "aumix")
+;;;
+;;; In your ~/.stumpwmrc
+
+(in-package :stumpwm-user)
+
+(defvar *aumix-program* "/usr/bin/aumix")
+
+(defvar *aumix-channels*
+  '((:pcm . "w")
+    (:master . "v")
+    (:alt-pcm . "W")
+    (:line . "l")))
+
+(defun assert-ret (val)
+  (assert val)
+  val)
+
+(defun process-aumix-volstring (output)
+  (do* ((i 0 (+ i 1))
+        (ch (aref output i) (aref output i))
+        (st 'ch)
+        (buf "")
+        left right)
+       (nil)
+    (setq st (case st
+               ((ch) (if (eql ch #\space) 'left 'ch))
+               ((left) (if (digit-char-p ch)
+                           (progn (setq buf (concatenate 'string buf (string ch))) 'left)
+                           (progn (setq left (/ (parse-integer buf) 100)) 'space)))
+               ((space) (if (eql ch #\space) (progn (setq buf "") 'right) (error "Invalid output from aumix")))
+               ((right) (if (digit-char-p ch)
+                            (progn (setq buf (concatenate 'string buf (string ch))) 'right)
+                            (progn (setq right (/ (parse-integer buf) 100))
+                                   (return (values (/ (+ left right) 2) left right)))))
+               (t (error "Invalid output from aumix"))))))
+
+(defun aumix-call (channel op amount)
+  (let* ((ch (assert-ret (cdr (assoc channel *aumix-channels*))))
+         (opstr (concat
+                 (case op
+                   ((:up) "+")
+                   ((:down) "-")
+                   ((:set) "")
+                   (t (error "Unknown volume operation")))
+                 (format nil "~D" (round (* 100 amount)))))
+         (output (stumpwm::run-prog-collect-output
+                  *aumix-program*
+                  (concat "-" ch opstr)
+                  (concat "-" ch "q"))))
+    (process-aumix-volstring output)))
+
+(defun aumix-get (channel)
+  (process-aumix-volstring
+   (stumpwm::run-prog-collect-output
+    *aumix-program*
+    (concat "-" (assert-ret (cdr (assoc channel *aumix-channels*))) "q"))))
+
+(define-stumpwm-type :mixer-channel (input prompt)
+  (let ((n (or (argument-pop input)
+               (completing-read (current-screen) prompt (mapcar (lambda (sym)
+                                                                  (string-downcase (symbol-name (car sym))))
+                                                                *aumix-channels*)))))
+    (intern (string-upcase n) 'keyword)))
+
+(defcommand mixer (channel opstr) ((:mixer-channel "Channel: ") (:rest "Op: "))
+  "Change mixer channel."
+  (let* ((fc (aref opstr 0))
+         (op (cond ((eql fc #\+) (setq opstr (subseq opstr 1)) :up)
+                   ((eql fc #\-) (setq opstr (subseq opstr 1)) :down)
+                   ((eql fc #\=) (setq opstr (subseq opstr 1)) :set)
+                   ((digit-char-p fc) :set)
+                   (t (error "Illegal mixer operation"))))
+         (amount (parse-integer opstr)))
+    (message "~A: ~D%" (symbol-name channel) (round (* (aumix-call channel op (/ amount 100)) 100)))))