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