;;; tiny-xmms.el --- Control XMMS from Emacs

;; Author: Mark Triggs <mst@dishevelled.net>

;; This file 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 2, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; A very minimal XMMS interface.  If you're looking for a serious XMMS
;; interface for Emacs you'd be better to try http://www.emacswiki.org/.

;; Requires the small program tiny-xmms-remote.c (which should be available
;; where you found this file).

;;; Code:

(require 'cl)
(require 'highline)

(defcustom tiny-xmms-remote-cmd "tiny-xmms-remote"
  "The location of the tiny-xmms-remote command")
(defcustom tiny-xmms-buffer "*xmms playlist*"
  "The buffer used by tiny-xmms")

(defvar tiny-xmms-playlist-identifier nil
  "An identifier for the last observed playlist")


(when (not (boundp 'tiny-xmms-mode-map))
  (defvar tiny-xmms-mode-map (make-sparse-keymap) "The keymap for tiny-xmms")

  (define-key tiny-xmms-mode-map (kbd "RET") 'tiny-xmms-skip-to-current)
  (define-key tiny-xmms-mode-map (kbd "d") 'tiny-xmms-remove-track)
  (define-key tiny-xmms-mode-map (kbd "s") 'tiny-xmms-sort)
  (define-key tiny-xmms-mode-map (kbd "q") 'tiny-xmms-quit)
  (define-key tiny-xmms-mode-map (kbd "g") 'tiny-xmms-generate-playlist)
  (define-key tiny-xmms-mode-map (kbd "n") 'tiny-xmms-next)
  (define-key tiny-xmms-mode-map (kbd "p") 'tiny-xmms-prev)
  (define-key tiny-xmms-mode-map (kbd "r") 'tiny-xmms-jump-to-random)
  (define-key tiny-xmms-mode-map (kbd "C-_") 'tiny-xmms-prev)
  (define-key tiny-xmms-mode-map (kbd "S") 'tiny-xmms-stop)
  (define-key tiny-xmms-mode-map (kbd "SPC") 'tiny-xmms-play/pause)
  (define-key tiny-xmms-mode-map (kbd ".") 'tiny-xmms-update-buffer)
  (define-key tiny-xmms-mode-map (kbd "C-s")
    (lambda ()
      (interactive)
      (goto-char (point-min))
      (call-interactively 'isearch-forward))))


(defface tiny-xmms-highline
  '((t (:background "light blue" :foreground "black" :weight bold)))
  "The faced used to show the currently highlighted track")


(defun tiny-xmms-overlays ()
  (remove-if-not
   (lambda (o) (eq (overlay-get o 'type) 'tiny-xmms))
   (overlays-in (point-min) (point-max))))


(defun tiny-xmms-generate-playlist (&optional sorted)
  "Generate the playlist buffer"
  (interactive)
  (with-current-buffer (get-buffer-create tiny-xmms-buffer)
    (setq buffer-read-only nil)
    (delete-region (point-min) (point-max)))
  (let ((callback
         (lambda (contents)
           (let ((playlist (butlast
                            (split-string contents
                                          (concat "[\n" (string 0) "]")))))
             (with-current-buffer (get-buffer-create tiny-xmms-buffer)
               (setq buffer-read-only nil)
               (delete-region (point-min) (point-max))
               (loop for (filename pos) on playlist by 'cddr
                     do (when (not (string= "" filename))
                          (let ((p (point)))
                            (insert (concat filename "\n"))
                            (let ((o (make-overlay p (point))))
                              (overlay-put o 'pos pos)
                              (overlay-put o 'type 'tiny-xmms)))))
               (setq buffer-read-only t)
               (goto-char (point-min))
               (tiny-xmms-update-buffer))))))
    (if sorted
        (tiny-xmms-remote 'get-sorted callback)
      (tiny-xmms-remote 'get callback)))
  (setq tiny-xmms-playlist-identifier
        (tiny-xmms-remote 'id)))


(defun tiny-xmms ()
  "Jump to a playlist buffer"
  (interactive)
  (let ((first-run (not (get-buffer tiny-xmms-buffer)))
        (buffer (get-buffer-create tiny-xmms-buffer)))
    (pop-to-buffer buffer)
    (cond (first-run
           (tiny-xmms-generate-playlist)
           (tiny-xmms-mode))
          ((or (and tiny-xmms-playlist-identifier
                    (/= (tiny-xmms-remote 'id)
                        tiny-xmms-playlist-identifier))
               (/= (save-excursion
                     (goto-char (point-max))
                     (1- (current-line-number)))
                   (tiny-xmms-remote 'length)))
           (tiny-xmms-generate-playlist))
          (t (tiny-xmms-update-buffer)))))


(defun tiny-xmms-update-buffer ()
  "Update the playlist buffer from XMMS"
  (interactive)
  (with-current-buffer (get-buffer tiny-xmms-buffer)
    (destructuring-bind (playing . pos) (tiny-xmms-remote 'playing)
      (setq header-line-format
            (format "[tiny-xmms] %s: %s (%s)"
                    (upcase-initials (tiny-xmms-remote 'state))
                    playing
                    (tiny-xmms-remote 'status)))
      (goto-line (1+ pos)))
    (recenter)
    (set-buffer-modified-p nil)))


(defun tiny-xmms-overlays-at (point)
  (remove-if-not (lambda (o)
                   (eq (overlay-get o 'type) 'tiny-xmms))
                 (overlays-at point)))


(defun tiny-xmms-remove-track ()
  "Remove the current track from the playlist"
  (interactive)
  (let ((overlay (car (tiny-xmms-overlays-at (point)))))
    (unless overlay
      (error "No track under point"))
    (let ((pos (overlay-get overlay 'pos)))
      (unless pos
        (setq test overlay)
        (debug))
      (tiny-xmms-remote 'remove pos)
      (mapc
       (lambda (overlay)
         (let ((removed-pos (string-to-number pos))
               (this-pos (string-to-number (overlay-get overlay 'pos))))
           (when (> this-pos removed-pos)
             (overlay-put overlay 'pos
                          (number-to-string (1- this-pos))))))
       (tiny-xmms-overlays))))
  (let ((inhibit-read-only t))
    (mapc 'delete-overlay (tiny-xmms-overlays-at (point)))
    (delete-region
     (line-beginning-position)
     (1+ (line-end-position)))
    (when (eobp)
      (forward-line -1))))


(defun tiny-xmms-remote (command &rest args)
  "Interface to XMMS.
A thin wrapper around the tiny-xmms-remote program."
  (case command
    (skip-to (call-process tiny-xmms-remote-cmd nil nil nil
                           "skip" (car args)))
    ((get get-sorted)
     (let* ((buf (get-buffer-create (generate-new-buffer-name " *temp*")))
            (p (start-process "xmms-playlist" buf
                              tiny-xmms-remote-cmd "get")))
       (set-process-sentinel
        p `(lambda (process state)
             (let ((state (process-status process))
                   (status (process-exit-status process)))
               (when (eq state 'exit)
                 (with-current-buffer ,buf
                   (when (eq ',command 'get-sorted)
                     (sort-lines nil (point-min) (point-max)))
                   (progn
                     (funcall ',(car args) (buffer-string))
                     (kill-buffer ,buf)))))))))
    (length (with-temp-buffer
              (call-process tiny-xmms-remote-cmd nil t nil "length")
              (string-to-number (buffer-string))))
    (state (with-temp-buffer
             (call-process tiny-xmms-remote-cmd nil t nil "state")
             (subseq (buffer-string) 0 -1)))
    (playing (with-temp-buffer
               (call-process tiny-xmms-remote-cmd nil t nil "playing")
               (let ((playing (split-string (buffer-string) "\n" t)))
                 (cons (car playing)
                       (string-to-number (cadr playing))))))
    (status (with-temp-buffer
              (call-process tiny-xmms-remote-cmd nil t nil "status")
              (car (split-string (buffer-string) "\n" t))))
    (play (call-process tiny-xmms-remote-cmd nil t nil "play"))
    (stop (call-process tiny-xmms-remote-cmd nil t nil "stop"))
    (pause (call-process tiny-xmms-remote-cmd nil t nil "pause"))
    (next (call-process tiny-xmms-remote-cmd nil t nil "next"))
    (prev (call-process tiny-xmms-remote-cmd nil t nil "prev"))
    (remove (apply 'call-process tiny-xmms-remote-cmd nil t nil "remove"
                   args))
    (id (with-temp-buffer
            (call-process tiny-xmms-remote-cmd nil t nil "id")
            (string-to-number (buffer-string))))))


(defun tiny-xmms-play ()
  "Play XMMS"
  (interactive)
  (tiny-xmms-remote 'play)
  (tiny-xmms-update-buffer))


(defun tiny-xmms-prev ()
  "Skip back a last track"
  (interactive)
  (tiny-xmms-remote 'prev)
  (sit-for 0.2) ; yuck.
  (tiny-xmms-update-buffer))


(defun tiny-xmms-buffer-lines (&optional buffer)
  "Return the number of lines in BUFFER."
  (save-excursion
    (with-current-buffer (or buffer (current-buffer))
      (goto-char (point-min))
      (loop while (progn (end-of-line) (not (eobp)))
            count t
            do (next-line 1)))))

(defun tiny-xmms-jump-to-random ()
  "Skip back a last track"
  (interactive)
  (goto-line (random (1+ (tiny-xmms-buffer-lines)))))


(defun tiny-xmms-next ()
  "Skip to the next track"
  (interactive)
  (tiny-xmms-remote 'next)
  (sit-for 0.2) ; yuck.
  (tiny-xmms-update-buffer))


(defun tiny-xmms-stop ()
  "Stop XMMS"
  (interactive)
  (tiny-xmms-remote 'stop)
  (tiny-xmms-update-buffer))


(defun tiny-xmms-pause ()
  "Pause XMMS"
  (interactive)
  (tiny-xmms-remote 'pause)
  (tiny-xmms-update-buffer))


(defun tiny-xmms-play/pause ()
  "Toggle between play/pause"
  (interactive)
  (if (string= (tiny-xmms-remote 'state) "playing")
      (tiny-xmms-pause)
    (tiny-xmms-play)))


(defun tiny-xmms-skip-to-current ()
  "Jump to the track under point"
  (interactive)
  (tiny-xmms-remote 'skip-to
                    (overlay-get (car (tiny-xmms-overlays-at (point))) 'pos))
  (tiny-xmms-update-buffer))


(defun tiny-xmms-sort ()
  "Sort the playlist"
  (interactive)
  (tiny-xmms-generate-playlist 'string<))


(defun tiny-xmms-quit ()
  "Bury the current buffer and delete its window"
  (interactive)
  (bury-buffer)
  (delete-window))


(define-derived-mode tiny-xmms-mode fundamental-mode "tiny-xmms"
  "Mode for jumping around the XMMS playlist"
  (use-local-map tiny-xmms-mode-map)
  (make-variable-buffer-local 'tiny-xmms-now-playling)
  (set (make-local-variable 'highline-face)
       'tiny-xmms-highline)
  (highline-local-on)
  (setq cursor-type '(bar . 1)))

(provide 'tiny-xmms)
;;; tiny-xmms.el ends here