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   (media/api/stop))
 826
 827 (defun media/queue-song-at-point ()
 828   "Switches to the 'continue' mode. If a song is currently playing and
 829 not in the 'Queue' playlist, adds it. Then, adds the url at point to
 830 the 'Queue' playlist, and plays it if no song is currently playing."
 831   (interactive)
 832
 833   ;; If a song is playing and not in the the Queue list, put it
 834
 835   (when (and media/current-information
 836              (not (string= (get-text-property (overlay-end media/current-overlay) 'playlist)
 837                            "Queue")))
 838
 839     (let* ((url (nth 0 media/current-information))
 840            (title (if (string= (car media/played-information) url) (cdr media/played-information)))
 841            (pos (media/add-song-to-playlist "Queue" url title)))
 842
 843       (move-overlay media/current-overlay
 844                     pos
 845                     (next-single-char-property-change pos 'url))))
 846
 847   (let* ((position (point)))
 848     (media/instant-highlight
 849      (previous-single-char-property-change (1+ position) 'url)
 850      (next-single-char-property-change position 'url))
 851     )
 852
 853   (let* ((position (point))
 854          (url (get-text-property position 'url))
 855          (title (get-text-property position 'title))
 856          (time (get-text-property position 'time))
 857          (pos (and url (media/add-song-to-playlist "Queue" url title time))))
 858
 859     (when (and pos (not media/current-information)) (media/play-position pos))
 860
 861     (next-line 1)
 862     (setq media/continue-mode t)
 863     (force-mode-line-update)
 864     )
 865
 866   )
 867
 868 (defun media/add-song (url) (interactive))
 869
 870 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 871
 872 (defun media/switch-continue-mode ()
 873   "Switches between a mode which automatically chains files and a mode
 874 which stops when the songs ends."
 875   (interactive)
 876   (setq media/continue-mode (not media/continue-mode))
 877   (force-mode-line-update)
 878   (if media/continue-mode (message "Continue mode switched on.")
 879     (message "Continue mode switched off."))
 880   )
 881
 882 (defun media/player-error ()
 883   (message "Player error")
 884   (media/remove-highlight))
 885
 886 (defun media/song-terminates ()
 887   (with-current-buffer media/buffer
 888     (if media/continue-mode (media/play-next t)
 889       (media/remove-highlight))))
 890
 891 (defun media/duration-to-string (duration)
 892   (let ((sec (mod duration 60))
 893         (min (/ duration 60)))
 894     (if (zerop duration) "0s"
 895       (concat (if (>= min 1) (format "%dm" min))
 896               (if (>= sec 1) (format "%ds" sec)))
 897       )))
 898
 899 (defun media/mode-string ()
 900   (propertize
 901    (concat
 902     " "
 903     media/player-id
 904     (if media/continue-mode "*")
 905     " "
 906
 907     (if media/current-information
 908         (if media/song-current-time
 909             (media/duration-to-string media/song-current-time)
 910           "?"
 911           ))
 912
 913     (if (and media/song-duration (> media/song-duration 0))
 914         (concat "/"
 915                 (media/duration-to-string media/song-duration)))
 916     )
 917
 918    'face 'media/mode-string-face)
 919   )
 920
 921 (defun media/show-current-information ()
 922   "Print a message with informations about the song currently playing"
 923   (interactive)
 924   (if media/current-information
 925       (message "Now playing %s (%dHz, %s, %dkbit/s)"
 926                (or (and (string= (car media/played-information) (nth 0 media/current-information))
 927                         (cdr media/played-information))
 928                    (replace-regexp-in-string "^.*/\\([^/]*\\)$" "\\1" (nth 0 media/current-information)))
 929                (nth 1 media/current-information)
 930                (if (= 2 (nth 2 media/current-information)) "stereo" "mono")
 931                (nth 3 media/current-information))
 932     (message "No song playing")))
 933
 934 (defun media/save-and-kill-buffer ()
 935   "Save the playlists and kill the media buffer"
 936   (interactive)
 937
 938   (condition-case nil
 939       (when media/add-current-song-to-interrupted-when-killing
 940         (setq media/active-playlist "Interrupted")
 941         (media/add-current-song-to-active-playlist t)
 942         )
 943     (error nil))
 944
 945   (unless (condition-case nil
 946               (media/save-playlists)
 947             (error (not (y-or-n-p "Can not save the playlists. Still kill the media buffer? "))))
 948     (kill-buffer media/buffer))
 949   )
 950
 951 (defun media/insert-keybindings (keymap)
 952   (insert (format "media/insert-keybindings [%s]" (prin1-to-string keymap)))
 953   (insert "\n---------------\n")
 954   (if (listp keymap)
 955       (if (eq (car keymap) 'keymap)
 956           (mapc 'media/insert-keybindings (cdr keymap)))
 957     (unless (eq (cdr keymap) 'undefined)
 958       (insert (format "%s -> %s\n"
 959                       (prin1-to-string (car keymap))
 960                       (prin1-to-string (cdr keymap)))))
 961     ))
 962
 963 (defun media/show-keys (&optional keymap) (interactive)
 964   (set-buffer (get-buffer-create "*media help*"))
 965   (media/insert-keybindings media/mode-map))
 966
 967 (defun media/quick-help () (interactive)
 968   (message "<return> play <n> add to the queue <p> pause <m> continue mode <q> bury the buffer <k> kill it"))
 969
 970 (defun media/move-forward () (interactive) (media/api/jump-at-time 'relative 3))
 971 (defun media/move-backward () (interactive) (media/api/jump-at-time 'relative -3))
 972 (defun media/volume-reset () (interactive) (media/api/set-volume 'absolute 50))
 973 (defun media/volume-increase ()  (interactive) (media/api/set-volume 'relative 1))
 974 (defun media/volume-decrease () (interactive) (media/api/set-volume 'relative -1))
 975
 976 (defun media/mode () (interactive)
 977   (if media/buffer (error "We already have a media buffer"))
 978
 979   (kill-all-local-variables)
 980
 981   (unless (boundp 'media/mode-map)
 982
 983     (setq media/mode-map (make-sparse-keymap))
 984
 985     (suppress-keymap media/mode-map)
 986
 987     (mapc (lambda (x) (define-key media/mode-map (car x) (cdr x)))
 988           `(("p" . media/pause)
 989             ("\C-m" . media/play-or-active-at-point)
 990             ("\t" . media/goto-next-playlist-or-dir)
 991             ([(shift iso-lefttab)] . media/goto-previous-playlist-or-dir)
 992             (" " . media/goto-current)
 993             ("a" . media/add-song-at-point-to-active-playlist)
 994             ("A" . media/add-current-song-to-active-playlist)
 995             ("n" . media/queue-song-at-point)
 996             ("f" . media/show-id3-at-point)
 997             ("r" . media/rename-point)
 998             ("R" . media/rename-point-according-to-id3)
 999             ("K" . media/move-point-to-tmp)
1000             ("N" . media/play-next)
1001             ("P" . media/play-prev)
1002             ("q" . bury-buffer)
1003             ("k" . media/save-and-kill-buffer)
1004             ("s" . media/stop)
1005             ("m" . media/switch-continue-mode)
1006             ;; ("t" . media/switch-timing)
1007             ("g" . media/refresh-list)
1008             ("h" . media/quick-help)
1009             ("?" . media/quick-help)
1010             ("l" . media/select-active-playlist)
1011             ;;             ("L" . media/create-playlist)
1012             ("i" . media/show-current-information)
1013             ;; ("I" . media/edit-id3-at-point)
1014             ("j" . media/jump-at-percent)
1015             (">" . media/move-forward)
1016             ("<" . media/move-backward)
1017             ([(control >)] . (lambda () (interactive) (media/api/jump-at-time 'relative 30)))
1018             ([(control <)] . (lambda () (interactive) (media/api/jump-at-time 'relative -30)))
1019             ([(control x) (control s)] . media/save-playlists)
1020             ("=" . media/volume-reset)
1021             ("+" . media/volume-increase)
1022             ("-" . media/volume-decrease)
1023             )))
1024
1025   (setq major-mode 'media
1026         mode-name "Media"
1027         ;; buffer-read-only t
1028         truncate-lines t
1029         media/buffer (current-buffer)
1030         media/current-overlay (make-overlay 0 0)
1031         media/instant-highlight-overlay (make-overlay 0 0)
1032         media/song-current-time nil
1033         media/song-duration nil
1034         global-mode-string (append global-mode-string '((:eval (media/mode-string))))
1035         )
1036
1037   (overlay-put media/current-overlay 'face 'media/current-tune-face)
1038   (overlay-put media/instant-highlight-overlay 'face 'media/instant-highlight-face)
1039
1040   (use-local-map media/mode-map)
1041
1042   (add-hook 'kill-emacs-hook 'media/die-decently)
1043   (add-hook 'kill-buffer-hook 'media/kill-buffer-cleanup nil t)
1044   (add-hook 'write-contents-hooks 'media/save-buffer nil t)
1045   )
1046
1047 (defun media/die-decently ()
1048   (when media/add-current-song-to-interrupted-when-killing
1049     (condition-case nil
1050         (progn
1051           (setq media/active-playlist "Interrupted")
1052           (media/add-current-song-to-active-playlist t)
1053           (media/save-playlists))
1054       (error nil))
1055     )
1056   )
1057
1058 (defun media/kill-buffer-cleanup () (interactive)
1059   (media/api/cleanup)
1060   (setq media/buffer nil
1061         global-mode-string (remove '(:eval (media/mode-string)) global-mode-string))
1062   )
1063
1064 (defun media/full-refresh ()
1065
1066   (undo-boundary)
1067   (erase-buffer)
1068   (media/import media/url-list)
1069   (media/goto-top)
1070   (media/load-playlists)
1071
1072   (unless media/expert
1073     (insert (propertize "
1074   media.el
1075   Written and (C) Francois Fleuret
1076   Send comments and bug reports to francois@fleuret.org
1077
1078   Return   play or active the playlist for insertion
1079   Space    goto song playing
1080   p        pause
1081   g        refresh list
1082   a        insert song at point to the active playlist
1083   A        insert current song to the active playlist
1084            universal argument store the time too
1085   l        select active playlist
1086   C-x C-s  save playlists
1087   n        queue song for playing
1088   f        show ID3 of song
1089   r        rename song
1090   R        rename song according to ID3
1091   K        move song to /tmp
1092   N        play next
1093   P        play previous
1094   q        hide buffer
1095   k        stop song and kill buffer
1096   s        stop song
1097   m        switch the continuous mode
1098   i        show current song information
1099   j        jump at position
1100   >        fast forward
1101   <        fast backward
1102   Ctrl->   fast forward x10
1103   Ctrl-<   fast backward x10
1104   =        reset volume
1105   +        increase volume
1106   -        decrease volume
1107 " 'prologue t)))
1108
1109   (set-buffer-modified-p nil)
1110   (undo-boundary)
1111   )
1112
1113 (defun media/switch-to-buffer-or-window (buffer)
1114   (let ((w (get-buffer-window buffer)))
1115     (if w (select-window w)
1116       (switch-to-buffer buffer))))
1117
1118 (defun media ()
1119   "If a `media/buffer' exists, and we are not in it, switch to it, if
1120 we are already in it, bury it. If none exists, creates one and switch
1121 to it."
1122   (interactive)
1123
1124   (if media/buffer
1125       (if (eq (window-buffer (selected-window)) media/buffer)
1126           (bury-buffer)
1127         (media/switch-to-buffer-or-window media/buffer))
1128     (switch-to-buffer (get-buffer-create "*media*"))
1129     (buffer-disable-undo)
1130     (media/mode)
1131     (media/full-refresh)
1132     (buffer-enable-undo)
1133     (run-hooks 'media/starting-hook)
1134     )
1135   )
1136
1137 (load media/player-api)
1138
1139 (media/api/init)