media.el

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