← Back to branch summary

~ubuntu-branches/ubuntu/wily/sawfish-merlin-ugliness/wily

« back to all changes in this revision

Viewing changes to mp3.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2004-07-28 15:21:44 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040728152144-1b1tm5ak371o1pe9
Tags: 1.3.1-1
* New upstream relase.
* Remove old dependency on sawfish-gnome and sawfish2

Show diffs side-by-side

added added

removed removed

Lines of Context:
mp3.jl
 
1
;; merlin/mp3.jl -- an mp3 playlist menu
 
2
 
 
3
;; version 0.2
 
4
 
 
5
;; Copyright (C) 2002 merlin <merlin@merlin.org>
 
6
 
 
7
;; http://merlin.org/sawfish/
 
8
 
 
9
;; This is free software; you can redistribute it and/or modify it
 
10
;; under the terms of the GNU General Public License as published by
 
11
;; the Free Software Foundation; either version 2, or (at your option)
 
12
;; any later version.
 
13
 
 
14
;; This is distributed in the hope that it will be useful, but
 
15
;; WITHOUT ANY WARRANTY; without even the implied warranty of
 
16
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
17
;; GNU General Public License for more details.
 
18
 
 
19
;; You should have received a copy of the GNU General Public License
 
20
;; along with sawfish; see the file COPYING.  If not, write to
 
21
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
22
 
 
23
;;;;;;;;;;;;;;;;;;;
 
24
;; PREREQUISITES ;;
 
25
;;;;;;;;;;;;;;;;;;;
 
26
 
 
27
;; This requires that you use the X Multimedia System (XMMS), that
 
28
;; your mp3 collection is indexed by playlists (.m3u files) which are
 
29
;; all present in a single directory, and that your playlist filenames
 
30
;; have the form Artist-Title.m3u; e.g., Swans-Real Love.m3u.
 
31
 
 
32
;;;;;;;;;;;;;;;;;;
 
33
;; INSTALLATION ;;
 
34
;;;;;;;;;;;;;;;;;;
 
35
 
 
36
;; Create a directory ~/.sawfish/lisp/merlin and then put this file there:
 
37
;;   mkdir -p ~/.sawfish/lisp/merlin
 
38
;;   mv mp3.jl ~/.sawfish/lisp/merlin
 
39
 
 
40
;; Then add to your .sawfish/rc:
 
41
;;   (require 'merlin.mp3)
 
42
;;   (install-mp3-menu (mp3-menu "/space/mp3" "/cdrom"))
 
43
;;
 
44
;; . You should change "/space/mp3" to the path of a directory
 
45
;;   containing your MP3 playlists.
 
46
;;
 
47
;; . You should change "/cdrom" to the mount point of your CD
 
48
;;   drive, as configured in XMMS, or nil if you have none.
 
49
;;
 
50
;; . If you don't want the Music menu placed in your root menu,
 
51
;;   don't use install-mp3-menu.
 
52
 
 
53
;; Then restart sawfish. Your root menu will now have a Music submenu
 
54
;; containing a list of your artists; each artist will have a submenu
 
55
;; containing their titles. There is also a control submenu and an
 
56
;; option to start playing the CD in your drive.
 
57
 
 
58
(define-structure merlin.mp3
 
59
  (export
 
60
   mp3-menu
 
61
   install-mp3-menu)
 
62
 
 
63
  (open
 
64
   rep
 
65
   rep.regexp
 
66
   rep.system
 
67
   rep.io.files
 
68
   sawfish.wm.menus)
 
69
 
 
70
  ;; Create an XMMS MP3 playlist menu {Artists}->{Titles} from a
 
71
  ;; directory containing playlists and optional CD mount point.
 
72
  (define (mp3-menu dir #!optional cdrom)
 
73
    (lambda ()
 
74
      (nconc
 
75
       (cons
 
76
        `("Control" . (("Play" (system "xmms --play &"))
 
77
                       ("Stop" (system "xmms --stop &"))
 
78
                       ("Prev" (system "xmms --rew &"))
 
79
                       ("Next" (system "xmms --fwd &"))))
 
80
        (and cdrom
 
81
             (cons `("CD" (system ,(concat "xmms " cdrom " &"))) nil)))
 
82
       (let*
 
83
           ((playlist-p
 
84
             (lambda (playlist)
 
85
               (string-match ".m3u$" playlist)))
 
86
            (playlists (sort (delete-if-not playlist-p (directory-files dir))))
 
87
            (uniquify-sorted
 
88
             (lambda (l)
 
89
               (let loop ((rest l))
 
90
                    (cond ((null rest) l)
 
91
                          ((equal (car rest) (cadr rest))
 
92
                           (rplacd rest (cddr rest)) (loop rest))
 
93
                          (t (loop (cdr rest)))))))
 
94
            (artist-f
 
95
             (lambda (playlist)
 
96
               (string-match "-" playlist)
 
97
               (substring playlist 0 (match-start))))
 
98
            (artists (uniquify-sorted (mapcar artist-f playlists)))
 
99
            (quotees (list 32 40 41 42 44 63))
 
100
            (quote-file-name
 
101
             (lambda (file)
 
102
               (let loop ((i 0) (s ""))
 
103
                    (if (eq i (length file))
 
104
                        s
 
105
                      (let ((c (aref file i)))
 
106
                        (loop (1+ i) (concat s (and (memq c quotees) 92) c)))))))
 
107
            (play
 
108
             (lambda (playlist)
 
109
               (let* ((quoted (quote-file-name playlist))
 
110
                      (file-name (expand-file-name quoted dir)))
 
111
                 (system (concat "xmms " file-name " &"))))))
 
112
         (mapcar 
 
113
          (lambda (artist)
 
114
            (cons artist
 
115
                  (delq nil
 
116
                        (mapcar
 
117
                         (lambda (playlist)
 
118
                           (and (string-match (concat "^" artist "-") playlist)
 
119
                                (list (substring playlist (1+ (length artist)) (- (length playlist) 4))
 
120
                                      (lambda () (play playlist)))))
 
121
                         playlists))))
 
122
          artists)))))
 
123
 
 
124
  ;; Install an MP3 menu in the root menu beneath the apps entry, if
 
125
  ;; present; otherwise at the top of the menu.
 
126
  (define (install-mp3-menu mp3-menu)
 
127
    (let ((mp3-entry (lambda (next) (cons (cons "Music" mp3-menu) next))))
 
128
      (let loop ((menu root-menu))
 
129
           (cond ((null menu) (setq root-menu (mp3-entry root-menu)))
 
130
                 ((eq 'apps-menu (cdar menu)) (rplacd menu (mp3-entry (cdr menu))))
 
131
                 (t (loop (cdr menu))))))))
 
 
b'\\ No newline at end of file'