1 ;; -*- mode: emacs-lisp -*-
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. ;;
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. ;;
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/>. ;;
17 ;; Written by and Copyright (C) Francois Fleuret ;;
18 ;; Contact <francois@fleuret.org> for comments & bug reports ;;
19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
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.
29 ;; I have in my ~/.emacs
31 ;; (when (load "media" nil t)
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")
46 ;; (define-key global-map [(meta \\)] 'media)
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")
55 "Major mode to control media players"
58 (defcustom media/player-api "media-mplayer"
59 "The file to load for the abstract layer with the media player."
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)."
71 (defcustom media/playlist-file "~/.media-playlists"
72 "Where to save the playlists."
76 (defcustom media/duration-to-history 5
77 "Duration in seconds after which the song should be put in the history."
81 (defcustom media/playlist-at-top nil
82 "Should the playlists be created at the top of the media buffer?"
86 (defcustom media/add-current-song-to-interrupted-when-killing nil
87 "Should we save the current song with time in the Interrupted playlist?"
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?"
96 (defcustom media/history-size 0
97 "How many songs to keep in the history list."
101 (defcustom media/continue-mode nil
102 "Should the player start the next song in the buffer when the current terminates?"
106 (defcustom media/expert nil
107 "Should the keymap help be shown?"
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.")
115 (defvar media/current-song-in-stream nil
116 "Contains the title of the current song playing, as it may be
117 parsed from the stream.")
119 (defvar media/buffer nil
120 "The main buffer for the media player mode.")
122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
123 ;; Hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
126 (defcustom media/finished-hook '(media/song-terminates)
127 "Hook called when the current playing song/movie terminates."
131 (defcustom media/starting-hook nil
132 "Hook called after the media buffer has been set up."
136 (defcustom media/before-play-hook nil
137 "Hook called before starting the player on a new song."
141 (defcustom media/play-hook '(media/show-current-information)
142 "Hook called when a song starts to play."
146 (defcustom media/error-hook '(media/player-error)
147 "Hook called when a player error occurs."
151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152 ;; Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
153 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
155 (defface media/playlist-face
156 '((((background dark)) (:foreground "blue" :bold t))
157 (((background light)) (:foreground "blue" :bold t)))
158 "Face for playlist names."
161 (defface media/directory-face
162 '((((background dark)) (:foreground "green" :bold t))
163 (((background light)) (:foreground "forest green" :bold t)))
164 "Face for directories."
167 (defface media/timestamp-face
168 '((((background dark)) (:foreground "turquoise"))
169 (((background light)) (:foreground "blue")))
170 "Face for the stored timestamps."
173 (defface media/nonexisting-face
174 '((((background dark)) (:foreground "red"))
175 (((background light)) (:foreground "red3")))
176 "Face for non-existing files."
179 (defface media/stream-face
180 '((((background dark)) (:foreground "green"))
181 (((background light)) (:foreground "green3")))
182 "Face for non-files urls."
185 (defface media/current-tune-face
186 '((((background dark)) (:foreground "gray80" :background "black"))
187 (((background light)) (:foreground "black" :background "yellow")))
188 "Highlight of the currently playing tune."
191 (defface media/instant-highlight-face
192 '((((background dark)) (:foreground "black" :background "lawn green"))
193 (((background light)) (:foreground "black" :background "lawn green")))
194 "Brief highlight when adding a tune to the \"Queue\" list."
197 (defface media/mode-string-face
198 '((t (:foreground "darkblue" :bold t)))
199 "The face to display the media info in the modeline."
202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
203 ;; Various initializations
204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
206 (setq media/current-overlay nil
207 media/instant-highlight-overlay nil
208 media/instant-highlight-timer nil
209 media/active-playlist nil)
211 (defun media/goto-top ()
212 (goto-char (text-property-any (point-min) (point-max) 'prologue nil)))
214 (defun media/goto-next-playlist-or-dir () (interactive)
215 (goto-char (min (next-single-char-property-change (point) 'playlist)
216 (next-single-char-property-change (point) 'dir)))
217 (unless (< (point) (point-max)) (goto-char (point-min)))
218 (unless (or (get-text-property (point) 'playlist)
219 (get-text-property (point) 'dir))
220 (goto-char (min (next-single-char-property-change (point) 'playlist)
221 (next-single-char-property-change (point) 'dir))))
224 (defun media/goto-previous-playlist-or-dir () (interactive)
225 (goto-char (max (previous-single-char-property-change (point) 'playlist)
226 (previous-single-char-property-change (point) 'dir)))
227 (unless (> (point) (point-min)) (goto-char (point-max)))
228 (unless (or (get-text-property (point) 'playlist)
229 (get-text-property (point) 'dir))
230 (goto-char (max (previous-single-char-property-change (point) 'playlist)
231 (previous-single-char-property-change (point) 'dir))))
234 (defun media/remove-instant-highlight ()
235 (move-overlay media/instant-highlight-overlay 0 0)
236 (setq media/instant-highlight-timer nil)
239 (defun media/instant-highlight (start end)
240 (move-overlay media/instant-highlight-overlay start end)
241 (when media/instant-highlight-timer
242 (cancel-timer media/instant-highlight-timer))
243 (setq media/instant-highlight-timer
244 (run-at-time 0.25 nil 'media/remove-instant-highlight)))
246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
247 ;; Finding and playing URLs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
250 (defun media/format-url (url)
251 (if (string-match "^file:.*/\\([^/]+\\)$" url)
256 (defun media/play-position (position) (interactive)
257 (let ((url (get-text-property position 'url))
258 (time (get-text-property position 'time)))
259 (if (not url) (media/remove-highlight)
260 (run-hook-with-args 'media/before-play-hook url)
261 (setq media/current-information nil
262 media/current-song-in-stream nil)
264 ;; We keep the information of the url and the title
265 (setq media/played-information (cons url (get-text-property position 'title)))
266 (media/move-highlight position)
267 (when time (media/api/jump-at-time 'absolute time))
270 (defun media/play-or-active-at-point () (interactive)
271 (if (get-text-property (point) 'url)
272 (media/play-position (point))
273 (let ((playlist (get-text-property (point) 'playlist)))
275 (setq media/active-playlist playlist)
276 (message "Active playlist is %s" media/active-playlist)))))
278 (defun media/goto-next () (interactive)
279 (let ((p (next-single-char-property-change (point) 'url)))
280 (while (and (< p (point-max)) (not (get-text-property p 'url)))
281 (setq p (next-single-char-property-change p 'url)))
282 (when (get-text-property p 'url)
285 (defun media/play-next (&optional dont-move) (interactive)
286 (let ((p (next-single-char-property-change (overlay-start media/current-overlay) 'url)))
287 (while (and (< p (point-max)) (not (get-text-property p 'url)))
288 (setq p (next-single-char-property-change p 'url)))
289 (if (not (get-text-property p 'url))
290 (media/remove-highlight)
291 (media/play-position p)
292 (unless (or ;;(pos-visible-in-window-p p)
296 (defun media/play-prev () (interactive)
297 (let ((p (previous-single-char-property-change (overlay-start media/current-overlay) 'url)))
298 (while (and (> p (point-min)) (not (get-text-property p 'url)))
299 (setq p (previous-single-char-property-change p 'url)))
300 (when (get-text-property p 'url)
301 (media/play-position p))
302 ;; (unless (pos-visible-in-window-p p)
307 (defun media/move-highlight (position)
308 (move-overlay media/current-overlay
309 (previous-property-change (1+ position))
310 ;; (next-property-change position)
311 ;; (previous-single-char-property-change (1+ position) 'url)
312 (next-single-char-property-change position 'url)
315 (defun media/remove-highlight ()
316 (move-overlay media/current-overlay 0 0))
318 (defun media/goto-current () (interactive)
319 (goto-char (overlay-start media/current-overlay)))
321 (defun media/jump-at-percent (&optional perc)
322 "Goes to a certain % of the song"
324 (media/api/jump-at-percent
328 (string-to-number (read-from-minibuffer "Percentage: ")))))))
330 (defun media/refresh-list (&optional dir) (interactive)
332 (let* ((current (overlay-end media/current-overlay))
333 (url (get-text-property current 'url))
334 ;; (playlist (get-text-property current 'playlist))
335 (w (get-buffer-window media/buffer)))
337 (if (not w) (media/full-refresh)
339 (s (window-start w)))
342 (set-window-start w s)))
346 ;; TODO: Move the overlay where they were before refresh
348 (message "Refreshed!"))
350 ;; TODO: Refresh only the directories which have to be
352 (defun media/rename-point () (interactive)
353 (let ((url (get-text-property (point) 'url)))
354 (when (and url (string-match "^file:/*\\(/.+\\)$" url))
355 (let* ((original (match-string-no-properties 1 url))
356 (new (read-from-minibuffer "New name: " original)))
357 (if (string= original new)
359 (message "Renaming %s to %s" original new)
360 (rename-file original new)
361 (media/refresh-list (file-name-directory original))
362 (unless (string= (file-name-directory original) (file-name-directory new))
363 (media/refresh-list (file-name-directory new)))
366 (defun media/move-point-to-tmp () (interactive)
367 (let ((url (get-text-property (point) 'url)))
368 (unless (and url (string-match "^file:/*\\(/.+\\)$" url))
369 (error "No file here"))
370 (let* ((original (match-string-no-properties 1 url))
371 (new (replace-regexp-in-string "^.*/" "/tmp/" original)))
372 (if (string= original new)
374 (message "Renaming %s into %s" original new)
375 (rename-file original new)
376 (media/refresh-list (file-name-directory original))
379 (setq media/id3-genre-table
380 [ "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
381 "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies"
382 "Other" "Pop" "R&B" "Rap" "Reggae" "Rock"
383 "Techno" "Industrial" "Alternative" "Ska" "Death Metal" "Pranks"
384 "Soundtrack" "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
385 "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
386 "Game" "Sound Clip" "Gospel" "Noise" "Alternative Rock" "Bass"
387 "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
388 "Instrumental Rock" "Ethnic" "Gothic" "Darkwave" "Techno-Industrial"
389 "Electronic" "Pop-Folk" "Eurodance" "Dream" "Southern Rock" "Comedy"
390 "Cult" "Gangsta" "Top 40" "Christian Rap" "Pop/Funk" "Jungle"
391 "Native US" "Cabaret" "New Wave" "Psychadelic" "Rave" "Showtunes"
392 "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" "Retro"
393 "Musical" "Rock & Roll" "Hard Rock" "Folk" "Folk-Rock" "National Folk"
394 "Swing" "Fast Fusion" "Bebob" "Latin" "Revival" "Celtic" "Bluegrass"
395 "Gothic Rock" "Progressive Rock" "Psychedelic Rock" "Symphonic Rock"
396 "Slow Rock" "Big Band" "Chorus" "Easy Listening" "Acoustic" "Humour"
397 "Speech" "Chanson" "Opera" "Chamber Music" "Sonata" "Symphony"
398 "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
399 "Samba" "Folklore" "Ballad" "Power Ballad" "Rythmic Soul" "Freestyle"
400 "Duet" "Punk Rock" "Drum Solo" "Acapella" "Euro-House" "Dance Hall"
401 "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie" "BritPop"
402 "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
403 "Black Metal" "Crossover" "Contemporary Christian" "Christian Rock"
404 "Merengue" "Salsa" "Trash Metal" ])
406 (defun media/get-file-id3-tags (file)
407 "Returns the id3 tags in a list (SONG ARTIST ALBUM YEAR NOTE GENRE),
408 returns nil if no id3 tags could be found."
409 (let ((size (elt (file-attributes file) 7)))
410 (unless (integerp size) (error "Can not read the file ID3 information (file probably too big)"))
412 (when (and (> size 128)
413 (insert-file-contents-literally file nil (- size 128) size t)
414 (string= (buffer-substring 1 4) "TAG"))
415 ;; Here we have the 128 last bytes of the file in a temporary
416 ;; buffer, and the three first characters are "TAG"
418 ;; We get the 5 first id3s
419 (mapcar (lambda (pos)
420 (replace-regexp-in-string
422 (buffer-substring (car pos) (cdr pos))))
423 '((4 . 34) (34 . 64) (64 . 94) (94 . 98) (98 . 127)))
424 ;; And we decode the last one with the genre table
427 (elt media/id3-genre-table (string-to-char
428 (buffer-substring 128 129)))
429 (error "<Error>"))))))))
431 (defun media/show-id3-at-point ()
433 (let ((url (get-text-property (point) 'url)))
435 (if (not (string-match "^file:/*\\(/.+\\)$" url))
436 (message "This is not a file!")
437 (let* ((filename (match-string-no-properties 1 url)))
438 (if (file-exists-p filename)
439 (let ((id3tags (media/get-file-id3-tags filename)))
442 "%s Song [%s] Artist [%s] Album [%s] Year [%s] Note [%s] Genre [%s]"
450 (message "%s (no id3 tags) " filename)))
451 (message "No such file (%s)!" filename)))))))
453 (defun media/rename-point-according-to-id3 ()
454 "Renames the file located at point, according to the ID3 tags"
456 (let ((url (get-text-property (point) 'url)))
457 (when (and url (string-match "^file:/*\\(/.+\\)$" url))
458 (if (file-exists-p (match-string-no-properties 1 url))
459 (let* ((filename (match-string-no-properties 1 url))
460 (id3tags (media/get-file-id3-tags filename)))
462 (let* ((original (match-string-no-properties 1 url))
463 (new (read-from-minibuffer "New name: "
464 (replace-regexp-in-string
466 (concat (replace-regexp-in-string
467 "[^/]+$" "" (match-string-no-properties 1 url))
472 (if (string= original new)
474 (message "Renaming %s into %s" original new)
475 (rename-file original new)
478 (message "%s (no id3 tags) " filename)))
479 (message "No such file!")))))
483 (defun media/edit-id3-at-point ()
484 "Open a new buffer with the ID3 fields of the file on line editable."
486 (let ((url (get-text-property (point) 'url)))
487 (when (and url (string-match "^file:/*\\(/.+\\)$" url))
488 (if (file-exists-p (match-string-no-properties 1 url))
489 (let* ((filename (match-string-no-properties 1 url))
490 (id3tags (or (media/get-file-id3-tags filename) '("-" "-" "-" "-" "-" "-"))))
491 (let ((map (make-sparse-keymap)))
493 (switch-to-buffer (get-buffer-create (generate-new-buffer-name "*media ID3 editor*")))
499 (insert (if (numberp s) (elt id3tags s)
500 (propertize s 'read-only t 'rear-nonsticky '(read-only)))))
509 (goto-char (point-min))
510 (re-search-forward "SONG: ")
512 (define-key map (kbd "TAB")
513 (lambda () (interactive)
514 (unless (re-search-forward ": +" nil t)
515 (goto-char (point-min))
516 (re-search-forward ": +" nil t))))
518 (define-key map [(control c) (control c)]
519 (lambda () (interactive)
524 (define-key map [(control c) (control q)]
525 (lambda () (interactive)
531 (message "C-c C-c to save the information, C-c C-q to cancel")
539 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
540 ;; Adding objects in the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
543 (defun media/separator ()
544 (unless (and (eq (char-before) ?\n) (eq (char-before (1- (point))) ?\n))
547 (defun media/insert-url (url depth &optional info)
550 (propertize (concat " "
551 (make-string (* 2 depth) ?\ )
554 (media/format-url (cdr url)) "\n")
558 (propertize (concat " "
559 (make-string (* 2 depth) ?\ )
562 (media/format-url url) "\n")
567 (defun media/string-from-size (size)
568 (if (< size 1024) (format "%5db" size)
569 (if (< size 1048576) (format "%5dk" (ash size -10))
570 (format "%5.01fM" (/ size 1048576.0))
573 (defun media/insert-file (filename depth)
574 (media/insert-url (concat "file://" (file-truename filename))
576 (concat (media/string-from-size (nth 7 (file-attributes filename))) " --")
579 (defun media/insert-dir (filename depth)
582 (insert (propertize (concat " "
583 (make-string (* 2 depth) ?\ )
585 "\n") 'face 'media/directory-face 'dir filename))
589 (let ((dircontent (directory-files-and-attributes filename)))
592 (unless (string-match "^\\." (car file))
593 (let ((url (concat filename "/" (car file))))
594 (when (file-regular-p url)
595 (media/insert-file url depth)))))
601 (unless (string-match "^\\." (car file))
602 (let ((url (concat filename "/" (car file))))
603 (when (file-directory-p url)
604 (media/insert-dir url (1+ depth))))))
609 (defun media/import (list)
611 (message "Importing the list of URLs")
616 (let* ((url (or (and (consp c) (car c)) c))
617 (title (or (and (consp c) (cdr c)) url)))
618 (if (string-match "^\\(http\\|mms\\)://" url)
619 (media/insert-url (cons url title) 0)
620 (if (file-regular-p url) (media/insert-file url 0)
621 (if (file-directory-p url) (media/insert-dir url 0)
622 (error "Unknown type `%s'" url))))))
625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
626 ;; Saving and loading the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
629 (defun media/save-playlists () (interactive)
633 (with-current-buffer media/buffer
634 (let ((pos (point-min))
638 (next-single-char-property-change pos 'url)
639 ;; (min (next-single-char-property-change pos 'url)
640 ;; (next-single-char-property-change pos 'time))
643 (let ((url (get-text-property pos 'url))
644 (title (get-text-property pos 'title))
645 (time (get-text-property pos 'time))
646 (playlist (get-text-property pos 'playlist)))
648 ;; (message "url=%s title=%s time=%s playlist=%s"
649 ;; (prin1-to-string url)
650 ;; (prin1-to-string title)
651 ;; (prin1-to-string time)
652 ;; (prin1-to-string playlist))
654 (when (and playlist url)
655 (unless (assoc playlist list) (push (list playlist) list))
656 (push (cons url (cons title time)) (cdr (assoc playlist list)))
660 (set-buffer (find-file-noselect media/playlist-file))
663 (insert "PLAYLIST:" (car x) "\n")
665 (when (or media/do-not-remove-nonexisting-entries
666 (not (string-match "^file:" (car y)))
667 (file-exists-p (replace-regexp-in-string "^file://" "" (car y))))
668 (when (car (cdr y)) (insert "TITLE:" (car (cdr y)) "\n"))
669 (when (cdr (cdr y)) (insert "TIME:" (number-to-string (cdr (cdr y))) "\n"))
670 (insert "URL:" (car y) "\n")))
674 (set-buffer-file-coding-system 'utf-8)
679 (set-buffer-modified-p nil))
681 (defun media/load-playlists () (interactive)
682 (if (file-exists-p media/playlist-file)
684 (insert-file media/playlist-file)
685 ;; (insert-file-contents-literally media/playlist-file)
686 (goto-char (point-min))
690 (while (re-search-forward "^\\([A-Z]*\\):\\(.*\\)$" nil t)
691 (eval (cdr (assoc (match-string-no-properties 1)
692 '(("PLAYLIST" . (setq playlist (match-string-no-properties 2)))
693 ("TITLE" . (setq title (match-string-no-properties 2)))
694 ("TIME" . (setq time (string-to-number (match-string-no-properties 2))))
695 ("URL" . (save-excursion
696 (media/add-song-to-playlist
697 playlist (match-string-no-properties 2) title time)
702 (defun media/select-active-playlist ()
704 (with-current-buffer media/buffer
705 (let ((playlists nil)
709 ;; Build the list of existing playlists
710 (while (< (setq pos (next-single-char-property-change pos 'playlist)) end)
711 (add-to-list 'playlists (list (get-text-property pos 'playlist))))
713 (setq media/active-playlist
714 (completing-read "Select playlist: " playlists))
716 (message "Using `%s' as active playlist" media/active-playlist)))
719 (defun media/create-playlist (name)
720 (interactive "MPlaylist to create: ")
721 (when (media/playlist-position name) (error "Playlist already existing"))
723 (if media/playlist-at-top (media/goto-top)
724 (goto-char (point-max)))
726 (insert (propertize (concat " " name "\n") 'playlist name 'face 'media/playlist-face)
727 (propertize "\n" 'playlist name)
729 (setq media/active-playlist name)
730 (message "Playlist `%s' created" name)))
732 (defun media/playlist-position (name)
733 "Returns the position where the given playlist starts."
734 (let ((pos (point-min)))
735 (while (and (setq pos (next-single-char-property-change pos 'playlist))
736 (not (string= name (get-text-property pos 'playlist)))
737 (< pos (point-max))))
738 (and (< pos (point-max)) pos)))
740 ;; (defun media/playlist-position (name)
741 ;; (text-property-any (point-min) (point-max) 'playlist name))
743 ;; (defun media/url-position (url &optional playlist)
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)))
750 (defun media/playlist-content (playlist)
751 (let ((pos (point-min))
753 (while (and (setq pos (next-single-char-property-change pos 'url))
754 (string= playlist (get-text-property pos 'playlist))
756 (setq urls (cons (cons pos (get-text-property pos 'url)) urls)))
759 (defun media/put-in-history ()
760 (set-buffer media/buffer)
761 (when (> media/history-size 0)
762 (let* ((urls (media/playlist-content "History"))
764 (current-url (car media/current-information))
765 ;; For the title, if the URL we are actually playing is the
766 ;; one we intended to play, we use the accompagnying title
768 (if (string= (car media/played-information) current-url)
769 (cdr media/played-information))))
771 (media/add-song-to-playlist "History" current-url current-title)
773 (when (> (1+ l) media/history-size)
774 (delete-region (car (car urls))
775 (car (nth (- l media/history-size) urls)))))))
777 (defun media/add-song-at-point-to-active-playlist () (interactive)
778 (if media/active-playlist
779 (let ((url (get-text-property (point) 'url))
780 (title (get-text-property (point) 'title))
781 (time (get-text-property (point) 'time)))
782 (if (not url) (error "No song at point")
783 (media/add-song-to-playlist media/active-playlist url title time)
784 (message "Added %s to playlist `%s'" (or title url) media/active-playlist)
785 (media/instant-highlight
786 (previous-single-char-property-change (1+ (point)) 'url)
787 (next-single-char-property-change (point) 'url))
789 (error "No current playlist")))
791 (defun media/add-current-song-to-active-playlist (&optional settime) (interactive "P")
792 (if media/active-playlist
793 (let ((url (get-text-property (overlay-start media/current-overlay) 'url))
794 (title (get-text-property (overlay-start media/current-overlay) 'title)))
795 (if (not url) (error "No current song")
796 (media/add-song-to-playlist media/active-playlist url title (and settime media/song-current-time))
797 (message "Added %s to playlist `%s'" (or title url) media/active-playlist)))
798 (error "No current playlist")))
800 (defun media/add-song-to-playlist (playlist url &optional title time)
801 (set-buffer media/buffer)
802 (let ((pos (or (media/playlist-position playlist)
803 (progn (media/create-playlist playlist)
804 (media/playlist-position playlist)))))
805 (unless pos (error (format "Weird: There is no playlist \"%s\" but can not create it") playlist))
807 (goto-char (next-single-char-property-change pos 'playlist))
809 (insert (propertize (concat
811 (or title (media/format-url url))
813 (concat " @" (media/duration-to-string time))
814 'face 'media/timestamp-face
821 'playlist (get-text-property (1- (point)) 'playlist))))
824 (defun media/pause () (interactive)
828 (defun media/stop () (interactive)
830 (setq media/current-information nil
831 media/current-song-in-stream nil)
834 (defun media/queue-song-at-point ()
835 "Switches to the 'continue' mode. If a song is currently playing and
836 not in the 'Queue' playlist, adds it. Then, adds the url at point to
837 the 'Queue' playlist, and plays it if no song is currently playing."
840 ;; If a song is playing and not in the the Queue list, put it
842 (when (and media/current-information
843 (not (string= (get-text-property (overlay-end media/current-overlay) 'playlist)
846 (let* ((url (nth 0 media/current-information))
847 (title (if (string= (car media/played-information) url) (cdr media/played-information)))
848 (pos (media/add-song-to-playlist "Queue" url title)))
850 (move-overlay media/current-overlay
852 (next-single-char-property-change pos 'url))))
854 (let* ((position (point)))
855 (media/instant-highlight
856 (previous-single-char-property-change (1+ position) 'url)
857 (next-single-char-property-change position 'url))
860 (let* ((position (point))
861 (url (get-text-property position 'url))
862 (title (get-text-property position 'title))
863 (time (get-text-property position 'time))
864 (pos (and url (media/add-song-to-playlist "Queue" url title time))))
866 (when (and pos (not media/current-information)) (media/play-position pos))
869 (setq media/continue-mode t)
870 (force-mode-line-update)
875 (defun media/add-song (url) (interactive))
877 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
879 (defun media/player-error ()
880 (message "Player error")
881 (setq media/current-information nil
882 media/current-song-in-stream nil)
883 (media/remove-highlight))
885 (defun media/song-terminates ()
886 (with-current-buffer media/buffer
887 (if media/continue-mode (media/play-next t)
888 (setq media/current-information nil
889 media/current-song-in-stream nil)
890 (media/remove-highlight))))
892 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
894 (defun media/switch-continue-mode ()
895 "Switches between a mode which automatically chains files and a mode
896 which stops when the songs ends."
898 (setq media/continue-mode (not media/continue-mode))
899 (force-mode-line-update)
900 (if media/continue-mode (message "Continue mode switched on.")
901 (message "Continue mode switched off."))
904 (defun media/duration-to-string (duration)
905 (let ((sec (mod duration 60))
906 (min (/ duration 60)))
907 (if (zerop duration) "0s"
908 (concat (if (>= min 1) (format "%dm" min))
909 (if (>= sec 1) (format "%ds" sec)))
912 (defun media/mode-string ()
917 (if media/continue-mode "*")
920 (if media/current-information
921 (if media/song-current-time
922 (media/duration-to-string media/song-current-time)
926 (if (and media/song-duration (> media/song-duration 0))
928 (media/duration-to-string media/song-duration)))
931 'face 'media/mode-string-face)
934 (defun media/show-current-information ()
935 "Print a message with informations about the song currently playing"
937 (if media/current-information
938 (message "Now playing %s %s(%dHz, %s, %dkbit/s)"
939 (or (and (string= (car media/played-information) (nth 0 media/current-information))
940 (cdr media/played-information))
941 (replace-regexp-in-string "^.*/\\([^/]*\\)$" "\\1" (nth 0 media/current-information)))
942 (if media/current-song-in-stream (concat "[" media/current-song-in-stream "] ") "")
943 (nth 1 media/current-information)
944 (if (= 2 (nth 2 media/current-information)) "stereo" "mono")
945 (nth 3 media/current-information))
946 (message "No song playing")))
948 (defun media/save-and-kill-buffer ()
949 "Save the playlists and kill the media buffer"
953 (when media/add-current-song-to-interrupted-when-killing
954 (setq media/active-playlist "Interrupted")
955 (media/add-current-song-to-active-playlist t)
959 (unless (condition-case nil
960 (media/save-playlists)
961 (error (not (y-or-n-p "Can not save the playlists. Still kill the media buffer? "))))
962 (kill-buffer media/buffer))
965 (defun media/insert-keybindings (keymap)
966 (insert (format "media/insert-keybindings [%s]" (prin1-to-string keymap)))
967 (insert "\n---------------\n")
969 (if (eq (car keymap) 'keymap)
970 (mapc 'media/insert-keybindings (cdr keymap)))
971 (unless (eq (cdr keymap) 'undefined)
972 (insert (format "%s -> %s\n"
973 (prin1-to-string (car keymap))
974 (prin1-to-string (cdr keymap)))))
977 (defun media/show-keys (&optional keymap) (interactive)
978 (set-buffer (get-buffer-create "*media help*"))
979 (media/insert-keybindings media/mode-map))
981 (defun media/quick-help () (interactive)
982 (message "<return> play <n> add to the queue <p> pause <m> continue mode <q> bury the buffer <k> kill it"))
984 (defun media/move-forward () (interactive) (media/api/jump-at-time 'relative 3))
985 (defun media/move-backward () (interactive) (media/api/jump-at-time 'relative -3))
986 (defun media/volume-reset () (interactive) (media/api/set-volume 'absolute 50))
987 (defun media/volume-increase () (interactive) (media/api/set-volume 'relative 1))
988 (defun media/volume-decrease () (interactive) (media/api/set-volume 'relative -1))
990 (defun media/mode () (interactive)
991 (if media/buffer (error "We already have a media buffer"))
993 (kill-all-local-variables)
995 (unless (boundp 'media/mode-map)
997 (setq media/mode-map (make-sparse-keymap))
999 (suppress-keymap media/mode-map)
1001 (mapc (lambda (x) (define-key media/mode-map (car x) (cdr x)))
1002 `(("p" . media/pause)
1003 ("\C-m" . media/play-or-active-at-point)
1004 ("\t" . media/goto-next-playlist-or-dir)
1005 ([(shift iso-lefttab)] . media/goto-previous-playlist-or-dir)
1006 (" " . media/goto-current)
1007 ("a" . media/add-song-at-point-to-active-playlist)
1008 ("A" . media/add-current-song-to-active-playlist)
1009 ("n" . media/queue-song-at-point)
1010 ("f" . media/show-id3-at-point)
1011 ("r" . media/rename-point)
1012 ("R" . media/rename-point-according-to-id3)
1013 ("K" . media/move-point-to-tmp)
1014 ("N" . media/play-next)
1015 ("P" . media/play-prev)
1017 ("k" . media/save-and-kill-buffer)
1019 ("m" . media/switch-continue-mode)
1020 ;; ("t" . media/switch-timing)
1021 ("g" . media/refresh-list)
1022 ("h" . media/quick-help)
1023 ("?" . media/quick-help)
1024 ("l" . media/select-active-playlist)
1025 ;; ("L" . media/create-playlist)
1026 ("i" . media/show-current-information)
1027 ;; ("I" . media/edit-id3-at-point)
1028 ("j" . media/jump-at-percent)
1029 (">" . media/move-forward)
1030 ("<" . media/move-backward)
1031 ([(control >)] . (lambda () (interactive) (media/api/jump-at-time 'relative 30)))
1032 ([(control <)] . (lambda () (interactive) (media/api/jump-at-time 'relative -30)))
1033 ([(control x) (control s)] . media/save-playlists)
1034 ("=" . media/volume-reset)
1035 ("+" . media/volume-increase)
1036 ("-" . media/volume-decrease)
1039 (setq major-mode 'media
1041 ;; buffer-read-only t
1043 media/buffer (current-buffer)
1044 media/current-overlay (make-overlay 0 0)
1045 media/instant-highlight-overlay (make-overlay 0 0)
1046 media/song-current-time nil
1047 media/song-duration nil
1048 global-mode-string (append global-mode-string '((:eval (media/mode-string))))
1051 (overlay-put media/current-overlay 'face 'media/current-tune-face)
1052 (overlay-put media/instant-highlight-overlay 'face 'media/instant-highlight-face)
1054 (use-local-map media/mode-map)
1056 (add-hook 'kill-emacs-hook 'media/die-decently)
1057 (add-hook 'kill-buffer-hook 'media/kill-buffer-cleanup nil t)
1058 (add-hook 'write-contents-hooks 'media/save-buffer nil t)
1061 (defun media/die-decently ()
1062 (when media/add-current-song-to-interrupted-when-killing
1065 (setq media/active-playlist "Interrupted")
1066 (media/add-current-song-to-active-playlist t)
1067 (media/save-playlists))
1072 (defun media/kill-buffer-cleanup () (interactive)
1074 (setq media/buffer nil
1075 global-mode-string (remove '(:eval (media/mode-string)) global-mode-string))
1078 (defun media/full-refresh ()
1082 (media/import media/url-list)
1084 (media/load-playlists)
1086 (unless media/expert
1087 (insert (propertize "
1089 Written and (C) Francois Fleuret
1090 Send comments and bug reports to francois@fleuret.org
1092 Return play or active the playlist for insertion
1093 Space goto song playing
1096 a insert song at point to the active playlist
1097 A insert current song to the active playlist
1098 universal argument store the time too
1099 l select active playlist
1100 C-x C-s save playlists
1101 n queue song for playing
1104 R rename song according to ID3
1109 k stop song and kill buffer
1111 m switch the continuous mode
1112 i show current song information
1116 Ctrl-> fast forward x10
1117 Ctrl-< fast backward x10
1123 (set-buffer-modified-p nil)
1127 (defun media/switch-to-buffer-or-window (buffer)
1128 (let ((w (get-buffer-window buffer)))
1129 (if w (select-window w)
1130 (switch-to-buffer buffer))))
1133 "If a `media/buffer' exists, and we are not in it, switch to it, if
1134 we are already in it, bury it. If none exists, creates one and switch
1139 (if (eq (window-buffer (selected-window)) media/buffer)
1141 (media/switch-to-buffer-or-window media/buffer))
1142 (switch-to-buffer (get-buffer-create "*media*"))
1143 (buffer-disable-undo)
1145 (media/full-refresh)
1146 (buffer-enable-undo)
1147 (run-hooks 'media/starting-hook)
1151 (load media/player-api)