Update.
[elisp.git] / media.el
1 ;; -*- mode: emacs-lisp -*-
2
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ;; This program is free software; you can redistribute it and/or         ;;
5 ;; modify it under the terms of the GNU General Public License as        ;;
6 ;; published by the Free Software Foundation; either version 3, or (at   ;;
7 ;; your option) any later version.                                       ;;
8 ;;                                                                       ;;
9 ;; This program is distributed in the hope that it will be useful, but   ;;
10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
12 ;; General Public License for more details.                              ;;
13 ;;                                                                       ;;
14 ;; You should have received a copy of the GNU General Public License     ;;
15 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
16 ;;                                                                       ;;
17 ;; Written by and Copyright (C) Francois Fleuret                         ;;
18 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20
21 ;; A simple front-end major mode for command line media players (only
22 ;; mplayer for now, feel free to write the code for others)
23 ;;
24 ;; The strict minimum is to set in your ~/.emacs the variable
25 ;; media/url-list to the list of directories where to pick the tunes
26 ;; and the URLs of streams. For the latter you can also specify a name
27 ;; that will appear in the interface instead of the URL itself.
28 ;;
29 ;; I have in my ~/.emacs
30 ;;
31 ;; (when (load "media" nil t)
32 ;;
33 ;;   (setq media/expert t
34 ;;         media/add-current-song-to-interrupted-when-killing t
35 ;;         media/duration-to-history 30
36 ;;         media/history-size 1000
37 ;;         media/playlist-file "~/private/media-playlists"
38 ;;         media/mplayer/args '("-framedrop" "-zoom" "-subfont-osd-scale" "3" "-osdlevel" "3")
39 ;;         media/mplayer/timing-request-period 1.0
40 ;;         media/url-list '("~/mp3"
41 ;;                          ("http://www.technomusic.com/live/hi/pls" . "Technomusic.com")
42 ;;                          ("http://www.fullhouseradio.com/listen.pls" . "Full House Radio")
43 ;;                          ("mms://live.france24.com/france24_fr.wsx" . "France 24")
44 ;;                          ))
45 ;;
46 ;;   (define-key global-map [(meta \\)] 'media)
47 ;; )
48 ;;
49 ;; If you put media.el and media-mplayer.el in an exotic directory,
50 ;; you have to tell emacs to look for them there by adding something
51 ;; like (add-to-list 'load-path "~/exotic/") before the (load "media")
52 ;; command.
53
54 (defgroup media ()
55   "Major mode to control media players"
56   :version "1.2.2")
57
58 (defcustom media/player-api "media-mplayer"
59   "The file to load for the abstract layer with the media player."
60   :type 'string
61   :group 'media)
62
63 (defcustom media/url-list '()
64   "List of directories to be imported and urls. Each element can be
65 either a string containing a directory or an url, or a cons cell the
66 first element of which is a string containing a url and the second a
67 title to display in the list (convenient for internet radios)."
68   :type 'list
69   :group 'media)
70
71 (defcustom media/playlist-file "~/.media-playlists"
72   "Where to save the playlists."
73   :type 'string
74   :group 'media)
75
76 (defcustom media/duration-to-history 5
77   "Duration in seconds after which the song should be put in the history."
78   :type 'integer
79   :group 'media)
80
81 (defcustom media/playlist-at-top nil
82   "Should the playlists be created at the top of the media buffer?"
83   :type 'bool
84   :group 'media)
85
86 (defcustom media/add-current-song-to-interrupted-when-killing nil
87   "Should we save the current song with time in the Interrupted playlist?"
88   :type 'bool
89   :group 'media)
90
91 (defcustom media/do-not-remove-nonexisting-entries nil
92   "Should we remove the entries corresponding to a non-existing file when saving the playlists?"
93   :type 'bool
94   :group 'media)
95
96 (defcustom media/history-size 0
97   "How many songs to keep in the history list."
98   :type 'integer
99   :group 'media)
100
101 (defcustom media/continue-mode nil
102   "Should the player start the next song in the buffer when the current terminates?"
103   :type 'boolean
104   :group 'media)
105
106 (defcustom media/continue-mode-hint "*"
107   "What to append to the MPlayer string when in repeat mode"
108   :type 'string
109   :group 'media)
110
111 (defcustom media/expert nil
112   "Should we bypass the keymap help when starting"
113   :type 'boolean
114   :group 'media)
115
116 (defvar media/current-information nil
117   "Contains the name of the current file playing, the frequency in Hz
118 and the bitrate. Should be nil if no information is available.")
119
120 (defvar media/current-song-in-stream nil
121   "Contains the title of the current song playing, as it may be
122 parsed from the stream.")
123
124 (defvar media/buffer nil
125   "The main buffer for the media player mode.")
126
127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
128 ;; Hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
130
131 (defcustom media/finished-hook '(media/song-terminates)
132   "Hook called when the current playing song/movie terminates."
133   :type 'hook
134   :group 'media)
135
136 (defcustom media/starting-hook nil
137   "Hook called after the media buffer has been set up."
138   :type 'hook
139   :group 'media)
140
141 (defcustom media/before-play-hook nil
142   "Hook called before starting the player on a new song."
143   :type 'hook
144   :group 'media)
145
146 (defcustom media/play-hook '(media/show-current-information)
147   "Hook called when a song starts to play."
148   :type 'hook
149   :group 'media)
150
151 (defcustom media/error-hook '(media/player-error)
152   "Hook called when a player error occurs."
153   :type 'hook
154   :group 'media)
155
156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
157 ;; Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
158 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159
160 (defface media/playlist-face
161   '((((background dark)) (:foreground "blue" :bold t))
162     (((background light)) (:foreground "blue" :bold t)))
163   "Face for playlist names."
164   :group 'media)
165
166 (defface media/directory-face
167   '((((background dark)) (:foreground "green" :bold t))
168     (((background light)) (:foreground "forest green" :bold t)))
169   "Face for directories."
170   :group 'media)
171
172 (defface media/timestamp-face
173   '((((background dark)) (:foreground "turquoise"))
174     (((background light)) (:foreground "blue")))
175   "Face for the stored timestamps."
176   :group 'media)
177
178 (defface media/nonexisting-face
179   '((((background dark)) (:foreground "red"))
180     (((background light)) (:foreground "red3")))
181   "Face for non-existing files."
182   :group 'media)
183
184 (defface media/stream-face
185   '((((background dark)) (:foreground "green"))
186     (((background light)) (:foreground "green3")))
187   "Face for non-files urls."
188   :group 'media)
189
190 (defface media/current-tune-face
191   '((((background dark)) (:foreground "gray80" :background "black"))
192     (((background light)) (:foreground "black" :background "yellow")))
193   "Highlight of the currently playing tune."
194   :group 'media)
195
196 (defface media/instant-highlight-face
197   '((((background dark)) (:foreground "black" :background "lawn green"))
198     (((background light)) (:foreground "black" :background "lawn green")))
199   "Brief highlight when adding a tune to the \"Queue\" list."
200   :group 'media)
201
202 (defface media/mode-string-face
203   '((t (:foreground "darkblue" :bold t)))
204   "The face to display the media info in the modeline."
205   :group 'media)
206
207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
208 ;; Various initializations
209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
210
211 (setq media/current-overlay nil
212       media/instant-highlight-overlay nil
213       media/instant-highlight-timer nil
214       media/active-playlist nil)
215
216 (defun media/goto-top ()
217   (goto-char (text-property-any (point-min) (point-max) 'prologue nil)))
218
219 (defun media/goto-next-playlist-or-dir () (interactive)
220   (goto-char (min (next-single-char-property-change (point) 'playlist)
221                   (next-single-char-property-change (point) 'dir)))
222   (unless (< (point) (point-max)) (goto-char (point-min)))
223   (unless (or (get-text-property (point) 'playlist)
224               (get-text-property (point) 'dir))
225     (goto-char (min (next-single-char-property-change (point) 'playlist)
226                     (next-single-char-property-change (point) 'dir))))
227   )
228
229 (defun media/goto-previous-playlist-or-dir () (interactive)
230   (goto-char (max (previous-single-char-property-change (point) 'playlist)
231                   (previous-single-char-property-change (point) 'dir)))
232   (unless (> (point) (point-min)) (goto-char (point-max)))
233   (unless (or (get-text-property (point) 'playlist)
234               (get-text-property (point) 'dir))
235     (goto-char (max (previous-single-char-property-change (point) 'playlist)
236                     (previous-single-char-property-change (point) 'dir))))
237   )
238
239 (defun media/remove-instant-highlight ()
240   (move-overlay media/instant-highlight-overlay 0 0)
241   (setq media/instant-highlight-timer nil)
242   )
243
244 (defun media/instant-highlight (start end)
245   (move-overlay media/instant-highlight-overlay start end)
246   (when media/instant-highlight-timer
247     (cancel-timer media/instant-highlight-timer))
248   (setq media/instant-highlight-timer
249         (run-at-time 0.25 nil 'media/remove-instant-highlight)))
250
251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
252 ;; Finding and playing URLs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
253 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
254
255 (defun media/reset-current-information ()
256     (setq media/current-information nil
257           media/current-song-in-stream nil))
258
259 (defun media/format-url (url)
260   (if (string-match "^file:.*/\\([^/]+\\)$" url)
261       (match-string 1 url)
262     url)
263   )
264
265 (defun media/play-position (position) (interactive)
266   (let ((url (get-text-property position 'url))
267         (time (get-text-property position 'time)))
268     (if (not url) (media/remove-highlight)
269       (run-hook-with-args 'media/before-play-hook url)
270       (media/reset-current-information)
271       (media/api/play url)
272       ;; We keep the information of the url and the title
273       (setq media/played-information (cons url (get-text-property position 'title)))
274       (media/move-highlight position)
275       (when time (media/api/jump-at-time 'absolute time))
276       )))
277
278 (defun media/play-or-active-at-point () (interactive)
279   (if (get-text-property (point) 'url)
280       (media/play-position (point))
281     (let ((playlist (get-text-property (point) 'playlist)))
282       (when playlist
283         (setq media/active-playlist playlist)
284         (message "Active playlist is %s" media/active-playlist)))))
285
286 (defun media/goto-next () (interactive)
287   (let ((p (next-single-char-property-change (point) 'url)))
288     (while (and (< p (point-max)) (not (get-text-property p 'url)))
289       (setq p (next-single-char-property-change p 'url)))
290     (when (get-text-property p 'url)
291       (goto-char p))))
292
293 (defun media/play-next (&optional dont-move) (interactive)
294   (let ((p (next-single-char-property-change (overlay-start media/current-overlay) 'url)))
295     (while (and (< p (point-max)) (not (get-text-property p 'url)))
296       (setq p (next-single-char-property-change p 'url)))
297     (if (not (get-text-property p 'url))
298         (media/remove-highlight)
299       (media/play-position p)
300       (unless (or ;;(pos-visible-in-window-p p)
301                   dont-move)
302         (goto-char p)))))
303
304 (defun media/play-prev () (interactive)
305   (let ((p (previous-single-char-property-change (overlay-start media/current-overlay) 'url)))
306     (while (and (> p (point-min)) (not (get-text-property p 'url)))
307       (setq p (previous-single-char-property-change p 'url)))
308     (when (get-text-property p 'url)
309       (media/play-position p))
310     ;; (unless (pos-visible-in-window-p p)
311       (goto-char p)
312       ;; )
313     ))
314
315 (defun media/move-highlight (position)
316   (move-overlay media/current-overlay
317                 (previous-property-change (1+ position))
318                 ;; (next-property-change position)
319                 ;; (previous-single-char-property-change (1+ position) 'url)
320                 (next-single-char-property-change position 'url)
321                 ))
322
323 (defun media/remove-highlight ()
324   (move-overlay media/current-overlay 0 0))
325
326 (defun media/goto-current () (interactive)
327   (goto-char (overlay-start media/current-overlay)))
328
329 (defun media/jump-at-percent (&optional perc)
330   "Goes to a certain % of the song"
331   (interactive "P")
332   (media/api/jump-at-percent
333    (max 0
334         (min 100
335              (or perc
336                  (string-to-number (read-from-minibuffer "Percentage: ")))))))
337
338 (defun media/refresh-list (&optional dir) (interactive)
339   (when media/buffer
340     (let* ((current (overlay-end media/current-overlay))
341            (url (get-text-property current 'url))
342            ;; (playlist (get-text-property current 'playlist))
343            (w (get-buffer-window media/buffer)))
344
345       (if (not w) (media/full-refresh)
346         (let ((p (point))
347               (s (window-start w)))
348           (media/full-refresh)
349           (goto-char p)
350           (set-window-start w s)))
351
352       ))
353
354   ;; TODO: Move the overlay where they were before refresh
355
356   (message "Refreshed!"))
357
358 ;; TODO: Refresh only the directories which have to be
359
360 (defun media/rename-point () (interactive)
361   (let ((url (get-text-property (point) 'url)))
362     (when (and url (string-match "^file:/*\\(/.+\\)$" url))
363       (let* ((original (match-string-no-properties 1 url))
364              (new (read-from-minibuffer "New name: " original)))
365         (if (string= original new)
366             (message "Cancel")
367           (message "Renaming %s to %s" original new)
368           (rename-file original new)
369           (media/refresh-list (file-name-directory original))
370           (unless (string= (file-name-directory original) (file-name-directory new))
371             (media/refresh-list (file-name-directory new)))
372           )))))
373
374 (defun media/move-point-to-tmp () (interactive)
375   (let ((url (get-text-property (point) 'url)))
376     (unless (and url (string-match "^file:/*\\(/.+\\)$" url))
377       (error "No file here"))
378     (let* ((original (match-string-no-properties 1 url))
379            (new (replace-regexp-in-string "^.*/" "/tmp/" original)))
380       (if (string= original new)
381           (message "Cancel")
382         (message "Renaming %s into %s" original new)
383         (rename-file original new)
384         (media/refresh-list (file-name-directory original))
385         ))))
386
387 (setq media/id3-genre-table
388       [ "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
389         "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies"
390         "Other" "Pop" "R&B" "Rap" "Reggae" "Rock"
391         "Techno" "Industrial" "Alternative" "Ska" "Death Metal" "Pranks"
392         "Soundtrack" "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
393         "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
394         "Game" "Sound Clip" "Gospel" "Noise" "Alternative Rock" "Bass"
395         "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
396         "Instrumental Rock" "Ethnic" "Gothic" "Darkwave" "Techno-Industrial"
397         "Electronic" "Pop-Folk" "Eurodance" "Dream" "Southern Rock" "Comedy"
398         "Cult" "Gangsta" "Top 40" "Christian Rap" "Pop/Funk" "Jungle"
399         "Native US" "Cabaret" "New Wave" "Psychadelic" "Rave" "Showtunes"
400         "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" "Retro"
401         "Musical" "Rock & Roll" "Hard Rock" "Folk" "Folk-Rock" "National Folk"
402         "Swing" "Fast Fusion" "Bebob" "Latin" "Revival" "Celtic" "Bluegrass"
403         "Gothic Rock" "Progressive Rock" "Psychedelic Rock" "Symphonic Rock"
404         "Slow Rock" "Big Band" "Chorus" "Easy Listening" "Acoustic" "Humour"
405         "Speech" "Chanson" "Opera" "Chamber Music" "Sonata" "Symphony"
406         "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
407         "Samba" "Folklore" "Ballad" "Power Ballad" "Rythmic Soul" "Freestyle"
408         "Duet" "Punk Rock" "Drum Solo" "Acapella" "Euro-House" "Dance Hall"
409         "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie" "BritPop"
410         "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
411         "Black Metal" "Crossover" "Contemporary Christian" "Christian Rock"
412         "Merengue" "Salsa" "Trash Metal" ])
413
414 (defun media/get-file-id3-tags (file)
415   "Returns the id3 tags in a list (SONG ARTIST ALBUM YEAR NOTE GENRE),
416 returns nil if no id3 tags could be found."
417   (let ((size (elt (file-attributes file) 7)))
418     (unless (integerp size) (error "Can not read the file ID3 information (file probably too big)"))
419     (with-temp-buffer
420       (when (and (> size 128)
421                  (insert-file-contents-literally file nil (- size 128) size t)
422                  (string= (buffer-substring 1 4) "TAG"))
423         ;; Here we have the 128 last bytes of the file in a temporary
424         ;; buffer, and the three first characters are "TAG"
425         (append
426          ;; We get the 5 first id3s
427          (mapcar (lambda (pos)
428                    (replace-regexp-in-string
429                     "[\0 ]*$" ""
430                     (buffer-substring (car pos) (cdr pos))))
431                  '((4 . 34) (34 . 64) (64 . 94) (94 . 98) (98 . 127)))
432          ;; And we decode the last one with the genre table
433          (list
434           (condition-case nil
435               (elt media/id3-genre-table (string-to-char
436                                           (buffer-substring 128 129)))
437             (error "<Error>"))))))))
438
439 (defun media/show-id3-at-point ()
440   (interactive)
441   (let ((url (get-text-property (point) 'url)))
442     (when url
443       (if (not (string-match "^file:/*\\(/.+\\)$" url))
444           (message "This is not a file!")
445         (let* ((filename (match-string-no-properties 1 url)))
446           (if (file-exists-p filename)
447               (let ((id3tags (media/get-file-id3-tags filename)))
448                 (if id3tags
449                     (message
450                      "%s Song [%s] Artist [%s] Album [%s] Year [%s] Note [%s] Genre [%s]"
451                      filename
452                      (elt id3tags 0)
453                      (elt id3tags 1)
454                      (elt id3tags 2)
455                      (elt id3tags 3)
456                      (elt id3tags 4)
457                      (elt id3tags 5))
458                   (message "%s (no id3 tags) " filename)))
459             (message "No such file (%s)!" filename)))))))
460
461 (defun media/rename-point-according-to-id3 ()
462   "Renames the file located at point, according to the ID3 tags"
463   (interactive)
464   (let ((url (get-text-property (point) 'url)))
465     (when (and url (string-match "^file:/*\\(/.+\\)$" url))
466       (if (file-exists-p (match-string-no-properties 1 url))
467           (let* ((filename (match-string-no-properties 1 url))
468                  (id3tags (media/get-file-id3-tags filename)))
469             (if id3tags
470                 (let* ((original (match-string-no-properties 1 url))
471                        (new (read-from-minibuffer "New name: "
472                                                   (replace-regexp-in-string
473                                                    " " "_"
474                                                    (concat (replace-regexp-in-string
475                                                             "[^/]+$" "" (match-string-no-properties 1 url))
476                                                            (elt id3tags 1)
477                                                            "_-_"
478                                                            (elt id3tags 0)
479                                                            ".mp3")))))
480                   (if (string= original new)
481                       (message "Cancel")
482                     (message "Renaming %s into %s" original new)
483                     (rename-file original new)
484                     (media/refresh-list)
485                     ))
486               (message "%s (no id3 tags) " filename)))
487         (message "No such file!")))))
488
489 ;; TODO: Finish
490
491 (defun media/edit-id3-at-point ()
492   "Open a new buffer with the ID3 fields of the file on line editable."
493   (interactive)
494   (let ((url (get-text-property (point) 'url)))
495     (when (and url (string-match "^file:/*\\(/.+\\)$" url))
496       (if (file-exists-p (match-string-no-properties 1 url))
497           (let* ((filename (match-string-no-properties 1 url))
498                  (id3tags (or (media/get-file-id3-tags filename) '("-" "-" "-" "-" "-" "-"))))
499             (let ((map (make-sparse-keymap)))
500
501               (switch-to-buffer (get-buffer-create (generate-new-buffer-name "*media ID3 editor*")))
502
503               (text-mode)
504               (auto-fill-mode)
505
506               (mapc (lambda (s)
507                       (insert (if (numberp s) (elt id3tags s)
508                                 (propertize s 'read-only t 'rear-nonsticky '(read-only)))))
509
510                     '("SONG:   " 0 "\n"
511                       "ARTIST: " 1 "\n"
512                       "ALBUM:  " 2 "\n"
513                       "YEAR:   " 3 "\n"
514                       "NOTE:   " 4 "\n"
515                       "GENRE:  " 5 "\n"))
516
517               (goto-char (point-min))
518               (re-search-forward "SONG:   ")
519
520               (define-key map (kbd "TAB")
521                 (lambda () (interactive)
522                   (unless (re-search-forward ": +" nil t)
523                     (goto-char (point-min))
524                     (re-search-forward ": +" nil t))))
525
526               (define-key map [(control c) (control c)]
527                 (lambda () (interactive)
528                   (kill-this-buffer)
529                   )
530                 )
531
532               (define-key map [(control c) (control q)]
533                 (lambda () (interactive)
534                   (kill-this-buffer)
535                   (message "Cancel")
536                   ))
537
538               (use-local-map map)
539               (message "C-c C-c to save the information, C-c C-q to cancel")
540               )
541             )
542         )
543       )
544     )
545   )
546
547 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
548 ;; Adding objects in the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
549 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
550
551 (defun media/separator ()
552   (unless (and (eq (char-before) ?\n) (eq (char-before (1- (point))) ?\n))
553     (insert "\n")))
554
555 (defun media/insert-url (url depth &optional info)
556   (insert
557    (if (listp url)
558        (propertize (concat " "
559                            (make-string (* 2 depth) ?\ )
560                            info
561                            " "
562                            (media/format-url (cdr url)) "\n")
563                    'url (car url)
564                    'title (cdr url))
565
566      (propertize (concat " "
567                          (make-string (* 2 depth) ?\ )
568                          info
569                          " "
570                          (media/format-url url) "\n")
571                  'url url
572                  'title nil))
573    ))
574
575 (defun media/string-from-size (size)
576   (if (< size 1024) (format "%5db" size)
577     (if (< size 1048576) (format "%5dk" (ash size -10))
578       (format "%5.01fM" (/ size 1048576.0))
579       )))
580
581 (defun media/insert-file (filename depth)
582   (media/insert-url (concat "file://" (file-truename filename))
583                     depth
584                     (concat (media/string-from-size (nth 7 (file-attributes filename))) " --")
585                     ))
586
587 (defun media/insert-dir (filename depth)
588   (media/separator)
589
590   (insert (propertize (concat "  "
591                               (make-string (* 2 depth) ?\ )
592                               filename
593                               "\n") 'face 'media/directory-face 'dir filename))
594
595   (media/separator)
596
597   (let ((dircontent (directory-files-and-attributes filename)))
598
599     (mapc (lambda (file)
600             (unless (string-match "^\\." (car file))
601               (let ((url (concat filename "/" (car file))))
602                 (when (file-regular-p url)
603                   (media/insert-file url depth)))))
604           dircontent)
605
606     (media/separator)
607
608     (mapc (lambda (file)
609             (unless (string-match "^\\." (car file))
610               (let ((url (concat filename "/" (car file))))
611                 (when (file-directory-p url)
612                   (media/insert-dir url (1+ depth))))))
613           dircontent)
614     )
615   )
616
617 (defun media/import (list)
618
619   (message "Importing the list of URLs")
620
621   (media/separator)
622
623   (mapc (lambda (c)
624           (let* ((url (or (and (consp c) (car c)) c))
625                  (title (or (and (consp c) (cdr c)) url)))
626             (if (string-match "^\\(http\\|mms\\)://" url)
627                 (media/insert-url (cons url title) 0)
628               (if (file-exists-p url)
629                   (if (file-regular-p url) (media/insert-file url 0)
630                     (if (file-directory-p url) (media/insert-dir url 0)
631                       (error "Unknown type `%s'" url))))
632               )))
633         list))
634
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;; Saving and loading the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
638
639 (defun media/save-playlists () (interactive)
640
641   (let ((list '()))
642
643     (with-current-buffer media/buffer
644       (let ((pos (point-min))
645             (end (point-max)))
646
647         (while (< (setq pos
648                         (next-single-char-property-change pos 'url)
649                         ;; (min (next-single-char-property-change pos 'url)
650                         ;; (next-single-char-property-change pos 'time))
651                         ) end)
652
653           (let ((url (get-text-property pos 'url))
654                 (title (get-text-property pos 'title))
655                 (time (get-text-property pos 'time))
656                 (playlist (get-text-property pos 'playlist)))
657
658             ;; (message "url=%s title=%s time=%s playlist=%s"
659             ;; (prin1-to-string url)
660             ;; (prin1-to-string title)
661             ;; (prin1-to-string time)
662             ;; (prin1-to-string playlist))
663
664             (when (and playlist url)
665               (unless (assoc playlist list) (push (list playlist) list))
666               (push (cons url (cons title time)) (cdr (assoc playlist list)))
667               )))))
668
669     (with-current-buffer (find-file-noselect media/playlist-file)
670       (erase-buffer)
671       (mapc (lambda (x)
672               (insert "PLAYLIST:" (car x) "\n")
673               (mapc (lambda (y)
674                       (when (or media/do-not-remove-nonexisting-entries
675                                 (not (string-match "^file:" (car y)))
676                                 (file-exists-p (replace-regexp-in-string "^file://" "" (car y))))
677                         (when (car (cdr y)) (insert "TITLE:" (car (cdr y)) "\n"))
678                         (when (cdr (cdr y)) (insert "TIME:" (number-to-string (cdr (cdr y))) "\n"))
679                         (insert "URL:" (car y) "\n")))
680                     (reverse (cdr x)))
681               )
682             (reverse list))
683       (set-buffer-file-coding-system 'utf-8)
684       (save-buffer)
685       (kill-this-buffer)
686       ))
687
688   (set-buffer-modified-p nil))
689
690 (defun media/load-playlists () (interactive)
691   (if (file-exists-p media/playlist-file)
692       (with-temp-buffer
693         (insert-file media/playlist-file)
694         ;; (insert-file-contents-literally media/playlist-file)
695         (goto-char (point-min))
696         (let ((playlist nil)
697               (title nil)
698               (time nil))
699           (while (re-search-forward "^\\([A-Z]*\\):\\(.*\\)$" nil t)
700             (eval (cdr (assoc (match-string-no-properties 1)
701                               '(("PLAYLIST" . (setq playlist (match-string-no-properties 2)))
702                                 ("TITLE" . (setq title (match-string-no-properties 2)))
703                                 ("TIME" . (setq time (string-to-number (match-string-no-properties 2))))
704                                 ("URL" . (save-excursion
705                                            (media/add-song-to-playlist
706                                             playlist (match-string-no-properties 2) title time)
707                                            (setq title nil
708                                                  time nil)))))))
709             )))))
710
711 (defun media/select-active-playlist ()
712   (interactive)
713   (with-current-buffer media/buffer
714     (let ((playlists nil)
715           (pos (point-min))
716           (end (point-max)))
717
718       ;; Build the list of existing playlists
719       (while (< (setq pos (next-single-char-property-change pos 'playlist)) end)
720         (add-to-list 'playlists (list (get-text-property pos 'playlist))))
721
722       (setq media/active-playlist
723             (completing-read "Select playlist: " playlists))
724
725       (message "Using `%s' as active playlist" media/active-playlist)))
726   )
727
728 (defun media/create-playlist (name)
729   (interactive "MPlaylist to create: ")
730   (when (media/playlist-position name) (error "Playlist already existing"))
731   (save-excursion
732     (if media/playlist-at-top (media/goto-top)
733       (goto-char (point-max)))
734     (media/separator)
735     (insert (propertize (concat "  " name "\n") 'playlist name 'face 'media/playlist-face)
736             (propertize "\n" 'playlist name)
737             )
738     (setq media/active-playlist name)
739     ;; (message "Playlist `%s' created" name)
740     ))
741
742 (defun media/playlist-position (name)
743   "Returns the position where the given playlist starts."
744   (let ((pos (point-min)))
745     (while (and (setq pos (next-single-char-property-change pos 'playlist))
746                 (not (string= name (get-text-property pos 'playlist)))
747                 (< pos (point-max))))
748     (and (< pos (point-max)) pos)))
749
750 ;; (defun media/playlist-position (name)
751 ;;   (text-property-any (point-min) (point-max) 'playlist name))
752
753 ;; (defun media/url-position (url &optional playlist)
754 ;;   (let ((pos (point-min)))
755 ;;     (while (and (setq pos (next-single-char-property-change pos 'playlist))
756 ;;                 (not (string= name (get-text-property pos 'playlist)))
757 ;;                 (< pos (point-max))))
758 ;;     (and (< pos (point-max)) pos)))
759
760 (defun media/playlist-content (playlist)
761   (let ((pos (point-min))
762         (urls ()))
763     (while (and (setq pos (next-single-char-property-change pos 'url))
764                 (string= playlist (get-text-property pos 'playlist))
765                 (< pos (point-max)))
766       (setq urls (cons (cons pos (get-text-property pos 'url)) urls)))
767     (nreverse urls)))
768
769 (defun media/put-in-history ()
770   (set-buffer media/buffer)
771   (when (> media/history-size 0)
772     (let* ((urls (media/playlist-content "History"))
773            (l (length urls))
774            (current-url (car media/current-information))
775            ;; For the title, if the URL we are actually playing is the
776            ;; one we intended to play, we use the accompagnying title
777            (current-title
778             (if (string= (car media/played-information) current-url)
779                 (cdr media/played-information))))
780
781       (media/add-song-to-playlist "History" current-url current-title)
782
783       (when (> (1+ l) media/history-size)
784         (delete-region (car (car urls))
785                        (car (nth (- l media/history-size) urls)))))))
786
787 (defun media/add-song-at-point-to-active-playlist () (interactive)
788   (if media/active-playlist
789       (let ((url (get-text-property (point) 'url))
790             (title (get-text-property (point) 'title))
791             (time (get-text-property (point) 'time)))
792         (if (not url) (error "No song at point")
793           (media/add-song-to-playlist media/active-playlist url title time)
794           (message "Added %s to playlist `%s'" (or title url) media/active-playlist)
795           (media/instant-highlight
796            (previous-single-char-property-change (1+ (point)) 'url)
797            (next-single-char-property-change (point) 'url))
798           (media/goto-next)))
799     (error "No current playlist")))
800
801 (defun media/add-current-song-to-active-playlist (&optional settime) (interactive "P")
802   (if media/active-playlist
803       (let ((url (get-text-property (overlay-start media/current-overlay) 'url))
804             (title (get-text-property (overlay-start media/current-overlay) 'title)))
805         (if (not url) (error "No current song")
806           (media/add-song-to-playlist media/active-playlist url title (and settime media/song-current-time))
807           (message "Added %s to playlist `%s'" (or title url) media/active-playlist)))
808     (error "No current playlist")))
809
810 (defun media/add-song-to-playlist (playlist url &optional title time)
811   (set-buffer media/buffer)
812   (let ((pos (or (media/playlist-position playlist)
813                  (progn (media/create-playlist playlist)
814                         (media/playlist-position playlist)))))
815     (unless pos (error (format "Weird: There is no playlist \"%s\" but can not create it") playlist))
816     (save-excursion
817       (goto-char (next-single-char-property-change pos 'playlist))
818       (prog1 (point)
819         (insert (propertize (concat
820                              "  "
821                              (or title (media/format-url url))
822                              (if time (propertize
823                                        (concat " @" (media/duration-to-string time))
824                                        'face 'media/timestamp-face
825                                        ))
826                              "\n"
827                              )
828                             'url url
829                             'title title
830                             'time time
831                             'playlist (get-text-property (1- (point)) 'playlist))))
832       )))
833
834 (defun media/pause () (interactive)
835   (message "Pause")
836   (media/api/pause))
837
838 (defun media/stop () (interactive)
839   (message "Stop")
840   (media/reset-current-information)
841   (media/api/stop))
842
843 (defun media/queue-song-at-point ()
844   "Switches to the 'continue' mode. If a song is currently playing and
845 not in the 'Queue' playlist, adds it. Then, adds the url at point to
846 the 'Queue' playlist, and plays it if no song is currently playing."
847   (interactive)
848
849   ;; If a song is playing and not in the the Queue list, put it
850
851   (when (and media/current-information
852              (not (string= (get-text-property (overlay-end media/current-overlay) 'playlist)
853                            "Queue")))
854
855     (let* ((url (nth 0 media/current-information))
856            (title (if (string= (car media/played-information) url) (cdr media/played-information)))
857            (pos (media/add-song-to-playlist "Queue" url title)))
858
859       (move-overlay media/current-overlay
860                     pos
861                     (next-single-char-property-change pos 'url))))
862
863   (let* ((position (point)))
864     (media/instant-highlight
865      (previous-single-char-property-change (1+ position) 'url)
866      (next-single-char-property-change position 'url))
867     )
868
869   (let* ((position (point))
870          (url (get-text-property position 'url))
871          (title (get-text-property position 'title))
872          (time (get-text-property position 'time))
873          (pos (and url (media/add-song-to-playlist "Queue" url title time))))
874
875     (when (and pos (not media/current-information)) (media/play-position pos))
876
877     (next-line 1)
878     (setq media/continue-mode t)
879     (force-mode-line-update)
880     )
881
882   )
883
884 (defun media/add-song (url) (interactive))
885
886 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
887
888 (defun media/player-error ()
889   (message "Player error")
890   (media/reset-current-information)
891   (media/remove-highlight))
892
893 (defun media/song-terminates ()
894   (with-current-buffer media/buffer
895     (if media/continue-mode (media/play-next t)
896       (media/reset-current-information)
897       (media/remove-highlight))))
898
899 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
900
901 (defun media/switch-continue-mode ()
902   "Switches between a mode which automatically chains files and a mode
903 which stops when the songs ends."
904   (interactive)
905   (setq media/continue-mode (not media/continue-mode))
906   (force-mode-line-update)
907   (if media/continue-mode (message "Continue mode switched on.")
908     (message "Continue mode switched off."))
909   )
910
911 (defun media/duration-to-string (duration)
912   (let ((sec (mod duration 60))
913         (min (/ duration 60)))
914     (if (zerop duration) "0s"
915       (concat (if (>= min 1) (format "%dm" min))
916               (if (>= sec 1) (format "%ds" sec)))
917       )))
918
919 (defun media/mode-string ()
920   (propertize
921    (concat
922     " "
923     media/player-id
924     (if media/continue-mode media/continue-mode-hint)
925     " "
926
927     (if media/current-information
928         (if media/song-current-time
929             (media/duration-to-string media/song-current-time)
930           "?"
931           ))
932
933     (if (and media/song-duration (> media/song-duration 0))
934         (concat "/"
935                 (media/duration-to-string media/song-duration)))
936     )
937
938    'face 'media/mode-string-face)
939   )
940
941 (defun media/show-current-information ()
942   "Print a message with informations about the song currently playing"
943   (interactive)
944   (if media/current-information
945       (message "Now playing %s %s(%dHz, %s, %dkbit/s)"
946                (or (and (string= (car media/played-information) (nth 0 media/current-information))
947                         (cdr media/played-information))
948                    (replace-regexp-in-string "^.*/\\([^/]*\\)$" "\\1" (nth 0 media/current-information)))
949                ;; (if media/current-song-in-stream (concat "[" media/current-song-in-stream "] ") "")
950                (if media/current-song-in-stream (concat "| " media/current-song-in-stream " ") "")
951                (nth 1 media/current-information)
952                (if (= 2 (nth 2 media/current-information)) "stereo" "mono")
953                (nth 3 media/current-information))
954     (message "No song playing")))
955
956 (defun media/save-and-kill-buffer ()
957   "Save the playlists and kill the media buffer"
958   (interactive)
959
960   (condition-case nil
961       (when media/add-current-song-to-interrupted-when-killing
962         (setq media/active-playlist "Interrupted")
963         (media/add-current-song-to-active-playlist t)
964         )
965     (error nil))
966
967   (unless (condition-case nil
968               (media/save-playlists)
969             (error (not (y-or-n-p "Can not save the playlists. Still kill the media buffer? "))))
970     (kill-buffer media/buffer))
971   )
972
973 (defun media/insert-keybindings (keymap)
974   (insert (format "media/insert-keybindings [%s]" (prin1-to-string keymap)))
975   (insert "\n---------------\n")
976   (if (listp keymap)
977       (if (eq (car keymap) 'keymap)
978           (mapc 'media/insert-keybindings (cdr keymap)))
979     (unless (eq (cdr keymap) 'undefined)
980       (insert (format "%s -> %s\n"
981                       (prin1-to-string (car keymap))
982                       (prin1-to-string (cdr keymap)))))
983     ))
984
985 (defun media/show-keys (&optional keymap) (interactive)
986   (set-buffer (get-buffer-create "*media help*"))
987   (media/insert-keybindings media/mode-map))
988
989 (defun media/quick-help () (interactive)
990   (message "<return> play <n> add to the queue <p> pause <m> continue mode <q> bury the buffer <k> kill it"))
991
992 (defun media/move-forward () (interactive) (media/api/jump-at-time 'relative 3))
993 (defun media/move-backward () (interactive) (media/api/jump-at-time 'relative -3))
994 (defun media/volume-reset () (interactive) (media/api/set-volume 'absolute 50))
995 (defun media/volume-increase ()  (interactive) (media/api/set-volume 'relative 1))
996 (defun media/volume-decrease () (interactive) (media/api/set-volume 'relative -1))
997
998 (defun media/mode () (interactive)
999   (if media/buffer (error "We already have a media buffer"))
1000
1001   (kill-all-local-variables)
1002
1003   (unless (boundp 'media/mode-map)
1004
1005     (setq media/mode-map (make-sparse-keymap))
1006
1007     (suppress-keymap media/mode-map)
1008
1009     (mapc (lambda (x) (define-key media/mode-map (car x) (cdr x)))
1010           `(("p" . media/pause)
1011             ("\C-m" . media/play-or-active-at-point)
1012             ("\t" . media/goto-next-playlist-or-dir)
1013             ([(shift iso-lefttab)] . media/goto-previous-playlist-or-dir)
1014             (" " . media/goto-current)
1015             ("a" . media/add-song-at-point-to-active-playlist)
1016             ("A" . media/add-current-song-to-active-playlist)
1017             ("n" . media/queue-song-at-point)
1018             ("f" . media/show-id3-at-point)
1019             ("r" . media/rename-point)
1020             ("R" . media/rename-point-according-to-id3)
1021             ("K" . media/move-point-to-tmp)
1022             ("N" . media/play-next)
1023             ("P" . media/play-prev)
1024             ("q" . bury-buffer)
1025             ("k" . media/save-and-kill-buffer)
1026             ("s" . media/stop)
1027             ("m" . media/switch-continue-mode)
1028             ;; ("t" . media/switch-timing)
1029             ("g" . media/refresh-list)
1030             ("h" . media/quick-help)
1031             ("?" . media/quick-help)
1032             ("l" . media/select-active-playlist)
1033             ;;             ("L" . media/create-playlist)
1034             ("i" . media/show-current-information)
1035             ;; ("I" . media/edit-id3-at-point)
1036             ("j" . media/jump-at-percent)
1037             (">" . media/move-forward)
1038             ("<" . media/move-backward)
1039             ([(control >)] . (lambda () (interactive) (media/api/jump-at-time 'relative 30)))
1040             ([(control <)] . (lambda () (interactive) (media/api/jump-at-time 'relative -30)))
1041             ([(control x) (control s)] . media/save-playlists)
1042             ("=" . media/volume-reset)
1043             ("+" . media/volume-increase)
1044             ("-" . media/volume-decrease)
1045             )))
1046
1047   (setq major-mode 'media
1048         mode-name "Media"
1049         ;; buffer-read-only t
1050         truncate-lines t
1051         media/buffer (current-buffer)
1052         media/current-overlay (make-overlay 0 0)
1053         media/instant-highlight-overlay (make-overlay 0 0)
1054         media/song-current-time nil
1055         media/song-duration nil
1056         global-mode-string (append global-mode-string '((:eval (media/mode-string))))
1057         )
1058
1059   (overlay-put media/current-overlay 'face 'media/current-tune-face)
1060   (overlay-put media/instant-highlight-overlay 'face 'media/instant-highlight-face)
1061
1062   (use-local-map media/mode-map)
1063
1064   (add-hook 'kill-emacs-hook 'media/die-decently)
1065   (add-hook 'kill-buffer-hook 'media/kill-buffer-cleanup nil t)
1066   (add-hook 'write-contents-hooks 'media/save-buffer nil t)
1067   )
1068
1069 (defun media/die-decently ()
1070   (when media/add-current-song-to-interrupted-when-killing
1071     (condition-case nil
1072         (progn
1073           (setq media/active-playlist "Interrupted")
1074           (media/add-current-song-to-active-playlist t)
1075           (media/save-playlists))
1076       (error nil))
1077     )
1078   )
1079
1080 (defun media/kill-buffer-cleanup () (interactive)
1081   (media/api/cleanup)
1082   (setq media/buffer nil
1083         global-mode-string (remove '(:eval (media/mode-string)) global-mode-string))
1084   )
1085
1086 (defun media/full-refresh ()
1087
1088   (undo-boundary)
1089   (erase-buffer)
1090   (media/import media/url-list)
1091   (media/goto-top)
1092   (media/load-playlists)
1093
1094   (unless media/expert
1095     (insert (propertize "
1096   media.el
1097   Written and (C) Francois Fleuret
1098   Send comments and bug reports to francois@fleuret.org
1099
1100   Return   play or active the playlist for insertion
1101   Space    goto song playing
1102   p        pause
1103   g        refresh list
1104   a        insert song at point to the active playlist
1105   A        insert current song to the active playlist
1106            universal argument store the time too
1107   l        select active playlist
1108   C-x C-s  save playlists
1109   n        queue song for playing
1110   f        show ID3 of song
1111   r        rename song
1112   R        rename song according to ID3
1113   K        move song to /tmp
1114   N        play next
1115   P        play previous
1116   q        hide buffer
1117   k        stop song and kill buffer
1118   s        stop song
1119   m        switch the continuous mode
1120   i        show current song information
1121   j        jump at position
1122   >        fast forward
1123   <        fast backward
1124   Ctrl->   fast forward x10
1125   Ctrl-<   fast backward x10
1126   =        reset volume
1127   +        increase volume
1128   -        decrease volume
1129 " 'prologue t)))
1130
1131   (set-buffer-modified-p nil)
1132   (undo-boundary)
1133   )
1134
1135 (defun media/switch-to-buffer-or-window (buffer)
1136   (let ((w (get-buffer-window buffer)))
1137     (if w (select-window w)
1138       (switch-to-buffer buffer))))
1139
1140 (defun media ()
1141   "If a `media/buffer' exists, and we are not in it, switch to it, if
1142 we are already in it, bury it. If none exists, creates one and switch
1143 to it."
1144   (interactive)
1145
1146   (if media/buffer
1147       (if (eq (window-buffer (selected-window)) media/buffer)
1148           (bury-buffer)
1149         (media/switch-to-buffer-or-window media/buffer))
1150     (switch-to-buffer (get-buffer-create "*media*"))
1151     (buffer-disable-undo)
1152     (media/mode)
1153     (media/full-refresh)
1154     (buffer-enable-undo)
1155     (run-hooks 'media/starting-hook)
1156     )
1157   )
1158
1159 (load media/player-api)
1160
1161 (media/api/init)