;; -*- mode: emacs-lisp -*-

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or         ;;
;; modify it under the terms of the GNU General Public License as        ;;
;; published by the Free Software Foundation; either version 3, or (at   ;;
;; your option) any later version.                                       ;;
;;                                                                       ;;
;; This program is distributed in the hope that it will be useful, but   ;;
;; WITHOUT ANY WARRANTY; without even the implied warranty of            ;;
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU      ;;
;; General Public License for more details.                              ;;
;;                                                                       ;;
;; You should have received a copy of the GNU General Public License     ;;
;; along with this program. If not, see <http://www.gnu.org/licenses/>.  ;;
;;                                                                       ;;
;; Written by and Copyright (C) Francois Fleuret                         ;;
;; Contact <francois@fleuret.org> for comments & bug reports             ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A simple front-end major mode for command line media players (only
;; mplayer for now, feel free to write the code for others)
;;
;; The strict minimum is to set in your ~/.emacs the variable
;; media/url-list to the list of directories where to pick the tunes
;; and the URLs of streams. For the latter you can also specify a name
;; that will appear in the interface instead of the URL itself.
;;
;; I have in my ~/.emacs
;;
;; (when (load "media" nil t)
;;
;;   (setq media/expert t
;;         media/add-current-song-to-interrupted-when-killing t
;;         media/duration-to-history 30
;;         media/history-size 1000
;;         media/playlist-file "~/private/media-playlists"
;;         media/mplayer/args '("-framedrop" "-zoom" "-subfont-osd-scale" "3" "-osdlevel" "3")
;;         media/mplayer/timing-request-period 1.0
;;         media/url-list '("~/mp3"
;;                          ("http://www.technomusic.com/live/hi/pls" . "Technomusic.com")
;;                          ("http://www.fullhouseradio.com/listen.pls" . "Full House Radio")
;;                          ("mms://live.france24.com/france24_fr.wsx" . "France 24")
;;                          ))
;;
;;   (define-key global-map [(meta \\)] 'media)
;; )
;;
;; If you put media.el and media-mplayer.el in an exotic directory,
;; you have to tell emacs to look for them there by adding something
;; like (add-to-list 'load-path "~/exotic/") before the (load "media")
;; command.

(defgroup media ()
  "Major mode to control media players"
  :version "1.2.2")

(defcustom media/player-api "media-mplayer"
  "The file to load for the abstract layer with the media player."
  :type 'string
  :group 'media)

(defcustom media/url-list '()
  "List of directories to be imported and urls. Each element can be
either a string containing a directory or an url, or a cons cell the
first element of which is a string containing a url and the second a
title to display in the list (convenient for internet radios)."
  :type 'list
  :group 'media)

(defcustom media/playlist-file "~/.media-playlists"
  "Where to save the playlists."
  :type 'string
  :group 'media)

(defcustom media/duration-to-history 5
  "Duration in seconds after which the song should be put in the history."
  :type 'integer
  :group 'media)

(defcustom media/playlist-at-top nil
  "Should the playlists be created at the top of the media buffer?"
  :type 'bool
  :group 'media)

(defcustom media/add-current-song-to-interrupted-when-killing nil
  "Should we save the current song with time in the Interrupted playlist?"
  :type 'bool
  :group 'media)

(defcustom media/do-not-remove-nonexisting-entries nil
  "Should we remove the entries corresponding to a non-existing file when saving the playlists?"
  :type 'bool
  :group 'media)

(defcustom media/history-size 0
  "How many songs to keep in the history list."
  :type 'integer
  :group 'media)

(defcustom media/continue-mode nil
  "Should the player start the next song in the buffer when the current terminates?"
  :type 'boolean
  :group 'media)

(defcustom media/continue-mode-hint "*"
  "What to append to the MPlayer string when in repeat mode"
  :type 'string
  :group 'media)

(defcustom media/expert nil
  "Should we bypass the keymap help when starting"
  :type 'boolean
  :group 'media)

(defvar media/current-information nil
  "Contains the name of the current file playing, the frequency in Hz
and the bitrate. Should be nil if no information is available.")

(defvar media/current-song-in-stream nil
  "Contains the title of the current song playing, as it may be
parsed from the stream.")

(defvar media/buffer nil
  "The main buffer for the media player mode.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defcustom media/finished-hook '(media/song-terminates)
  "Hook called when the current playing song/movie terminates."
  :type 'hook
  :group 'media)

(defcustom media/starting-hook nil
  "Hook called after the media buffer has been set up."
  :type 'hook
  :group 'media)

(defcustom media/before-play-hook nil
  "Hook called before starting the player on a new song."
  :type 'hook
  :group 'media)

(defcustom media/play-hook '(media/show-current-information)
  "Hook called when a song starts to play."
  :type 'hook
  :group 'media)

(defcustom media/error-hook '(media/player-error)
  "Hook called when a player error occurs."
  :type 'hook
  :group 'media)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defface media/playlist-face
  '((((background dark)) (:foreground "blue" :bold t))
    (((background light)) (:foreground "blue" :bold t)))
  "Face for playlist names."
  :group 'media)

(defface media/directory-face
  '((((background dark)) (:foreground "green" :bold t))
    (((background light)) (:foreground "forest green" :bold t)))
  "Face for directories."
  :group 'media)

(defface media/timestamp-face
  '((((background dark)) (:foreground "turquoise"))
    (((background light)) (:foreground "blue")))
  "Face for the stored timestamps."
  :group 'media)

(defface media/nonexisting-face
  '((((background dark)) (:foreground "red"))
    (((background light)) (:foreground "red3")))
  "Face for non-existing files."
  :group 'media)

(defface media/stream-face
  '((((background dark)) (:foreground "green"))
    (((background light)) (:foreground "green3")))
  "Face for non-files urls."
  :group 'media)

(defface media/current-tune-face
  '((((background dark)) (:foreground "gray80" :background "black"))
    (((background light)) (:foreground "black" :background "yellow")))
  "Highlight of the currently playing tune."
  :group 'media)

(defface media/instant-highlight-face
  '((((background dark)) (:foreground "black" :background "lawn green"))
    (((background light)) (:foreground "black" :background "lawn green")))
  "Brief highlight when adding a tune to the \"Queue\" list."
  :group 'media)

(defface media/mode-string-face
  '((t (:foreground "darkblue" :bold t)))
  "The face to display the media info in the modeline."
  :group 'media)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Various initializations
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(setq media/current-overlay nil
      media/instant-highlight-overlay nil
      media/instant-highlight-timer nil
      media/active-playlist nil)

(defun media/goto-top ()
  (goto-char (text-property-any (point-min) (point-max) 'prologue nil)))

(defun media/goto-next-playlist-or-dir () (interactive)
  (goto-char (min (next-single-char-property-change (point) 'playlist)
                  (next-single-char-property-change (point) 'dir)))
  (unless (< (point) (point-max)) (goto-char (point-min)))
  (unless (or (get-text-property (point) 'playlist)
              (get-text-property (point) 'dir))
    (goto-char (min (next-single-char-property-change (point) 'playlist)
                    (next-single-char-property-change (point) 'dir))))
  )

(defun media/goto-previous-playlist-or-dir () (interactive)
  (goto-char (max (previous-single-char-property-change (point) 'playlist)
                  (previous-single-char-property-change (point) 'dir)))
  (unless (> (point) (point-min)) (goto-char (point-max)))
  (unless (or (get-text-property (point) 'playlist)
              (get-text-property (point) 'dir))
    (goto-char (max (previous-single-char-property-change (point) 'playlist)
                    (previous-single-char-property-change (point) 'dir))))
  )

(defun media/remove-instant-highlight ()
  (move-overlay media/instant-highlight-overlay 0 0)
  (setq media/instant-highlight-timer nil)
  )

(defun media/instant-highlight (start end)
  (move-overlay media/instant-highlight-overlay start end)
  (when media/instant-highlight-timer
    (cancel-timer media/instant-highlight-timer))
  (setq media/instant-highlight-timer
        (run-at-time 0.25 nil 'media/remove-instant-highlight)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Finding and playing URLs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/reset-current-information ()
    (setq media/current-information nil
          media/current-song-in-stream nil))

(defun media/format-url (url)
  (if (string-match "^file:.*/\\([^/]+\\)$" url)
      (match-string 1 url)
    url)
  )

(defun media/play-position (position) (interactive)
  (let ((url (get-text-property position 'url))
        (time (get-text-property position 'time)))
    (if (not url) (media/remove-highlight)
      (run-hook-with-args 'media/before-play-hook url)
      (media/reset-current-information)
      (media/api/play url)
      ;; We keep the information of the url and the title
      (setq media/played-information (cons url (get-text-property position 'title)))
      (media/move-highlight position)
      (when time (media/api/jump-at-time 'absolute time))
      )))

(defun media/play-or-active-at-point () (interactive)
  (if (get-text-property (point) 'url)
      (media/play-position (point))
    (let ((playlist (get-text-property (point) 'playlist)))
      (when playlist
        (setq media/active-playlist playlist)
        (message "Active playlist is %s" media/active-playlist)))))

(defun media/goto-next () (interactive)
  (let ((p (next-single-char-property-change (point) 'url)))
    (while (and (< p (point-max)) (not (get-text-property p 'url)))
      (setq p (next-single-char-property-change p 'url)))
    (when (get-text-property p 'url)
      (goto-char p))))

(defun media/play-next (&optional dont-move) (interactive)
  (let ((p (next-single-char-property-change (overlay-start media/current-overlay) 'url)))
    (while (and (< p (point-max)) (not (get-text-property p 'url)))
      (setq p (next-single-char-property-change p 'url)))
    (if (not (get-text-property p 'url))
        (media/remove-highlight)
      (media/play-position p)
      (unless (or ;;(pos-visible-in-window-p p)
                  dont-move)
        (goto-char p)))))

(defun media/play-prev () (interactive)
  (let ((p (previous-single-char-property-change (overlay-start media/current-overlay) 'url)))
    (while (and (> p (point-min)) (not (get-text-property p 'url)))
      (setq p (previous-single-char-property-change p 'url)))
    (when (get-text-property p 'url)
      (media/play-position p))
    ;; (unless (pos-visible-in-window-p p)
      (goto-char p)
      ;; )
    ))

(defun media/move-highlight (position)
  (move-overlay media/current-overlay
                (previous-property-change (1+ position))
                ;; (next-property-change position)
                ;; (previous-single-char-property-change (1+ position) 'url)
                (next-single-char-property-change position 'url)
                ))

(defun media/remove-highlight ()
  (move-overlay media/current-overlay 0 0))

(defun media/goto-current () (interactive)
  (goto-char (overlay-start media/current-overlay)))

(defun media/jump-at-percent (&optional perc)
  "Goes to a certain % of the song"
  (interactive "P")
  (media/api/jump-at-percent
   (max 0
        (min 100
             (or perc
                 (string-to-number (read-from-minibuffer "Percentage: ")))))))

(defun media/refresh-list (&optional dir) (interactive)
  (when media/buffer
    (let* ((current (overlay-end media/current-overlay))
           (url (get-text-property current 'url))
           ;; (playlist (get-text-property current 'playlist))
           (w (get-buffer-window media/buffer)))

      (if (not w) (media/full-refresh)
        (let ((p (point))
              (s (window-start w)))
          (media/full-refresh)
          (goto-char p)
          (set-window-start w s)))

      ))

  ;; TODO: Move the overlay where they were before refresh

  (message "Refreshed!"))

;; TODO: Refresh only the directories which have to be

(defun media/rename-point () (interactive)
  (let ((url (get-text-property (point) 'url)))
    (when (and url (string-match "^file:/*\\(/.+\\)$" url))
      (let* ((original (match-string-no-properties 1 url))
             (new (read-from-minibuffer "New name: " original)))
        (if (string= original new)
            (message "Cancel")
          (message "Renaming %s to %s" original new)
          (rename-file original new)
          (media/refresh-list (file-name-directory original))
          (unless (string= (file-name-directory original) (file-name-directory new))
            (media/refresh-list (file-name-directory new)))
          )))))

(defun media/move-point-to-tmp () (interactive)
  (let ((url (get-text-property (point) 'url)))
    (unless (and url (string-match "^file:/*\\(/.+\\)$" url))
      (error "No file here"))
    (let* ((original (match-string-no-properties 1 url))
           (new (replace-regexp-in-string "^.*/" "/tmp/" original)))
      (if (string= original new)
          (message "Cancel")
        (message "Renaming %s into %s" original new)
        (rename-file original new)
        (media/refresh-list (file-name-directory original))
        ))))

(setq media/id3-genre-table
      [ "Blues" "Classic Rock" "Country" "Dance" "Disco" "Funk"
        "Grunge" "Hip-Hop" "Jazz" "Metal" "New Age" "Oldies"
        "Other" "Pop" "R&B" "Rap" "Reggae" "Rock"
        "Techno" "Industrial" "Alternative" "Ska" "Death Metal" "Pranks"
        "Soundtrack" "Euro-Techno" "Ambient" "Trip-Hop" "Vocal" "Jazz+Funk"
        "Fusion" "Trance" "Classical" "Instrumental" "Acid" "House"
        "Game" "Sound Clip" "Gospel" "Noise" "Alternative Rock" "Bass"
        "Soul" "Punk" "Space" "Meditative" "Instrumental Pop"
        "Instrumental Rock" "Ethnic" "Gothic" "Darkwave" "Techno-Industrial"
        "Electronic" "Pop-Folk" "Eurodance" "Dream" "Southern Rock" "Comedy"
        "Cult" "Gangsta" "Top 40" "Christian Rap" "Pop/Funk" "Jungle"
        "Native US" "Cabaret" "New Wave" "Psychadelic" "Rave" "Showtunes"
        "Trailer" "Lo-Fi" "Tribal" "Acid Punk" "Acid Jazz" "Polka" "Retro"
        "Musical" "Rock & Roll" "Hard Rock" "Folk" "Folk-Rock" "National Folk"
        "Swing" "Fast Fusion" "Bebob" "Latin" "Revival" "Celtic" "Bluegrass"
        "Gothic Rock" "Progressive Rock" "Psychedelic Rock" "Symphonic Rock"
        "Slow Rock" "Big Band" "Chorus" "Easy Listening" "Acoustic" "Humour"
        "Speech" "Chanson" "Opera" "Chamber Music" "Sonata" "Symphony"
        "Booty Bass" "Primus" "Porn Groove" "Satire" "Slow Jam" "Club" "Tango"
        "Samba" "Folklore" "Ballad" "Power Ballad" "Rythmic Soul" "Freestyle"
        "Duet" "Punk Rock" "Drum Solo" "Acapella" "Euro-House" "Dance Hall"
        "Goa" "Drum & Bass" "Club-House" "Hardcore" "Terror" "Indie" "BritPop"
        "Negerpunk" "Polsk Punk" "Beat" "Christian Gangsta Rap" "Heavy Metal"
        "Black Metal" "Crossover" "Contemporary Christian" "Christian Rock"
        "Merengue" "Salsa" "Trash Metal" ])

(defun media/get-file-id3-tags (file)
  "Returns the id3 tags in a list (SONG ARTIST ALBUM YEAR NOTE GENRE),
returns nil if no id3 tags could be found."
  (let ((size (elt (file-attributes file) 7)))
    (unless (integerp size) (error "Can not read the file ID3 information (file probably too big)"))
    (with-temp-buffer
      (when (and (> size 128)
                 (insert-file-contents-literally file nil (- size 128) size t)
                 (string= (buffer-substring 1 4) "TAG"))
        ;; Here we have the 128 last bytes of the file in a temporary
        ;; buffer, and the three first characters are "TAG"
        (append
         ;; We get the 5 first id3s
         (mapcar (lambda (pos)
                   (replace-regexp-in-string
                    "[ ]*$" ""
                    (buffer-substring (car pos) (cdr pos))))
                 '((4 . 34) (34 . 64) (64 . 94) (94 . 98) (98 . 127)))
         ;; And we decode the last one with the genre table
         (list
          (condition-case nil
              (elt media/id3-genre-table (string-to-char
                                          (buffer-substring 128 129)))
            (error "<Error>"))))))))

(defun media/show-id3-at-point ()
  (interactive)
  (let ((url (get-text-property (point) 'url)))
    (when url
      (if (not (string-match "^file:/*\\(/.+\\)$" url))
          (message "This is not a file!")
        (let* ((filename (match-string-no-properties 1 url)))
          (if (file-exists-p filename)
              (let ((id3tags (media/get-file-id3-tags filename)))
                (if id3tags
                    (message
                     "%s Song [%s] Artist [%s] Album [%s] Year [%s] Note [%s] Genre [%s]"
                     filename
                     (elt id3tags 0)
                     (elt id3tags 1)
                     (elt id3tags 2)
                     (elt id3tags 3)
                     (elt id3tags 4)
                     (elt id3tags 5))
                  (message "%s (no id3 tags) " filename)))
            (message "No such file (%s)!" filename)))))))

(defun media/rename-point-according-to-id3 ()
  "Renames the file located at point, according to the ID3 tags"
  (interactive)
  (let ((url (get-text-property (point) 'url)))
    (when (and url (string-match "^file:/*\\(/.+\\)$" url))
      (if (file-exists-p (match-string-no-properties 1 url))
          (let* ((filename (match-string-no-properties 1 url))
                 (id3tags (media/get-file-id3-tags filename)))
            (if id3tags
                (let* ((original (match-string-no-properties 1 url))
                       (new (read-from-minibuffer "New name: "
                                                  (replace-regexp-in-string
                                                   " " "_"
                                                   (concat (replace-regexp-in-string
                                                            "[^/]+$" "" (match-string-no-properties 1 url))
                                                           (elt id3tags 1)
                                                           "_-_"
                                                           (elt id3tags 0)
                                                           ".mp3")))))
                  (if (string= original new)
                      (message "Cancel")
                    (message "Renaming %s into %s" original new)
                    (rename-file original new)
                    (media/refresh-list)
                    ))
              (message "%s (no id3 tags) " filename)))
        (message "No such file!")))))

;; TODO: Finish

(defun media/edit-id3-at-point ()
  "Open a new buffer with the ID3 fields of the file on line editable."
  (interactive)
  (let ((url (get-text-property (point) 'url)))
    (when (and url (string-match "^file:/*\\(/.+\\)$" url))
      (if (file-exists-p (match-string-no-properties 1 url))
          (let* ((filename (match-string-no-properties 1 url))
                 (id3tags (or (media/get-file-id3-tags filename) '("-" "-" "-" "-" "-" "-"))))
            (let ((map (make-sparse-keymap)))

              (switch-to-buffer (get-buffer-create (generate-new-buffer-name "*media ID3 editor*")))

              (text-mode)
              (auto-fill-mode)

              (mapc (lambda (s)
                      (insert (if (numberp s) (elt id3tags s)
                                (propertize s 'read-only t 'rear-nonsticky '(read-only)))))

                    '("SONG:   " 0 "\n"
                      "ARTIST: " 1 "\n"
                      "ALBUM:  " 2 "\n"
                      "YEAR:   " 3 "\n"
                      "NOTE:   " 4 "\n"
                      "GENRE:  " 5 "\n"))

              (goto-char (point-min))
              (re-search-forward "SONG:   ")

              (define-key map (kbd "TAB")
                (lambda () (interactive)
                  (unless (re-search-forward ": +" nil t)
                    (goto-char (point-min))
                    (re-search-forward ": +" nil t))))

              (define-key map [(control c) (control c)]
                (lambda () (interactive)
                  (kill-this-buffer)
                  )
                )

              (define-key map [(control c) (control q)]
                (lambda () (interactive)
                  (kill-this-buffer)
                  (message "Cancel")
                  ))

              (use-local-map map)
              (message "C-c C-c to save the information, C-c C-q to cancel")
              )
            )
        )
      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adding objects in the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/separator ()
  (unless (and (eq (char-before) ?\n) (eq (char-before (1- (point))) ?\n))
    (insert "\n")))

(defun media/insert-url (url depth &optional info)
  (insert
   (if (listp url)
       (propertize (concat " "
                           (make-string (* 2 depth) ?\ )
                           info
                           " "
                           (media/format-url (cdr url)) "\n")
                   'url (car url)
                   'title (cdr url))

     (propertize (concat " "
                         (make-string (* 2 depth) ?\ )
                         info
                         " "
                         (media/format-url url) "\n")
                 'url url
                 'title nil))
   ))

(defun media/string-from-size (size)
  (if (< size 1024) (format "%5db" size)
    (if (< size 1048576) (format "%5dk" (ash size -10))
      (format "%5.01fM" (/ size 1048576.0))
      )))

(defun media/insert-file (filename depth)
  (media/insert-url (concat "file://" (file-truename filename))
                    depth
                    (concat (media/string-from-size (nth 7 (file-attributes filename))) " --")
                    ))

(defun media/insert-dir (filename depth)
  (media/separator)

  (insert (propertize (concat "  "
                              (make-string (* 2 depth) ?\ )
                              filename
                              "\n") 'face 'media/directory-face 'dir filename))

  (media/separator)

  (let ((dircontent (directory-files-and-attributes filename)))

    (mapc (lambda (file)
            (unless (string-match "^\\." (car file))
              (let ((url (concat filename "/" (car file))))
                (when (file-regular-p url)
                  (media/insert-file url depth)))))
          dircontent)

    (media/separator)

    (mapc (lambda (file)
            (unless (string-match "^\\." (car file))
              (let ((url (concat filename "/" (car file))))
                (when (file-directory-p url)
                  (media/insert-dir url (1+ depth))))))
          dircontent)
    )
  )

(defun media/import (list)

  (message "Importing the list of URLs")

  (media/separator)

  (mapc (lambda (c)
          (let* ((url (or (and (consp c) (car c)) c))
                 (title (or (and (consp c) (cdr c)) url)))
            (if (string-match "^\\(http\\|mms\\)://" url)
                (media/insert-url (cons url title) 0)
              (if (file-exists-p url)
                  (if (file-regular-p url) (media/insert-file url 0)
                    (if (file-directory-p url) (media/insert-dir url 0)
                      (error "Unknown type `%s'" url))))
              )))
        list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Saving and loading the buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/save-playlists () (interactive)

  (let ((list '()))

    (with-current-buffer media/buffer
      (let ((pos (point-min))
            (end (point-max)))

        (while (< (setq pos
                        (next-single-char-property-change pos 'url)
                        ;; (min (next-single-char-property-change pos 'url)
                        ;; (next-single-char-property-change pos 'time))
                        ) end)

          (let ((url (get-text-property pos 'url))
                (title (get-text-property pos 'title))
                (time (get-text-property pos 'time))
                (playlist (get-text-property pos 'playlist)))

            ;; (message "url=%s title=%s time=%s playlist=%s"
            ;; (prin1-to-string url)
            ;; (prin1-to-string title)
            ;; (prin1-to-string time)
            ;; (prin1-to-string playlist))

            (when (and playlist url)
              (unless (assoc playlist list) (push (list playlist) list))
              (push (cons url (cons title time)) (cdr (assoc playlist list)))
              )))))

    (with-current-buffer (find-file-noselect media/playlist-file)
      (erase-buffer)
      (mapc (lambda (x)
              (insert "PLAYLIST:" (car x) "\n")
              (mapc (lambda (y)
                      (when (or media/do-not-remove-nonexisting-entries
                                (not (string-match "^file:" (car y)))
                                (file-exists-p (replace-regexp-in-string "^file://" "" (car y))))
                        (when (car (cdr y)) (insert "TITLE:" (car (cdr y)) "\n"))
                        (when (cdr (cdr y)) (insert "TIME:" (number-to-string (cdr (cdr y))) "\n"))
                        (insert "URL:" (car y) "\n")))
                    (reverse (cdr x)))
              )
            (reverse list))
      (set-buffer-file-coding-system 'utf-8)
      (save-buffer)
      (kill-this-buffer)
      ))

  (set-buffer-modified-p nil))

(defun media/load-playlists () (interactive)
  (if (file-exists-p media/playlist-file)
      (with-temp-buffer
        (insert-file media/playlist-file)
        ;; (insert-file-contents-literally media/playlist-file)
        (goto-char (point-min))
        (let ((playlist nil)
              (title nil)
              (time nil))
          (while (re-search-forward "^\\([A-Z]*\\):\\(.*\\)$" nil t)
            (eval (cdr (assoc (match-string-no-properties 1)
                              '(("PLAYLIST" . (setq playlist (match-string-no-properties 2)))
                                ("TITLE" . (setq title (match-string-no-properties 2)))
                                ("TIME" . (setq time (string-to-number (match-string-no-properties 2))))
                                ("URL" . (save-excursion
                                           (media/add-song-to-playlist
                                            playlist (match-string-no-properties 2) title time)
                                           (setq title nil
                                                 time nil)))))))
            )))))

(defun media/select-active-playlist ()
  (interactive)
  (with-current-buffer media/buffer
    (let ((playlists nil)
          (pos (point-min))
          (end (point-max)))

      ;; Build the list of existing playlists
      (while (< (setq pos (next-single-char-property-change pos 'playlist)) end)
        (add-to-list 'playlists (list (get-text-property pos 'playlist))))

      (setq media/active-playlist
            (completing-read "Select playlist: " playlists))

      (message "Using `%s' as active playlist" media/active-playlist)))
  )

(defun media/create-playlist (name)
  (interactive "MPlaylist to create: ")
  (when (media/playlist-position name) (error "Playlist already existing"))
  (save-excursion
    (if media/playlist-at-top (media/goto-top)
      (goto-char (point-max)))
    (media/separator)
    (insert (propertize (concat "  " name "\n") 'playlist name 'face 'media/playlist-face)
            (propertize "\n" 'playlist name)
            )
    (setq media/active-playlist name)
    ;; (message "Playlist `%s' created" name)
    ))

(defun media/playlist-position (name)
  "Returns the position where the given playlist starts."
  (let ((pos (point-min)))
    (while (and (setq pos (next-single-char-property-change pos 'playlist))
                (not (string= name (get-text-property pos 'playlist)))
                (< pos (point-max))))
    (and (< pos (point-max)) pos)))

;; (defun media/playlist-position (name)
;;   (text-property-any (point-min) (point-max) 'playlist name))

;; (defun media/url-position (url &optional playlist)
;;   (let ((pos (point-min)))
;;     (while (and (setq pos (next-single-char-property-change pos 'playlist))
;;                 (not (string= name (get-text-property pos 'playlist)))
;;                 (< pos (point-max))))
;;     (and (< pos (point-max)) pos)))

(defun media/playlist-content (playlist)
  (let ((pos (point-min))
        (urls ()))
    (while (and (setq pos (next-single-char-property-change pos 'url))
                (string= playlist (get-text-property pos 'playlist))
                (< pos (point-max)))
      (setq urls (cons (cons pos (get-text-property pos 'url)) urls)))
    (nreverse urls)))

(defun media/put-in-history ()
  (set-buffer media/buffer)
  (when (> media/history-size 0)
    (let* ((urls (media/playlist-content "History"))
           (l (length urls))
           (current-url (car media/current-information))
           ;; For the title, if the URL we are actually playing is the
           ;; one we intended to play, we use the accompagnying title
           (current-title
            (if (string= (car media/played-information) current-url)
                (cdr media/played-information))))

      (media/add-song-to-playlist "History" current-url current-title)

      (when (> (1+ l) media/history-size)
        (delete-region (car (car urls))
                       (car (nth (- l media/history-size) urls)))))))

(defun media/add-song-at-point-to-active-playlist () (interactive)
  (if media/active-playlist
      (let ((url (get-text-property (point) 'url))
            (title (get-text-property (point) 'title))
            (time (get-text-property (point) 'time)))
        (if (not url) (error "No song at point")
          (media/add-song-to-playlist media/active-playlist url title time)
          (message "Added %s to playlist `%s'" (or title url) media/active-playlist)
          (media/instant-highlight
           (previous-single-char-property-change (1+ (point)) 'url)
           (next-single-char-property-change (point) 'url))
          (media/goto-next)))
    (error "No current playlist")))

(defun media/add-current-song-to-active-playlist (&optional settime) (interactive "P")
  (if media/active-playlist
      (let ((url (get-text-property (overlay-start media/current-overlay) 'url))
            (title (get-text-property (overlay-start media/current-overlay) 'title)))
        (if (not url) (error "No current song")
          (media/add-song-to-playlist media/active-playlist url title (and settime media/song-current-time))
          (message "Added %s to playlist `%s'" (or title url) media/active-playlist)))
    (error "No current playlist")))

(defun media/add-song-to-playlist (playlist url &optional title time)
  (set-buffer media/buffer)
  (let ((pos (or (media/playlist-position playlist)
                 (progn (media/create-playlist playlist)
                        (media/playlist-position playlist)))))
    (unless pos (error (format "Weird: There is no playlist \"%s\" but can not create it") playlist))
    (save-excursion
      (goto-char (next-single-char-property-change pos 'playlist))
      (prog1 (point)
        (insert (propertize (concat
                             "  "
                             (or title (media/format-url url))
                             (if time (propertize
                                       (concat " @" (media/duration-to-string time))
                                       'face 'media/timestamp-face
                                       ))
                             "\n"
                             )
                            'url url
                            'title title
                            'time time
                            'playlist (get-text-property (1- (point)) 'playlist))))
      )))

(defun media/pause () (interactive)
  (message "Pause")
  (media/api/pause))

(defun media/stop () (interactive)
  (message "Stop")
  (media/reset-current-information)
  (media/api/stop))

(defun media/queue-song-at-point ()
  "Switches to the 'continue' mode. If a song is currently playing and
not in the 'Queue' playlist, adds it. Then, adds the url at point to
the 'Queue' playlist, and plays it if no song is currently playing."
  (interactive)

  ;; If a song is playing and not in the the Queue list, put it

  (when (and media/current-information
             (not (string= (get-text-property (overlay-end media/current-overlay) 'playlist)
                           "Queue")))

    (let* ((url (nth 0 media/current-information))
           (title (if (string= (car media/played-information) url) (cdr media/played-information)))
           (pos (media/add-song-to-playlist "Queue" url title)))

      (move-overlay media/current-overlay
                    pos
                    (next-single-char-property-change pos 'url))))

  (let* ((position (point)))
    (media/instant-highlight
     (previous-single-char-property-change (1+ position) 'url)
     (next-single-char-property-change position 'url))
    )

  (let* ((position (point))
         (url (get-text-property position 'url))
         (title (get-text-property position 'title))
         (time (get-text-property position 'time))
         (pos (and url (media/add-song-to-playlist "Queue" url title time))))

    (when (and pos (not media/current-information)) (media/play-position pos))

    (next-line 1)
    (setq media/continue-mode t)
    (force-mode-line-update)
    )

  )

(defun media/add-song (url) (interactive))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/player-error ()
  (message "Player error")
  (media/reset-current-information)
  (media/remove-highlight))

(defun media/song-terminates ()
  (with-current-buffer media/buffer
    (if media/continue-mode (media/play-next t)
      (media/reset-current-information)
      (media/remove-highlight))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun media/switch-continue-mode ()
  "Switches between a mode which automatically chains files and a mode
which stops when the songs ends."
  (interactive)
  (setq media/continue-mode (not media/continue-mode))
  (force-mode-line-update)
  (if media/continue-mode (message "Continue mode switched on.")
    (message "Continue mode switched off."))
  )

(defun media/duration-to-string (duration)
  (let ((sec (mod duration 60))
        (min (/ duration 60)))
    (if (zerop duration) "0s"
      (concat (if (>= min 1) (format "%dm" min))
              (if (>= sec 1) (format "%ds" sec)))
      )))

(defun media/mode-string ()
  (propertize
   (concat
    " "
    media/player-id
    (if media/continue-mode media/continue-mode-hint)
    " "

    (if media/current-information
        (if media/song-current-time
            (media/duration-to-string media/song-current-time)
          "?"
          ))

    (if (and media/song-duration (> media/song-duration 0))
        (concat "/"
                (media/duration-to-string media/song-duration)))
    )

   'face 'media/mode-string-face)
  )

(defun media/show-current-information ()
  "Print a message with informations about the song currently playing"
  (interactive)
  (if media/current-information
      (message "Now playing %s %s(%dHz, %s, %dkbit/s)"
               (or (and (string= (car media/played-information) (nth 0 media/current-information))
                        (cdr media/played-information))
                   (replace-regexp-in-string "^.*/\\([^/]*\\)$" "\\1" (nth 0 media/current-information)))
               ;; (if media/current-song-in-stream (concat "[" media/current-song-in-stream "] ") "")
               (if media/current-song-in-stream (concat "| " media/current-song-in-stream " ") "")
               (nth 1 media/current-information)
               (if (= 2 (nth 2 media/current-information)) "stereo" "mono")
               (nth 3 media/current-information))
    (message "No song playing")))

(defun media/save-and-kill-buffer ()
  "Save the playlists and kill the media buffer"
  (interactive)

  (condition-case nil
      (when media/add-current-song-to-interrupted-when-killing
        (setq media/active-playlist "Interrupted")
        (media/add-current-song-to-active-playlist t)
        )
    (error nil))

  (unless (condition-case nil
              (media/save-playlists)
            (error (not (y-or-n-p "Can not save the playlists. Still kill the media buffer? "))))
    (kill-buffer media/buffer))
  )

(defun media/insert-keybindings (keymap)
  (insert (format "media/insert-keybindings [%s]" (prin1-to-string keymap)))
  (insert "\n---------------\n")
  (if (listp keymap)
      (if (eq (car keymap) 'keymap)
          (mapc 'media/insert-keybindings (cdr keymap)))
    (unless (eq (cdr keymap) 'undefined)
      (insert (format "%s -> %s\n"
                      (prin1-to-string (car keymap))
                      (prin1-to-string (cdr keymap)))))
    ))

(defun media/show-keys (&optional keymap) (interactive)
  (set-buffer (get-buffer-create "*media help*"))
  (media/insert-keybindings media/mode-map))

(defun media/quick-help () (interactive)
  (message "<return> play <n> add to the queue <p> pause <m> continue mode <q> bury the buffer <k> kill it"))

(defun media/move-forward () (interactive) (media/api/jump-at-time 'relative 3))
(defun media/move-backward () (interactive) (media/api/jump-at-time 'relative -3))
(defun media/volume-reset () (interactive) (media/api/set-volume 'absolute 50))
(defun media/volume-increase ()  (interactive) (media/api/set-volume 'relative 1))
(defun media/volume-decrease () (interactive) (media/api/set-volume 'relative -1))

(defun media/mode () (interactive)
  (if media/buffer (error "We already have a media buffer"))

  (kill-all-local-variables)

  (unless (boundp 'media/mode-map)

    (setq media/mode-map (make-sparse-keymap))

    (suppress-keymap media/mode-map)

    (mapc (lambda (x) (define-key media/mode-map (car x) (cdr x)))
          `(("p" . media/pause)
            ("\C-m" . media/play-or-active-at-point)
            ("\t" . media/goto-next-playlist-or-dir)
            ([(shift iso-lefttab)] . media/goto-previous-playlist-or-dir)
            (" " . media/goto-current)
            ("a" . media/add-song-at-point-to-active-playlist)
            ("A" . media/add-current-song-to-active-playlist)
            ("n" . media/queue-song-at-point)
            ("f" . media/show-id3-at-point)
            ("r" . media/rename-point)
            ("R" . media/rename-point-according-to-id3)
            ("K" . media/move-point-to-tmp)
            ("N" . media/play-next)
            ("P" . media/play-prev)
            ("q" . bury-buffer)
            ("k" . media/save-and-kill-buffer)
            ("s" . media/stop)
            ("m" . media/switch-continue-mode)
            ;; ("t" . media/switch-timing)
            ("g" . media/refresh-list)
            ("h" . media/quick-help)
            ("?" . media/quick-help)
            ("l" . media/select-active-playlist)
            ;;             ("L" . media/create-playlist)
            ("i" . media/show-current-information)
            ;; ("I" . media/edit-id3-at-point)
            ("j" . media/jump-at-percent)
            (">" . media/move-forward)
            ("<" . media/move-backward)
            ([(control >)] . (lambda () (interactive) (media/api/jump-at-time 'relative 30)))
            ([(control <)] . (lambda () (interactive) (media/api/jump-at-time 'relative -30)))
            ([(control x) (control s)] . media/save-playlists)
            ("=" . media/volume-reset)
            ("+" . media/volume-increase)
            ("-" . media/volume-decrease)
            )))

  (setq major-mode 'media
        mode-name "Media"
        ;; buffer-read-only t
        truncate-lines t
        media/buffer (current-buffer)
        media/current-overlay (make-overlay 0 0)
        media/instant-highlight-overlay (make-overlay 0 0)
        media/song-current-time nil
        media/song-duration nil
        global-mode-string (append global-mode-string '((:eval (media/mode-string))))
        )

  (overlay-put media/current-overlay 'face 'media/current-tune-face)
  (overlay-put media/instant-highlight-overlay 'face 'media/instant-highlight-face)

  (use-local-map media/mode-map)

  (add-hook 'kill-emacs-hook 'media/die-decently)
  (add-hook 'kill-buffer-hook 'media/kill-buffer-cleanup nil t)
  (add-hook 'write-contents-hooks 'media/save-buffer nil t)
  )

(defun media/die-decently ()
  (when media/add-current-song-to-interrupted-when-killing
    (condition-case nil
        (progn
          (setq media/active-playlist "Interrupted")
          (media/add-current-song-to-active-playlist t)
          (media/save-playlists))
      (error nil))
    )
  )

(defun media/kill-buffer-cleanup () (interactive)
  (media/api/cleanup)
  (setq media/buffer nil
        global-mode-string (remove '(:eval (media/mode-string)) global-mode-string))
  )

(defun media/full-refresh ()

  (undo-boundary)
  (erase-buffer)
  (media/import media/url-list)
  (media/goto-top)
  (media/load-playlists)

  (unless media/expert
    (insert (propertize "
  media.el
  Written and (C) Francois Fleuret
  Send comments and bug reports to francois@fleuret.org

  Return   play or active the playlist for insertion
  Space    goto song playing
  p        pause
  g        refresh list
  a        insert song at point to the active playlist
  A        insert current song to the active playlist
           universal argument store the time too
  l        select active playlist
  C-x C-s  save playlists
  n        queue song for playing
  f        show ID3 of song
  r        rename song
  R        rename song according to ID3
  K        move song to /tmp
  N        play next
  P        play previous
  q        hide buffer
  k        stop song and kill buffer
  s        stop song
  m        switch the continuous mode
  i        show current song information
  j        jump at position
  >        fast forward
  <        fast backward
  Ctrl->   fast forward x10
  Ctrl-<   fast backward x10
  =        reset volume
  +        increase volume
  -        decrease volume
" 'prologue t)))

  (set-buffer-modified-p nil)
  (undo-boundary)
  )

(defun media/switch-to-buffer-or-window (buffer)
  (let ((w (get-buffer-window buffer)))
    (if w (select-window w)
      (switch-to-buffer buffer))))

(defun media ()
  "If a `media/buffer' exists, and we are not in it, switch to it, if
we are already in it, bury it. If none exists, creates one and switch
to it."
  (interactive)

  (if media/buffer
      (if (eq (window-buffer (selected-window)) media/buffer)
          (bury-buffer)
        (media/switch-to-buffer-or-window media/buffer))
    (switch-to-buffer (get-buffer-create "*media*"))
    (buffer-disable-undo)
    (media/mode)
    (media/full-refresh)
    (buffer-enable-undo)
    (run-hooks 'media/starting-hook)
    )
  )

(load media/player-api)

(media/api/init)