[clfswm-cvs] r411 - in clfswm: . contrib src
Philippe Brochard
pbrochard at common-lisp.net
Tue Feb 22 14:16:08 UTC 2011
Author: pbrochard
Date: Tue Feb 22 09:16:08 2011
New Revision: 411
Log:
contrib/volume-mode.lisp: Add a volume mode inspired by the emms volume package. and its alsa mixer interface
Added:
clfswm/contrib/amixer.lisp
clfswm/contrib/volume-mode.lisp
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-configuration.lisp
clfswm/src/clfswm-menu.lisp
clfswm/src/tools.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Tue Feb 22 09:16:08 2011
@@ -1,3 +1,11 @@
+2011-02-22 Desmond O. Chang <dochang at gmail.com>
+
+ * contrib/amixer.lisp: Add a volume mode inspired by the emms
+ volume package. Alsa mixer interface.
+
+ * contrib/volume-mode.lisp: Add a volume mode inspired by the emms
+ volume package.
+
2011-02-22 Desmond O. Chang <dochang at gmail.com>
* src/clfswm.lisp (main): Use ASDF:SYSTEM-SOURCE-DIRECTORY instead
Added: clfswm/contrib/amixer.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/amixer.lisp Tue Feb 22 09:16:08 2011
@@ -0,0 +1,103 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Volume mode
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2011 Desmond O. Chang <dochang at gmail.com>
+;;;
+;;; This program 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 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: A volume mode.
+;;; If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;; (load-contrib "volume-mode.lisp")
+;;; And with the alsa mixer:
+;;; (load-contrib "amixer.lisp")
+;;;
+;;; This mode is inspired by the emms volume package. When you change the
+;;; volume in main mode or second mode, clfswm will enter volume mode and
+;;; set a timer to leave this mode. Changing volume in volume mode will
+;;; reset the timer. You can also leave volume mode manually by return,
+;;; escape or control-g.
+;;;
+;;; Special variable *VOLUME-MODE-TIMEOUT* controls the timeout in
+;;; seconds. If it's positive, volume mode will exit when timeout occurs;
+;;; if it's 0, volume mode will exit right now; if it's negative, volume
+;;; will not exit even if timeout occurs. Default timeout is 3 seconds.
+;;;
+;;; Volume mode uses three special variables to control the mixer:
+;;; *VOLUME-MUTE-FUNCTION*, *VOLUME-LOWER-FUNCTION* and
+;;; *VOLUME-RAISE-FUNCTION*. Their values are functions which must accept
+;;; no arguments and return two values indicating the mixer state. The
+;;; first value is the volume ratio whose type must be (real 0 1). If the
+;;; mixer is mute, the second value should be true, otherwise it should be
+;;; false. If volume controller cannot get the mixer state, it must
+;;; return NIL.
+;;;
+;;; Volume mode shows a mute sign, a percentage and a ratio bar on the
+;;; screen. A plus sign '+' means it's unmute and a minus sign '-' means
+;;; it's mute now. If volume mode doesn't know the mixer state, a message
+;;; "unknown" will be shown.
+;;;
+;;; contrib/amixer.lisp shows how to use volume mode with alsa.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defvar *amixer-scontrol* "Master"
+ "Default control for amixer commands.")
+
+(defun amixer-cmd (cmd scontrol &rest parameters)
+ (let* ((sed "sed 's/^.*\\[\\([[:digit:]]\\+\\)%\\].*\\[\\(on\\|off\\)\\].*$/\\1%\\2/'")
+ (fmt "amixer ~A ~A~{ ~A~} 2>/dev/null | tail -1 | ~A")
+ (shell (format nil fmt cmd scontrol parameters sed))
+ (line (read-line (do-shell shell) nil nil)))
+ (when line
+ (let* ((ratio (parse-integer line :junk-allowed t))
+ (%-pos (position #\% line)))
+ (values (and ratio (/ ratio 100))
+ (equal "off" (and %-pos (subseq line (1+ %-pos)))))))))
+
+(defun amixer-sset (&rest parameters)
+ (apply 'amixer-cmd "sset" *amixer-scontrol* parameters))
+
+(defparameter *volume-mute-function*
+ (lambda () (amixer-sset "toggle")))
+
+(defparameter *volume-lower-function*
+ (lambda () (amixer-sset "5%-")))
+
+(defparameter *volume-raise-function*
+ (lambda () (amixer-sset "5%+")))
+
+(defun amixer-lower-1% ()
+ "Lower 1% volume."
+ (volume-set (lambda () (amixer-sset "1%-"))))
+
+(defun amixer-raise-1% ()
+ "Raise 1% volume."
+ (volume-set (lambda () (amixer-sset "1%+"))))
+
+(defun amixer-volume-bind ()
+ (define-volume-key ("less") 'amixer-lower-1%)
+ (define-volume-key ("greater") 'amixer-raise-1%)
+ (define-second-key ("less") 'amixer-lower-1%)
+ (define-second-key ("greater") 'amixer-raise-1%))
+
+(add-hook *binding-hook* 'amixer-volume-bind)
Added: clfswm/contrib/volume-mode.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/volume-mode.lisp Tue Feb 22 09:16:08 2011
@@ -0,0 +1,260 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Volume mode
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2011 Desmond O. Chang <dochang at gmail.com>
+;;;
+;;; This program 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 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; Documentation: A volume mode.
+;;; If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;; (load-contrib "volume-mode.lisp")
+;;; And with the alsa mixer:
+;;; (load-contrib "amixer.lisp")
+;;;
+;;; This mode is inspired by the emms volume package. When you change the
+;;; volume in main mode or second mode, clfswm will enter volume mode and
+;;; set a timer to leave this mode. Changing volume in volume mode will
+;;; reset the timer. You can also leave volume mode manually by return,
+;;; escape or control-g.
+;;;
+;;; Special variable *VOLUME-MODE-TIMEOUT* controls the timeout in
+;;; seconds. If it's positive, volume mode will exit when timeout occurs;
+;;; if it's 0, volume mode will exit right now; if it's negative, volume
+;;; will not exit even if timeout occurs. Default timeout is 3 seconds.
+;;;
+;;; Volume mode uses three special variables to control the mixer:
+;;; *VOLUME-MUTE-FUNCTION*, *VOLUME-LOWER-FUNCTION* and
+;;; *VOLUME-RAISE-FUNCTION*. Their values are functions which must accept
+;;; no arguments and return two values indicating the mixer state. The
+;;; first value is the volume ratio whose type must be (real 0 1). If the
+;;; mixer is mute, the second value should be true, otherwise it should be
+;;; false. If volume controller cannot get the mixer state, it must
+;;; return NIL.
+;;;
+;;; Volume mode shows a mute sign, a percentage and a ratio bar on the
+;;; screen. A plus sign '+' means it's unmute and a minus sign '-' means
+;;; it's mute now. If volume mode doesn't know the mixer state, a message
+;;; "unknown" will be shown.
+;;;
+;;; contrib/amixer.lisp shows how to use volume mode with alsa.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+
+(defparameter *volume-keys* nil)
+(defparameter *volume-mode-placement* 'bottom-middle-placement
+ "Config(Placement group): Volume mode window placement")
+
+
+(defvar *volume-window* nil)
+(defvar *volume-font* nil)
+(defvar *volume-gc* nil)
+(defvar *in-volume-mode* nil)
+(defvar *leave-volume-mode* nil)
+
+(defvar *volume-ratio* nil)
+(defvar *volume-mute* nil)
+
+(defvar *volume-mode-timeout* 3
+ "Volume mode timeout in seconds:
+> 0 means volume mode will exit when timeout occurs;
+= 0 means exit right now;
+< 0 means exit manually.")
+
+
+;;; CONFIG - Volume mode
+(defparameter *volume-font-string* *default-font-string*
+ "Config(Volume mode group): Volume string window font string")
+(defparameter *volume-background* "black"
+ "Config(Volume mode group): Volume string window background color")
+(defparameter *volume-foreground* "green"
+ "Config(Volume mode group): Volume string window foreground color")
+(defparameter *volume-border* "red"
+ "Config(Volume mode group): Volume string window border color")
+(defparameter *volume-width* 400
+ "Config(Volume mode group): Volume mode window width")
+(defparameter *volume-height* 15
+ "Config(Volume mode group): Volume mode window height")
+(defparameter *volume-text-limit* 30
+ "Config(Volume mode group): Maximum text limit in the volume window")
+(defparameter *volume-external-mixer-cmd* "/usr/bin/gnome-alsamixer"
+ "Config(Volume mode group): Command to start an external mixer program")
+
+(create-configuration-menu :clear t)
+
+(define-init-hash-table-key *volume-keys* "Volume mode keys")
+(define-define-key "volume" *volume-keys*)
+
+(add-hook *binding-hook* 'init-*volume-keys*)
+
+(defun set-default-volume-keys ()
+ (define-volume-key ("XF86AudioMute") 'volume-mute)
+ (define-volume-key ("XF86AudioLowerVolume") 'volume-lower)
+ (define-volume-key ("XF86AudioRaiseVolume") 'volume-raise)
+ (define-volume-key (#\/) 'volume-mute)
+ (define-volume-key (#\,) 'volume-lower)
+ (define-volume-key (#\.) 'volume-raise)
+ (define-volume-key ("m") 'volume-mute)
+ (define-volume-key ("l") 'volume-lower)
+ (define-volume-key ("r") 'volume-raise)
+ (define-volume-key ("Return") 'leave-volume-mode)
+ (define-volume-key ("Escape") 'leave-volume-mode)
+ (define-volume-key ("g" :control) 'leave-volume-mode)
+ (define-volume-key ("e") 'run-external-volume-mixer)
+ ;;; Main mode
+ (define-main-key ("XF86AudioMute") 'volume-mute)
+ (define-main-key ("XF86AudioLowerVolume") 'volume-lower)
+ (define-main-key ("XF86AudioRaiseVolume") 'volume-raise)
+ ;;; Second mode
+ (define-second-key ("XF86AudioMute") 'volume-mute)
+ (define-second-key ("XF86AudioLowerVolume") 'volume-lower)
+ (define-second-key ("XF86AudioRaiseVolume") 'volume-raise))
+
+(add-hook *binding-hook* 'set-default-volume-keys)
+
+(defun volume-mode-window-message (width)
+ (if *volume-ratio*
+ (let* ((mute (if *volume-mute* #\- #\+))
+ (percentage (round (* 100 *volume-ratio*)))
+ (n (round (* width *volume-ratio*))))
+ (format nil "[~A] ~3 at A% ~A~A" mute percentage
+ (repeat-chars n #\#) (repeat-chars (- width n) #\.)))
+ "unknown"))
+
+(defun draw-volume-mode-window ()
+ (raise-window *volume-window*)
+ (clear-pixmap-buffer *volume-window* *volume-gc*)
+ (let* ((text (limit-length (volume-mode-window-message 20) *volume-text-limit*))
+ (len (length text)))
+ (xlib:draw-glyphs *pixmap-buffer* *volume-gc*
+ (truncate (/ (- *volume-width* (* (xlib:max-char-width *volume-font*) len)) 2))
+ (truncate (/ (+ *volume-height* (- (xlib:font-ascent *volume-font*) (xlib:font-descent *volume-font*))) 2))
+ text))
+ (copy-pixmap-buffer *volume-window* *volume-gc*))
+
+(defun leave-volume-mode ()
+ "Leave the volume mode"
+ (throw 'exit-volume-loop nil))
+
+(defun update-volume-mode ()
+ (draw-volume-mode-window)
+ (cond ((plusp *volume-mode-timeout*)
+ (erase-timer :volume-mode-timer)
+ (with-timer (*volume-mode-timeout* :volume-mode-timer)
+ (setf *leave-volume-mode* t)))
+ ((zerop *volume-mode-timeout*)
+ (erase-timer :volume-mode-timer)
+ (setf *leave-volume-mode* t))
+ ((minusp *volume-mode-timeout*)
+ (erase-timer :volume-mode-timer))))
+
+(defun volume-enter-function ()
+ (with-placement (*volume-mode-placement* x y *volume-width* *volume-height*)
+ (setf *volume-font* (xlib:open-font *display* *volume-font-string*)
+ *volume-window* (xlib:create-window :parent *root*
+ :x x
+ :y y
+ :width *volume-width*
+ :height *volume-height*
+ :background (get-color *volume-background*)
+ :border-width 1
+ :border (get-color *volume-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press))
+ *volume-gc* (xlib:create-gcontext :drawable *volume-window*
+ :foreground (get-color *volume-foreground*)
+ :background (get-color *volume-background*)
+ :font *volume-font*
+ :line-style :solid))
+ (map-window *volume-window*))
+ (setf *in-volume-mode* t
+ *leave-volume-mode* nil)
+ (update-volume-mode))
+
+(defun volume-loop-function ()
+ (when *leave-volume-mode*
+ (leave-volume-mode)))
+
+(defun volume-leave-function ()
+ (when *volume-gc*
+ (xlib:free-gcontext *volume-gc*))
+ (when *volume-window*
+ (xlib:destroy-window *volume-window*))
+ (when *volume-font*
+ (xlib:close-font *volume-font*))
+ (xlib:display-finish-output *display*)
+ (erase-timer :volume-mode-timer)
+ (setf *volume-window* nil
+ *volume-gc* nil
+ *volume-font* nil
+ *in-volume-mode* nil
+ *leave-volume-mode* nil))
+
+(define-handler volume-mode :key-press (code state)
+ (funcall-key-from-code *volume-keys* code state))
+
+(defun volume-mode ()
+ (let ((grab-keyboard-p (xgrab-keyboard-p))
+ (grab-pointer-p (xgrab-pointer-p)))
+ (xgrab-pointer *root* 92 93)
+ (unless grab-keyboard-p
+ (ungrab-main-keys)
+ (xgrab-keyboard *root*))
+ (generic-mode 'volume-mode 'exit-volume-loop
+ :enter-function 'volume-enter-function
+ :loop-function 'volume-loop-function
+ :leave-function 'volume-leave-function
+ :original-mode '(main-mode))
+ (unless grab-keyboard-p
+ (xungrab-keyboard)
+ (grab-main-keys))
+ (if grab-pointer-p
+ (xgrab-pointer *root* 66 67)
+ (xungrab-pointer))))
+
+(defun volume-set (fn)
+ (when fn
+ (setf (values *volume-ratio* *volume-mute*) (funcall fn))
+ (if *in-volume-mode*
+ (update-volume-mode)
+ (volume-mode))))
+
+(defvar *volume-mute-function* nil)
+(defvar *volume-lower-function* nil)
+(defvar *volume-raise-function* nil)
+
+(defun volume-mute ()
+ "Toggle mute."
+ (volume-set *volume-mute-function*))
+
+(defun volume-lower ()
+ "Lower volume."
+ (volume-set *volume-lower-function*))
+
+(defun volume-raise ()
+ "Raise volume."
+ (volume-set *volume-raise-function*))
+
+(defun run-external-volume-mixer ()
+ "Start an external volume mixer"
+ (do-shell *volume-external-mixer-cmd*))
Modified: clfswm/src/clfswm-configuration.lisp
==============================================================================
--- clfswm/src/clfswm-configuration.lisp (original)
+++ clfswm/src/clfswm-configuration.lisp Tue Feb 22 09:16:08 2011
@@ -156,8 +156,10 @@
symbol))
-(defun create-configuration-menu ()
+(defun create-configuration-menu (&key clear)
"Configuration menu"
+ (when clear
+ (clear-sub-menu 'main 'configuration-menu))
(multiple-value-bind (all-groups all-variables)
(find-configuration-variables)
(loop for group in all-groups
Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp (original)
+++ clfswm/src/clfswm-menu.lisp Tue Feb 22 09:16:08 2011
@@ -114,6 +114,8 @@
(defun del-sub-menu (menu-name sub-menu-name &optional (root *menu*))
(del-item-by-value (find-menu sub-menu-name) (find-menu menu-name root)))
+(defun clear-sub-menu (menu-name sub-menu-name &optional (root *menu*))
+ (setf (menu-item (find-menu sub-menu-name (find-menu menu-name root))) nil))
(defun add-menu-comment (menu-name &optional (comment "---") (root *menu*))
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Tue Feb 22 09:16:08 2011
@@ -60,6 +60,7 @@
:create-symbol
:number->char
:simple-type-of
+ :repeat-chars
:nth-insert
:split-string
:append-newline-space
@@ -427,6 +428,11 @@
(t type))))
+(defun repeat-chars (n char)
+ "Return a string containing N CHARs."
+ (make-string n :initial-element char))
+
+
(defun nth-insert (n elem list)
"Insert elem in (nth n list)"
More information about the clfswm-cvs
mailing list