1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
;; 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))))))))
|
