[clfswm-cvs] r243 - in clfswm: . contrib src
Philippe Brochard
pbrochard at common-lisp.net
Mon Jun 22 20:27:52 UTC 2009
Author: pbrochard
Date: Mon Jun 22 16:27:52 2009
New Revision: 243
Log:
contrib/mpd.lisp: New file to handle the Music Player Daemon (MPD)
Added:
clfswm/contrib/mpd.lisp
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/config.lisp
clfswm/src/tools.lisp
clfswm/src/version.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Mon Jun 22 16:27:52 2009
@@ -1,3 +1,7 @@
+2009-06-22 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * contrib/mpd.lisp: New file to handle the Music Player Daemon (MPD)
+
2009-06-19 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-autodoc.lisp (produce-doc, produce-doc-html): Minor
Added: clfswm/contrib/mpd.lisp
==============================================================================
--- (empty file)
+++ clfswm/contrib/mpd.lisp Mon Jun 22 16:27:52 2009
@@ -0,0 +1,107 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Music Player Daemon (MPD) interface
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2009 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; 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: If you want to use this file, just add this line in
+;;; your configuration file:
+;;;
+;;; (load-contrib "mpd.lisp")
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(format t "Loading MPD code... ")
+
+
+(defun start-sonata ()
+ "Start sonata"
+ (do-shell "exec sonata"))
+
+
+(defun show-mpd-info ()
+ "Show MPD informations"
+ (info-on-shell "MPD informations:" "mpc"))
+
+(defun mpd-previous ()
+ "Play the previous song in the current playlist"
+ (do-shell "mpc prev"))
+
+(defun mpd-next ()
+ "Play the next song in the current playlist"
+ (do-shell "mpc next"))
+
+(defun mpd-toggle ()
+ "Toggles Play/Pause, plays if stopped"
+ (do-shell "mpc toggle"))
+
+(defun mpd-play ()
+ "Start playing"
+ (do-shell "mpc play"))
+
+(defun mpd-stop ()
+ "Stop the currently playing playlists"
+ (do-shell "mpc stop"))
+
+
+(defun mpd-seek-+5% ()
+ "Seeks to +5%"
+ (do-shell "mpc seek +5%")
+ (mpd-menu))
+
+(defun mpd-seek--5% ()
+ "Seeks to -5%"
+ (do-shell "mpc seek -5%")
+ (mpd-menu))
+
+(defun show-mpd-playlist ()
+ "Show the current MPD playlist"
+ (info-on-shell "Current MPD playlist:" "mpc playlist"))
+
+(defun mpd-menu ()
+ "< Open the MPD menu >"
+ (info-mode-menu '((#\i show-mpd-info)
+ (#\p mpd-previous)
+ (#\n mpd-next)
+ (#\t mpd-toggle)
+ (#\y mpd-play)
+ (#\k mpd-stop)
+ (#\x mpd-seek-+5%)
+ (#\w mpd-seek--5%)
+ (#\l show-mpd-playlist)
+ (#\s start-sonata))))
+
+
+(defun add-mpd-menu-to-help-menu ()
+ (setf *help-menu-list* (append *help-menu-list*
+ `((#\s (mpd-menu ,*menu-color-submenu*))))))
+
+(add-hook *init-hook* 'add-mpd-menu-to-help-menu)
+
+(defun mpd-binding ()
+ (define-main-key ("F2" :alt) 'mpd-menu))
+
+(add-hook *binding-hook* 'mpd-binding)
+
+
+
+(format t "done~%")
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Mon Jun 22 16:27:52 2009
@@ -171,9 +171,13 @@
(defun circulate-leave-function ()
- (xlib:destroy-window *circulate-window*)
- (xlib:close-font *circulate-font*)
- (xlib:display-finish-output *display*))
+ (when *circulate-window*
+ (xlib:destroy-window *circulate-window*))
+ (when *circulate-font*
+ (xlib:close-font *circulate-font*))
+ (xlib:display-finish-output *display*)
+ (setf *circulate-window* nil
+ *circulate-font* nil))
(defun circulate-loop-function ()
;;; Check if the key modifier is alway pressed
@@ -238,6 +242,7 @@
:leave-function #'circulate-leave-function
:key-press-hook #'circulate-handle-key-press
:key-release-hook #'circulate-handle-key-release)
+ (circulate-leave-function)
(unless grab-keyboard-p
(xungrab-keyboard)
(grab-main-keys))
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Mon Jun 22 16:27:52 2009
@@ -484,32 +484,15 @@
(info-mode (list *version*)))
+
(defun help-on-clfswm ()
"Open the help and info window"
- (info-mode-menu `((#\h show-global-key-binding)
- (#\b show-main-mode-key-binding)
- (#\c show-corner-help)
- (#\g show-config-variable)
- (#\d show-date)
- (#\p show-cpu-proc)
- (#\m show-mem-proc)
- (#\x (xmms-info-menu ,*menu-color-submenu*))
- (#\v show-version)
- (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
+ (info-mode-menu *help-menu-list*))
(defun help-on-second-mode ()
"Open the help and info window for the second mode"
- (info-mode-menu `((#\h show-global-key-binding)
- (#\b show-second-mode-key-binding)
- (#\c show-corner-help)
- (#\g show-config-variable)
- (#\d show-date)
- (#\p show-cpu-proc)
- (#\m show-mem-proc)
- (#\x (xmms-info-menu ,*menu-color-submenu*))
- (#\v show-version)
- (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
+ (info-mode-menu *help-menu-list*))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Mon Jun 22 16:27:52 2009
@@ -30,7 +30,7 @@
(let ((truename (concatenate 'string *contrib-dir* "contrib/" file)))
(format t "Loading contribution file: ~A~%" truename)
(when (probe-file truename)
- (load truename))))
+ (load truename :verbose nil))))
(defun reload-clfswm ()
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Mon Jun 22 16:27:52 2009
@@ -240,6 +240,7 @@
(xgrab-init-pointer)
(xgrab-init-keyboard)
(init-last-child)
+ (reset-help-menu-list)
(call-hook *binding-hook*)
(map-window *no-focus-window*)
(dbg *display*)
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Mon Jun 22 16:27:52 2009
@@ -280,5 +280,18 @@
"Config(Menu group): Menu key color in menu")
+;;; Help menu list
+(defparameter *help-menu-list* nil
+ "Config(Info mode group): List of menus in the help menu")
-
+(defun reset-help-menu-list ()
+ (setf *help-menu-list* `((#\h show-global-key-binding)
+ (#\b show-main-mode-key-binding)
+ (#\c show-corner-help)
+ (#\g show-config-variable)
+ (#\d show-date)
+ (#\p show-cpu-proc)
+ (#\m show-mem-proc)
+ (#\x (xmms-info-menu ,*menu-color-submenu*))
+ (#\v show-version)
+ (#\i (info-on-cd-menu ,*menu-color-submenu*)))))
\ No newline at end of file
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Mon Jun 22 16:27:52 2009
@@ -133,7 +133,10 @@
(defmacro add-hook (hook &rest value)
- `(setf ,hook (append ,hook (list , at value))))
+ `(setf ,hook (append (typecase ,hook
+ (list ,hook)
+ (t (list ,hook)))
+ (list , at value))))
(defmacro remove-hook (hook &rest value)
(let ((i (gensym)))
Modified: clfswm/src/version.lisp
==============================================================================
--- clfswm/src/version.lisp (original)
+++ clfswm/src/version.lisp Mon Jun 22 16:27:52 2009
@@ -33,4 +33,4 @@
(in-package :version)
-(defparameter *version* #.(concatenate 'string "Version: 0805 built " (date-string)))
+(defparameter *version* #.(concatenate 'string "Version: 0906 built " (date-string)))
More information about the clfswm-cvs
mailing list