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