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/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/format-url (url)
 251   (if (string-match "^file:.*/\\([^/]+\\)$" url)
 252       (match-string 1 url)
 253     url)
 254   )
 255
 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)
 263       (media/api/play url)
 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))
 268       )))
 269
 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)))
 274       (when playlist
 275         (setq media/active-playlist playlist)
 276         (message "Active playlist is %s" media/active-playlist)))))
 277
 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)
 283       (goto-char p))))
 284
 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)
 293                   dont-move)
 294         (goto-char p)))))
 295
 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)
 303       (goto-char p)
 304       ;; )
 305     ))
 306
 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)
 313                 ))
 314
 315 (defun media/remove-highlight ()
 316   (move-overlay media/current-overlay 0 0))
 317
 318 (defun media/goto-current () (interactive)
 319   (goto-char (overlay-start media/current-overlay)))
 320
 321 (defun media/jump-at-percent (&optional perc)
 322   "Goes to a certain % of the song"
 323   (interactive "P")
 324   (media/api/jump-at-percent
 325    (max 0
 326         (min 100
 327              (or perc
 328                  (string-to-number (read-from-minibuffer "Percentage: ")))))))
 329
 330 (defun media/refresh-list (&optional dir) (interactive)
 331   (when media/buffer
 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)))
 336
 337       (if (not w) (media/full-refresh)
 338         (let ((p (point))
 339               (s (window-start w)))
 340           (media/full-refresh)
 341           (goto-char p)
 342           (set-window-start w s)))
 343
 344       ))
 345
 346   ;; TODO: Move the overlay where they were before refresh
 347
 348   (message "Refreshed!"))
 349
 350 ;; TODO: Refresh only the directories which have to be
 351
 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)
 358             (message "Cancel")
 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)))
 364           )))))
 365
 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)
 373           (message "Cancel")
 374         (message "Renaming %s into %s" original new)
 375         (rename-file original new)
 376         (media/refresh-list (file-name-directory original))
 377         ))))
 378
 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" ])
 405
 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)"))
 411     (with-temp-buffer
 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"
 417         (append
 418          ;; We get the 5 first id3s
 419          (mapcar (lambda (pos)
 420                    (replace-regexp-in-string
 421                     "[\0 ]*$" ""
 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
 425          (list
 426           (condition-case nil
 427               (elt media/id3-genre-table (string-to-char
 428                                           (buffer-substring 128 129)))
 429             (error "<Error>"))))))))
 430
 431 (defun media/show-id3-at-point ()
 432   (interactive)
 433   (let ((url (get-text-property (point) 'url)))
 434     (when 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)))
 440                 (if id3tags
 441                     (message
 442                      "%s Song [%s] Artist [%s] Album [%s] Year [%s] Note [%s] Genre [%s]"
 443                      filename
 444                      (elt id3tags 0)
 445                      (elt id3tags 1)
 446                      (elt id3tags 2)
 447                      (elt id3tags 3)
 448                      (elt id3tags 4)
 449                      (elt id3tags 5))
 450                   (message "%s (no id3 tags) " filename)))
 451             (message "No such file (%s)!" filename)))))))
 452
 453 (defun media/rename-point-according-to-id3 ()
 454   "Renames the file located at point, according to the ID3 tags"
 455   (interactive)
 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)))
 461             (if id3tags
 462                 (let* ((original (match-string-no-properties 1 url))
 463                        (new (read-from-minibuffer "New name: "
 464                                                   (replace-regexp-in-string
 465                                                    " " "_"
 466                                                    (concat (replace-regexp-in-string
 467                                                             "[^/]+$" "" (match-string-no-properties 1 url))
 468                                                            (elt id3tags 1)
 469                                                            "_-_"
 470                                                            (elt id3tags 0)
 471                                                            ".mp3")))))
 472                   (if (string= original new)
 473                       (message "Cancel")
 474                     (message "Renaming %s into %s" original new)
 475                     (rename-file original new)
 476                     (media/refresh-list)
 477                     ))
 478               (message "%s (no id3 tags) " filename)))
 479         (message "No such file!")))))
 480
 481 ;; TODO: Finish
 482
 483 (defun media/edit-id3-at-point ()
 484   "Open a new buffer with the ID3 fields of the file on line editable."
 485   (interactive)
 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)))
 492
 493               (switch-to-buffer (get-buffer-create (generate-new-buffer-name "*media ID3 editor*")))
 494
 495               (text-mode)
 496               (auto-fill-mode)
 497
 498               (mapc (lambda (s)
 499                       (insert (if (numberp s) (elt id3tags s)
 500                                 (propertize s 'read-only t 'rear-nonsticky '(read-only)))))
 501
 502                     '("SONG:   " 0 "\n"
 503                       "ARTIST: " 1 "\n"
 504                       "ALBUM:  " 2 "\n"
 505                       "YEAR:   " 3 "\n"
 506                       "NOTE:   " 4 "\n"
 507                       "GENRE:  " 5 "\n"))
 508
 509               (goto-char (point-min))
 510               (re-search-forward "SONG:   ")
 511
 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))))
 517
 518               (define-key map [(control c) (control c)]
 519                 (lambda () (interactive)
 520                   (kill-this-buffer)
 521                   )
 522                 )
 523
 524               (define-key map [(control c) (control q)]
 525                 (lambda () (interactive)
 526                   (kill-this-buffer)
 527                   (message "Cancel")
 528                   ))
 529
 530               (use-local-map map)
 531               (message "C-c C-c to save the information, C-c C-q to cancel")
 532               )
 533             )
 534         )
 535       )
 536     )
 537   )
 538
 539 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 540 ;; Adding objects in the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 542
 543 (defun media/separator ()
 544   (unless (and (eq (char-before) ?\n) (eq (char-before (1- (point))) ?\n))
 545     (insert "\n")))
 546
 547 (defun media/insert-url (url depth &optional info)
 548   (insert
 549    (if (listp url)
 550        (propertize (concat " "
 551                            (make-string (* 2 depth) ?\ )
 552                            info
 553                            " "
 554                            (media/format-url (cdr url)) "\n")
 555                    'url (car url)
 556                    'title (cdr url))
 557
 558      (propertize (concat " "
 559                          (make-string (* 2 depth) ?\ )
 560                          info
 561                          " "
 562                          (media/format-url url) "\n")
 563                  'url url
 564                  'title nil))
 565    ))
 566
 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))
 571       )))
 572
 573 (defun media/insert-file (filename depth)
 574   (media/insert-url (concat "file://" (file-truename filename))
 575                     depth
 576                     (concat (media/string-from-size (nth 7 (file-attributes filename))) " --")
 577                     ))
 578
 579 (defun media/insert-dir (filename depth)
 580   (media/separator)
 581
 582   (insert (propertize (concat "  "
 583                               (make-string (* 2 depth) ?\ )
 584                               filename
 585                               "\n") 'face 'media/directory-face 'dir filename))
 586
 587   (media/separator)
 588
 589   (let ((dircontent (directory-files-and-attributes filename)))
 590
 591     (mapc (lambda (file)
 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)))))
 596           dircontent)
 597
 598     (media/separator)
 599
 600     (mapc (lambda (file)
 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))))))
 605           dircontent)
 606     )
 607   )
 608
 609 (defun media/import (list)
 610
 611   (message "Importing the list of URLs")
 612
 613   (media/separator)
 614
 615   (mapc (lambda (c)
 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))))))
 623         list))
 624
 625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 626 ;; Saving and loading the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 628
 629 (defun media/save-playlists () (interactive)
 630
 631   (let ((list '()))
 632
 633     (with-current-buffer media/buffer
 634       (let ((pos (point-min))
 635             (end (point-max)))
 636
 637         (while (< (setq pos
 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))
 641                         ) end)
 642
 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)))
 647
 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))
 653
 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)))
 657               )))))
 658
 659     (save-excursion
 660       (set-buffer (find-file-noselect media/playlist-file))
 661       (erase-buffer)
 662       (mapc (lambda (x)
 663               (insert "PLAYLIST:" (car x) "\n")
 664               (mapc (lambda (y)
 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")))
 671                     (reverse (cdr x)))
 672               )
 673             (reverse list))
 674       (set-buffer-file-coding-system 'utf-8)
 675       (save-buffer)
 676       (kill-this-buffer)
 677       ))
 678
 679   (set-buffer-modified-p nil))
 680
 681 (defun media/load-playlists () (interactive)
 682   (if (file-exists-p media/playlist-file)
 683       (with-temp-buffer
 684         (insert-file media/playlist-file)
 685         ;; (insert-file-contents-literally media/playlist-file)
 686         (goto-char (point-min))
 687         (let ((playlist nil)
 688               (title nil)
 689               (time nil))
 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)
 698                                            (setq title nil
 699                                                  time nil)))))))
 700             )))))
 701
 702 (defun media/select-active-playlist ()
 703   (interactive)
 704   (with-current-buffer media/buffer
 705     (let ((playlists nil)
 706           (pos (point-min))
 707           (end (point-max)))
 708
 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))))
 712
 713       (setq media/active-playlist
 714             (completing-read "Select playlist: " playlists))
 715
 716       (message "Using `%s' as active playlist" media/active-playlist)))
 717   )
 718
 719 (defun media/create-playlist (name)
 720   (interactive "MPlaylist to create: ")
 721   (when (media/playlist-position name) (error "Playlist already existing"))
 722   (save-excursion
 723     (if media/playlist-at-top (media/goto-top)
 724       (goto-char (point-max)))
 725     (media/separator)
 726     (insert (propertize (concat "  " name "\n") 'playlist name 'face 'media/playlist-face)
 727             (propertize "\n" 'playlist name)
 728             )
 729     (setq media/active-playlist name)
 730     (message "Playlist `%s' created" name)))
 731
 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)))
 739
 740 ;; (defun media/playlist-position (name)
 741 ;;   (text-property-any (point-min) (point-max) 'playlist name))
 742
 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)))
 749
 750 (defun media/playlist-content (playlist)
 751   (let ((pos (point-min))
 752         (urls ()))
 753     (while (and (setq pos (next-single-char-property-change pos 'url))
 754                 (string= playlist (get-text-property pos 'playlist))
 755                 (< pos (point-max)))
 756       (setq urls (cons (cons pos (get-text-property pos 'url)) urls)))
 757     (nreverse urls)))
 758
 759 (defun media/put-in-history ()
 760   (set-buffer media/buffer)
 761   (when (> media/history-size 0)
 762     (let* ((urls (media/playlist-content "History"))
 763            (l (length urls))
 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
 767            (current-title
 768             (if (string= (car media/played-information) current-url)
 769                 (cdr media/played-information))))
 770
 771       (media/add-song-to-playlist "History" current-url current-title)
 772
 773       (when (> (1+ l) media/history-size)
 774         (delete-region (car (car urls))
 775                        (car (nth (- l media/history-size) urls)))))))
 776
 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))
 788           (media/goto-next)))
 789     (error "No current playlist")))
 790
 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")))
 799
 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))
 806     (save-excursion
 807       (goto-char (next-single-char-property-change pos 'playlist))
 808       (prog1 (point)
 809         (insert (propertize (concat
 810                              "  "
 811                              (or title (media/format-url url))
 812                              (if time (propertize
 813                                        (concat " @" (media/duration-to-string time))
 814                                        'face 'media/timestamp-face
 815                                        ))
 816                              "\n"
 817                              )
 818                             'url url
 819                             'title title
 820                             'time time
 821                             'playlist (get-text-property (1- (point)) 'playlist))))
 822       )))
 823
 824 (defun media/pause () (interactive)
 825   (message "Pause")
 826   (media/api/pause))
 827
 828 (defun media/stop () (interactive)
 829   (message "Stop")
 830   (setq media/current-information nil
 831         media/current-song-in-stream nil)
 832   (media/api/stop))
 833
 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."
 838   (interactive)
 839
 840   ;; If a song is playing and not in the the Queue list, put it
 841
 842   (when (and media/current-information
 843              (not (string= (get-text-property (overlay-end media/current-overlay) 'playlist)
 844                            "Queue")))
 845
 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)))
 849
 850       (move-overlay media/current-overlay
 851                     pos
 852                     (next-single-char-property-change pos 'url))))
 853
 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))
 858     )
 859
 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))))
 865
 866     (when (and pos (not media/current-information)) (media/play-position pos))
 867
 868     (next-line 1)
 869     (setq media/continue-mode t)
 870     (force-mode-line-update)
 871     )
 872
 873   )
 874
 875 (defun media/add-song (url) (interactive))
 876
 877 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 878
 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))
 884
 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))))
 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                (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")))
 947
 948 (defun media/save-and-kill-buffer ()
 949   "Save the playlists and kill the media buffer"
 950   (interactive)
 951
 952   (condition-case nil
 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)
 956         )
 957     (error nil))
 958
 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))
 963   )
 964
 965 (defun media/insert-keybindings (keymap)
 966   (insert (format "media/insert-keybindings [%s]" (prin1-to-string keymap)))
 967   (insert "\n---------------\n")
 968   (if (listp keymap)
 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)))))
 975     ))
 976
 977 (defun media/show-keys (&optional keymap) (interactive)
 978   (set-buffer (get-buffer-create "*media help*"))
 979   (media/insert-keybindings media/mode-map))
 980
 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"))
 983
 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))
 989
 990 (defun media/mode () (interactive)
 991   (if media/buffer (error "We already have a media buffer"))
 992
 993   (kill-all-local-variables)
 994
 995   (unless (boundp 'media/mode-map)
 996
 997     (setq media/mode-map (make-sparse-keymap))
 998
 999     (suppress-keymap media/mode-map)
1000
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)
1016             ("q" . bury-buffer)
1017             ("k" . media/save-and-kill-buffer)
1018             ("s" . media/stop)
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)
1037             )))
1038
1039   (setq major-mode 'media
1040         mode-name "Media"
1041         ;; buffer-read-only t
1042         truncate-lines 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))))
1049         )
1050
1051   (overlay-put media/current-overlay 'face 'media/current-tune-face)
1052   (overlay-put media/instant-highlight-overlay 'face 'media/instant-highlight-face)
1053
1054   (use-local-map media/mode-map)
1055
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)
1059   )
1060
1061 (defun media/die-decently ()
1062   (when media/add-current-song-to-interrupted-when-killing
1063     (condition-case nil
1064         (progn
1065           (setq media/active-playlist "Interrupted")
1066           (media/add-current-song-to-active-playlist t)
1067           (media/save-playlists))
1068       (error nil))
1069     )
1070   )
1071
1072 (defun media/kill-buffer-cleanup () (interactive)
1073   (media/api/cleanup)
1074   (setq media/buffer nil
1075         global-mode-string (remove '(:eval (media/mode-string)) global-mode-string))
1076   )
1077
1078 (defun media/full-refresh ()
1079
1080   (undo-boundary)
1081   (erase-buffer)
1082   (media/import media/url-list)
1083   (media/goto-top)
1084   (media/load-playlists)
1085
1086   (unless media/expert
1087     (insert (propertize "
1088   media.el
1089   Written and (C) Francois Fleuret
1090   Send comments and bug reports to francois@fleuret.org
1091
1092   Return   play or active the playlist for insertion
1093   Space    goto song playing
1094   p        pause
1095   g        refresh list
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
1102   f        show ID3 of song
1103   r        rename song
1104   R        rename song according to ID3
1105   K        move song to /tmp
1106   N        play next
1107   P        play previous
1108   q        hide buffer
1109   k        stop song and kill buffer
1110   s        stop song
1111   m        switch the continuous mode
1112   i        show current song information
1113   j        jump at position
1114   >        fast forward
1115   <        fast backward
1116   Ctrl->   fast forward x10
1117   Ctrl-<   fast backward x10
1118   =        reset volume
1119   +        increase volume
1120   -        decrease volume
1121 " 'prologue t)))
1122
1123   (set-buffer-modified-p nil)
1124   (undo-boundary)
1125   )
1126
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))))
1131
1132 (defun media ()
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
1135 to it."
1136   (interactive)
1137
1138   (if media/buffer
1139       (if (eq (window-buffer (selected-window)) media/buffer)
1140           (bury-buffer)
1141         (media/switch-to-buffer-or-window media/buffer))
1142     (switch-to-buffer (get-buffer-create "*media*"))
1143     (buffer-disable-undo)
1144     (media/mode)
1145     (media/full-refresh)
1146     (buffer-enable-undo)
1147     (run-hooks 'media/starting-hook)
1148     )
1149   )
1150
1151 (load media/player-api)
1152
1153 (media/api/init)