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