;; merlin/mp3.jl -- an mp3 playlist menu

;; version 0.2

;; Copyright (C) 2002 merlin <merlin@merlin.org>

;; http://merlin.org/sawfish/

;; This 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 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 sawfish; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;;;;;;;;;;;;;;;;;;
;; PREREQUISITES ;;
;;;;;;;;;;;;;;;;;;;

;; This requires that you use the X Multimedia System (XMMS), that
;; your mp3 collection is indexed by playlists (.m3u files) which are
;; all present in a single directory, and that your playlist filenames
;; have the form Artist-Title.m3u; e.g., Swans-Real Love.m3u.

;;;;;;;;;;;;;;;;;;
;; INSTALLATION ;;
;;;;;;;;;;;;;;;;;;

;; Create a directory ~/.sawfish/lisp/merlin and then put this file there:
;;   mkdir -p ~/.sawfish/lisp/merlin
;;   mv mp3.jl ~/.sawfish/lisp/merlin

;; Then add to your .sawfish/rc:
;;   (require 'merlin.mp3)
;;   (install-mp3-menu (mp3-menu "/space/mp3" "/cdrom"))
;;
;; . You should change "/space/mp3" to the path of a directory
;;   containing your MP3 playlists.
;;
;; . You should change "/cdrom" to the mount point of your CD
;;   drive, as configured in XMMS, or nil if you have none.
;;
;; . If you don't want the Music menu placed in your root menu,
;;   don't use install-mp3-menu.

;; Then restart sawfish. Your root menu will now have a Music submenu
;; containing a list of your artists; each artist will have a submenu
;; containing their titles. There is also a control submenu and an
;; option to start playing the CD in your drive.

(define-structure merlin.mp3
  (export
   mp3-menu
   install-mp3-menu)

  (open
   rep
   rep.regexp
   rep.system
   rep.io.files
   sawfish.wm.menus)

  ;; Create an XMMS MP3 playlist menu {Artists}->{Titles} from a
  ;; directory containing playlists and optional CD mount point.
  (define (mp3-menu dir #!optional cdrom)
    (lambda ()
      (nconc
       (cons
	`("Control" . (("Play" (system "xmms --play &"))
		       ("Stop" (system "xmms --stop &"))
		       ("Prev" (system "xmms --rew &"))
		       ("Next" (system "xmms --fwd &"))))
	(and cdrom
	     (cons `("CD" (system ,(concat "xmms " cdrom " &"))) nil)))
       (let*
	   ((playlist-p
	     (lambda (playlist)
	       (string-match ".m3u$" playlist)))
	    (playlists (sort (delete-if-not playlist-p (directory-files dir))))
	    (uniquify-sorted
	     (lambda (l)
	       (let loop ((rest l))
		    (cond ((null rest) l)
			  ((equal (car rest) (cadr rest))
			   (rplacd rest (cddr rest)) (loop rest))
			  (t (loop (cdr rest)))))))
	    (artist-f
	     (lambda (playlist)
	       (string-match "-" playlist)
	       (substring playlist 0 (match-start))))
	    (artists (uniquify-sorted (mapcar artist-f playlists)))
	    (quotees (list 32 40 41 42 44 63))
	    (quote-file-name
	     (lambda (file)
	       (let loop ((i 0) (s ""))
		    (if (eq i (length file))
			s
		      (let ((c (aref file i)))
			(loop (1+ i) (concat s (and (memq c quotees) 92) c)))))))
	    (play
	     (lambda (playlist)
	       (let* ((quoted (quote-file-name playlist))
		      (file-name (expand-file-name quoted dir)))
		 (system (concat "xmms " file-name " &"))))))
	 (mapcar 
	  (lambda (artist)
	    (cons artist
		  (delq nil
			(mapcar
			 (lambda (playlist)
			   (and (string-match (concat "^" artist "-") playlist)
				(list (substring playlist (1+ (length artist)) (- (length playlist) 4))
				      (lambda () (play playlist)))))
			 playlists))))
	  artists)))))

  ;; Install an MP3 menu in the root menu beneath the apps entry, if
  ;; present; otherwise at the top of the menu.
  (define (install-mp3-menu mp3-menu)
    (let ((mp3-entry (lambda (next) (cons (cons "Music" mp3-menu) next))))
      (let loop ((menu root-menu))
	   (cond ((null menu) (setq root-menu (mp3-entry root-menu)))
		 ((eq 'apps-menu (cdar menu)) (rplacd menu (mp3-entry (cdr menu))))
		 (t (loop (cdr menu))))))))